From gitlab at gitlab.haskell.org Sat Jun 1 03:55:20 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 23:55:20 -0400 Subject: [Git][ghc/ghc][master] Fix and enforce validation of header for .hie files Message-ID: <5cf1f7285dc16_1c95eaae6b08979ec@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 6 changed files: - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/HscMain.hs - utils/haddock Changes: ===================================== compiler/hieFile/HieAst.hs ===================================== @@ -1,3 +1,6 @@ +{- +Main functions for .hie file generation +-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} @@ -20,7 +23,6 @@ import BooleanFormula import Class ( FunDep ) import CoreUtils ( exprType ) import ConLike ( conLikeName ) -import Config ( cProjectVersion ) import Desugar ( deSugarExpr ) import FieldLabel import HsSyn @@ -42,7 +44,6 @@ import HieUtils import qualified Data.Array as A import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC import qualified Data.Map as M import qualified Data.Set as S import Data.Data ( Data, Typeable ) @@ -98,9 +99,7 @@ mkHieFile ms ts rs = do let Just src_file = ml_hs_file $ ms_location ms src <- liftIO $ BS.readFile src_file return $ HieFile - { hie_version = curHieVersion - , hie_ghc_version = BSC.pack cProjectVersion - , hie_hs_file = src_file + { hie_hs_file = src_file , hie_module = ms_mod ms , hie_types = arr , hie_asts = asts' ===================================== compiler/hieFile/HieBin.hs ===================================== @@ -1,8 +1,11 @@ +{- +Binary serialization for .hie files. +-} {-# LANGUAGE ScopedTypeVariables #-} -module HieBin ( readHieFile, writeHieFile, HieName(..), toHieName ) where +module HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic) where +import Config ( cProjectVersion ) import GhcPrelude - import Binary import BinIface ( getDictFastString ) import FastMutInt @@ -14,17 +17,23 @@ import Outputable import PrelInfo import SrcLoc import UniqSupply ( takeUniqFromSupply ) +import Util ( maybeRead ) import Unique import UniqFM import qualified Data.Array as A import Data.IORef +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC import Data.List ( mapAccumR ) -import Data.Word ( Word32 ) -import Control.Monad ( replicateM ) +import Data.Word ( Word8, Word32 ) +import Control.Monad ( replicateM, when ) import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) +import HieTypes + -- | `Name`'s get converted into `HieName`'s before being written into @.hie@ -- files. See 'toHieName' and 'fromHieName' for logic on how to convert between -- these two types. @@ -63,10 +72,33 @@ data HieDictionary = HieDictionary initBinMemSize :: Int initBinMemSize = 1024*1024 -writeHieFile :: Binary a => FilePath -> a -> IO () +-- | The header for HIE files - Capital ASCII letters "HIE". +hieMagic :: [Word8] +hieMagic = [72,73,69] + +hieMagicLen :: Int +hieMagicLen = length hieMagic + +ghcVersion :: ByteString +ghcVersion = BSC.pack cProjectVersion + +putBinLine :: BinHandle -> ByteString -> IO () +putBinLine bh xs = do + mapM_ (putByte bh) $ BS.unpack xs + putByte bh 10 -- newline char + +-- | Write a `HieFile` to the given `FilePath`, with a proper header and +-- symbol tables for `Name`s and `FastString`s +writeHieFile :: FilePath -> HieFile -> IO () writeHieFile hie_file_path hiefile = do bh0 <- openBinMem initBinMemSize + -- Write the header: hieHeader followed by the + -- hieVersion and the GHC version used to generate this file + mapM_ (putByte bh0) hieMagic + putBinLine bh0 $ BSC.pack $ show hieVersion + putBinLine bh0 $ ghcVersion + -- remember where the dictionary pointer will go dict_p_p <- tellBin bh0 put_ bh0 dict_p_p @@ -105,7 +137,7 @@ writeHieFile hie_file_path hiefile = do symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the fornt of the file + -- write the dictionary pointer at the front of the file dict_p <- tellBin bh putAt bh dict_p_p dict_p seekBin bh dict_p @@ -120,10 +152,87 @@ writeHieFile hie_file_path hiefile = do writeBinMem bh hie_file_path return () -readHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache) +data HieFileResult + = HieFileResult + { hie_file_result_version :: Integer + , hie_file_result_ghc_version :: ByteString + , hie_file_result :: HieFile + } + +type HieHeader = (Integer, ByteString) + +-- | Read a `HieFile` from a `FilePath`. Can use +-- an existing `NameCache`. Allows you to specify +-- which versions of hieFile to attempt to read. +-- `Left` case returns the failing header versions. +readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader (HieFileResult, NameCache)) +readHieFileWithVersion readVersion nc file = do + bh0 <- readBinMem file + + (hieVersion, ghcVersion) <- readHieFileHeader file bh0 + + if readVersion (hieVersion, ghcVersion) + then do + (hieFile, nc') <- readHieFileContents bh0 nc + return $ Right (HieFileResult hieVersion ghcVersion hieFile, nc') + else return $ Left (hieVersion, ghcVersion) + + +-- | Read a `HieFile` from a `FilePath`. Can use +-- an existing `NameCache`. +readHieFile :: NameCache -> FilePath -> IO (HieFileResult, NameCache) readHieFile nc file = do + bh0 <- readBinMem file + (readHieVersion, ghcVersion) <- readHieFileHeader file bh0 + + -- Check if the versions match + when (readHieVersion /= hieVersion) $ + panic $ unwords ["readHieFile: hie file versions don't match for file:" + , file + , "Expected" + , show hieVersion + , "but got", show readHieVersion + ] + (hieFile, nc') <- readHieFileContents bh0 nc + return $ (HieFileResult hieVersion ghcVersion hieFile, nc') + +readBinLine :: BinHandle -> IO ByteString +readBinLine bh = BS.pack . reverse <$> loop [] + where + loop acc = do + char <- get bh :: IO Word8 + if char == 10 -- ASCII newline '\n' + then return acc + else loop (char : acc) + +readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader +readHieFileHeader file bh0 = do + -- Read the header + magic <- replicateM hieMagicLen (get bh0) + version <- BSC.unpack <$> readBinLine bh0 + case maybeRead version of + Nothing -> + panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:" + , show version + ] + Just readHieVersion -> do + ghcVersion <- readBinLine bh0 + + -- Check if the header is valid + when (magic /= hieMagic) $ + panic $ unwords ["readHieFileHeader: headers don't match for file:" + , file + , "Expected" + , show hieMagic + , "but got", show magic + ] + return (readHieVersion, ghcVersion) + +readHieFileContents :: BinHandle -> NameCache -> IO (HieFile, NameCache) +readHieFileContents bh0 nc = do + dict <- get_dictionary bh0 -- read the symbol table so we are capable of reading the actual data ===================================== compiler/hieFile/HieDebug.hs ===================================== @@ -1,3 +1,6 @@ +{- +Functions to validate and check .hie file ASTs generated by GHC. +-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} ===================================== compiler/hieFile/HieTypes.hs ===================================== @@ -1,3 +1,8 @@ +{- +Types for the .hie file format are defined here. + +For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files +-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -7,6 +12,7 @@ module HieTypes where import GhcPrelude +import Config import Binary import FastString ( FastString ) import IfaceType @@ -28,8 +34,8 @@ import Control.Applicative ( (<|>) ) type Span = RealSrcSpan -- | Current version of @.hie@ files -curHieVersion :: Word8 -curHieVersion = 0 +hieVersion :: Integer +hieVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer {- | GHC builds up a wealth of information about Haskell source as it compiles it. @@ -48,13 +54,7 @@ Besides saving compilation cycles, @.hie@ files also offer a more stable interface than the GHC API. -} data HieFile = HieFile - { hie_version :: Word8 - -- ^ version of the HIE format - - , hie_ghc_version :: ByteString - -- ^ Version of GHC that produced this file - - , hie_hs_file :: FilePath + { hie_hs_file :: FilePath -- ^ Initial Haskell source file path , hie_module :: Module @@ -74,11 +74,8 @@ data HieFile = HieFile , hie_hs_src :: ByteString -- ^ Raw bytes of the initial Haskell source } - instance Binary HieFile where put_ bh hf = do - put_ bh $ hie_version hf - put_ bh $ hie_ghc_version hf put_ bh $ hie_hs_file hf put_ bh $ hie_module hf put_ bh $ hie_types hf @@ -93,8 +90,6 @@ instance Binary HieFile where <*> get bh <*> get bh <*> get bh - <*> get bh - <*> get bh {- ===================================== compiler/main/HscMain.hs ===================================== @@ -174,7 +174,7 @@ import Data.Set (Set) import HieAst ( mkHieFile ) import HieTypes ( getAsts, hie_asts ) -import HieBin ( readHieFile, writeHieFile ) +import HieBin ( readHieFile, writeHieFile , hie_file_result) import HieDebug ( diffFile, validateScopes ) #include "HsVersions.h" @@ -434,7 +434,7 @@ extract_renamed_stuff mod_summary tc_result = do -- Roundtrip testing nc <- readIORef $ hsc_NC hs_env (file', _) <- readHieFile nc out_file - case diffFile hieFile file' of + case diffFile hieFile (hie_file_result file') of [] -> putMsg dflags $ text "Got no roundtrip errors" xs -> do ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit f01473ed28e7c2700ff8e87b00ab87a802c9edd9 +Subproject commit 83bb9870a117f9426e6f6cff6fec3bb6e93a7c18 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e0d87da2fd25e2fb255417fcb15f93f508c1250 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e0d87da2fd25e2fb255417fcb15f93f508c1250 You're receiving 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 Jun 1 03:55:54 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 23:55:54 -0400 Subject: [Git][ghc/ghc][master] Improve ThreadId Show instance Message-ID: <5cf1f74a87ae7_1c953faa1bc7c9dc9006c4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 1 changed file: - libraries/base/GHC/Conc/Sync.hs Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -113,7 +113,7 @@ import GHC.IORef import GHC.MVar import GHC.Ptr import GHC.Real ( fromIntegral ) -import GHC.Show ( Show(..), showString ) +import GHC.Show ( Show(..), showParen, showString ) import GHC.Stable ( StablePtr(..) ) import GHC.Weak @@ -145,7 +145,7 @@ This misfeature will hopefully be corrected at a later date. -- | @since 4.2.0.0 instance Show ThreadId where - showsPrec d t = + showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . showsPrec d (getThreadId (id2TSO t)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1d43d4a3e45d86261fa63591e99749cb7d3f68ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1d43d4a3e45d86261fa63591e99749cb7d3f68ed You're receiving 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 Jun 1 03:56:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 23:56:32 -0400 Subject: [Git][ghc/ghc][master] Reject nested foralls in foreign imports (#16702) Message-ID: <5cf1f77065c83_1c95eaae6b0904118@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 5 changed files: - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - + testsuite/tests/ffi/should_fail/T16702.hs - + testsuite/tests/ffi/should_fail/T16702.stderr - testsuite/tests/ffi/should_fail/all.T Changes: ===================================== compiler/typecheck/TcForeign.hs ===================================== @@ -64,7 +64,6 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.Maybe -- Defines a binding isForeignImport :: LForeignDecl name -> Bool @@ -251,8 +250,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty ; let -- Drop the foralls before inspecting the -- structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys norm_sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty) id = mkLocalId nm sig_ty -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking, @@ -424,10 +422,9 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where - -- Drop the foralls before inspecting n + -- Drop the foralls before inspecting -- the structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty) {- ************************************************************************ @@ -458,6 +455,11 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty = -- Got an IO result type, that's always fine! check (pred_res_ty res_ty) (illegalForeignTyErr result) + -- We disallow nested foralls in foreign types + -- (at least, for the time being). See #16702. + | tcIsForAllTy ty + = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall") + -- Case for non-IO result type with FFI Import | not non_io_result_ok = addErrTc $ illegalForeignTyErr result (text "IO result type expected") ===================================== docs/users_guide/ffi-chap.rst ===================================== @@ -14,9 +14,10 @@ Foreign function interface (FFI) Allow use of the Haskell foreign function interface. -GHC (mostly) conforms to the Haskell Foreign Function Interface, whose -definition is part of the Haskell Report on -`http://www.haskell.org/ `__. +GHC (mostly) conforms to the Haskell Foreign Function Interface as specified +in the Haskell Report. Refer to the `relevant chapter +_` +of the Haskell Report for more details. FFI support is enabled by default, but can be enabled or disabled explicitly with the :extension:`ForeignFunctionInterface` flag. @@ -102,6 +103,25 @@ OK: :: foreign import foo :: Int -> MyIO Int foreign import "dynamic" baz :: (Int -> MyIO Int) -> CInt -> MyIO Int +.. _ffi-foralls: + +Explicit ``forall``s in foreign types +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The type variables in the type of a foreign declaration may be quantified with +an explicit ``forall`` by using the :extension:`ExplicitForAll` language +extension, as in the following example: :: + + {-# LANGUAGE ExplicitForAll #-} + foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a) + +Note that an explicit ``forall`` must appear at the front of the type signature +and is not permitted to appear nested within the type, as in the following +(erroneous) examples: :: + + foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a) + foreign import ccall quux :: (forall a. Ptr a) -> IO () + .. _ffi-prim: Primitive imports ===================================== testsuite/tests/ffi/should_fail/T16702.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE RankNTypes #-} + +module T16702 where + +import Foreign.C.Types +import Foreign.Ptr +import Data.Kind (Type) + +foreign import ccall "math.h pow" + c_pow :: CDouble + -> forall (a :: Type). CDouble + -> forall (b :: Type). CDouble + +foreign import ccall "malloc" + malloc1 :: CSize -> forall a. IO (Ptr a) + +foreign import ccall "malloc" + malloc2 :: Show a => CSize -> IO (Ptr a) + +foreign import ccall "malloc" + malloc3 :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/T16702.stderr ===================================== @@ -0,0 +1,29 @@ + +T16702.hs:12:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "math.h pow" c_pow + :: CDouble + -> forall (a :: Type). CDouble -> forall (b :: Type). CDouble + +T16702.hs:17:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "malloc" malloc1 + :: CSize -> forall a. IO (Ptr a) + +T16702.hs:20:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc2 + :: Show a => CSize -> IO (Ptr a) + +T16702.hs:23:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc3 + :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/all.T ===================================== @@ -14,6 +14,7 @@ test('T5664', normal, compile_fail, ['-v0']) test('T7506', normal, compile_fail, ['']) test('T7243', normal, compile_fail, ['']) test('T10461', normal, compile_fail, ['']) +test('T16702', normal, compile_fail, ['']) # UnsafeReenter tests implementation of an undefined behavior (calling Haskell # from an unsafe foreign function) and only makes sense in non-threaded way View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/45f88494293bea20cc3aca025ee6fe84087987ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/45f88494293bea20cc3aca025ee6fe84087987ce You're receiving 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 Jun 1 03:57:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 31 May 2019 23:57:12 -0400 Subject: [Git][ghc/ghc][master] Fix space leaks in dynLoadObjs (#16708) Message-ID: <5cf1f798db359_1c955c0da3c909776@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1 changed file: - compiler/ghci/Linker.hs Changes: ===================================== compiler/ghci/Linker.hs ===================================== @@ -115,7 +115,7 @@ readPLS dl = modifyMbPLS_ :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () -modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState { @@ -881,8 +881,8 @@ dynLinkObjs hsc_env pls objs = do dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] -> IO PersistentLinkerState -dynLoadObjs _ pls [] = return pls -dynLoadObjs hsc_env pls objs = do +dynLoadObjs _ pls [] = return pls +dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do let dflags = hsc_dflags hsc_env let platform = targetPlatform dflags let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] @@ -899,13 +899,13 @@ dynLoadObjs hsc_env pls objs = do -- library. ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) - (nub $ snd <$> temp_sos pls) + (nub $ snd <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) , Option "-Xlinker" , Option "-rpath" , Option "-Xlinker" , Option lp ]) - (nub $ fst <$> temp_sos pls) + (nub $ fst <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) @@ -933,13 +933,13 @@ dynLoadObjs hsc_env pls objs = do -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again. - linkDynLib dflags2 objs (pkgs_loaded pls) + linkDynLib dflags2 objs pkgs_loaded -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime dflags TFL_GhcSession [soFile] m <- loadDLL hsc_env soFile case m of - Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } + Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/76e5889017ee4ac688901d37f2fa684e807769b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/76e5889017ee4ac688901d37f2fa684e807769b6 You're receiving 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 Jun 1 09:43:28 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 01 Jun 2019 05:43:28 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf248c08da0f_1c953faa1a2fc1249189f0@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 221fe2ff by Sebastian Graf at 2019-06-01T09:42:26Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 9 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -312,155 +238,23 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,7 +36,8 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable import NameEnv @@ -48,199 +53,219 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> symmetric (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state + | x == y -> boring - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + | otherwise -> extendSubstAndSolve x e2 tms + (_, PmExprVar{}) -> symmetric - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + symmetric = unify tms (e2, e1) --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +273,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +Consider a pattern match like - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. --} + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. + +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. + +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. +-} \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/221fe2ff65567d022fa913465868f18a26924ade -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/221fe2ff65567d022fa913465868f18a26924ade You're receiving 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 Jun 1 09:58:54 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 01 Jun 2019 05:58:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Improve ThreadId Show instance Message-ID: <5cf24c5e20f8b_1c953faa33c4fbb8919682@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - d9d0e514 by Ömer Sinan Ağacan at 2019-06-01T09:58:48Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 26736f3c by Ömer Sinan Ağacan at 2019-06-01T09:58:50Z rts: Remove unused decls from CNF.h - - - - - 14 changed files: - compiler/ghci/Linker.hs - compiler/prelude/PrelRules.hs - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - libraries/base/GHC/Conc/Sync.hs - rts/sm/CNF.h - + testsuite/tests/codeGen/should_compile/T16449_1.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_run/T16449_2.hs - + testsuite/tests/codeGen/should_run/T16449_2.stderr - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/ffi/should_fail/T16702.hs - + testsuite/tests/ffi/should_fail/T16702.stderr - testsuite/tests/ffi/should_fail/all.T Changes: ===================================== compiler/ghci/Linker.hs ===================================== @@ -115,7 +115,7 @@ readPLS dl = modifyMbPLS_ :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () -modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState { @@ -881,8 +881,8 @@ dynLinkObjs hsc_env pls objs = do dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] -> IO PersistentLinkerState -dynLoadObjs _ pls [] = return pls -dynLoadObjs hsc_env pls objs = do +dynLoadObjs _ pls [] = return pls +dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do let dflags = hsc_dflags hsc_env let platform = targetPlatform dflags let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] @@ -899,13 +899,13 @@ dynLoadObjs hsc_env pls objs = do -- library. ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) - (nub $ snd <$> temp_sos pls) + (nub $ snd <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) , Option "-Xlinker" , Option "-rpath" , Option "-Xlinker" , Option lp ]) - (nub $ fst <$> temp_sos pls) + (nub $ fst <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) @@ -933,13 +933,13 @@ dynLoadObjs hsc_env pls objs = do -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again. - linkDynLib dflags2 objs (pkgs_loaded pls) + linkDynLib dflags2 objs pkgs_loaded -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime dflags TFL_GhcSession [soFile] m <- loadDLL hsc_env soFile case m of - Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } + Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -467,13 +467,16 @@ shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr -- Used for shift primops -- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word# -- SllOp, SrlOp :: Word# -> Int# -> Word# --- See Note [Guarding against silly shifts] shiftRule shift_op = do { dflags <- getDynFlags ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs ; case e1 of _ | shift_len == 0 -> return e1 + -- See Note [Guarding against silly shifts] + | shift_len < 0 || shift_len > wordSizeInBits dflags + -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + ("Bad shift length " ++ show shift_len) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) ===================================== compiler/typecheck/TcForeign.hs ===================================== @@ -64,7 +64,6 @@ import Hooks import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.Maybe -- Defines a binding isForeignImport :: LForeignDecl name -> Bool @@ -251,8 +250,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty ; let -- Drop the foralls before inspecting the -- structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys norm_sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty) id = mkLocalId nm sig_ty -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking, @@ -424,10 +422,9 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where - -- Drop the foralls before inspecting n + -- Drop the foralls before inspecting -- the structure of the foreign type. - (bndrs, res_ty) = tcSplitPiTys sig_ty - arg_tys = mapMaybe binderRelevantType_maybe bndrs + (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty) {- ************************************************************************ @@ -458,6 +455,11 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty = -- Got an IO result type, that's always fine! check (pred_res_ty res_ty) (illegalForeignTyErr result) + -- We disallow nested foralls in foreign types + -- (at least, for the time being). See #16702. + | tcIsForAllTy ty + = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall") + -- Case for non-IO result type with FFI Import | not non_io_result_ok = addErrTc $ illegalForeignTyErr result (text "IO result type expected") ===================================== docs/users_guide/ffi-chap.rst ===================================== @@ -14,9 +14,10 @@ Foreign function interface (FFI) Allow use of the Haskell foreign function interface. -GHC (mostly) conforms to the Haskell Foreign Function Interface, whose -definition is part of the Haskell Report on -`http://www.haskell.org/ `__. +GHC (mostly) conforms to the Haskell Foreign Function Interface as specified +in the Haskell Report. Refer to the `relevant chapter +_` +of the Haskell Report for more details. FFI support is enabled by default, but can be enabled or disabled explicitly with the :extension:`ForeignFunctionInterface` flag. @@ -102,6 +103,25 @@ OK: :: foreign import foo :: Int -> MyIO Int foreign import "dynamic" baz :: (Int -> MyIO Int) -> CInt -> MyIO Int +.. _ffi-foralls: + +Explicit ``forall``s in foreign types +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The type variables in the type of a foreign declaration may be quantified with +an explicit ``forall`` by using the :extension:`ExplicitForAll` language +extension, as in the following example: :: + + {-# LANGUAGE ExplicitForAll #-} + foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a) + +Note that an explicit ``forall`` must appear at the front of the type signature +and is not permitted to appear nested within the type, as in the following +(erroneous) examples: :: + + foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a) + foreign import ccall quux :: (forall a. Ptr a) -> IO () + .. _ffi-prim: Primitive imports ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -113,7 +113,7 @@ import GHC.IORef import GHC.MVar import GHC.Ptr import GHC.Real ( fromIntegral ) -import GHC.Show ( Show(..), showString ) +import GHC.Show ( Show(..), showParen, showString ) import GHC.Stable ( StablePtr(..) ) import GHC.Weak @@ -145,7 +145,7 @@ This misfeature will hopefully be corrected at a later date. -- | @since 4.2.0.0 instance Show ThreadId where - showsPrec d t = + showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . showsPrec d (getThreadId (id2TSO t)) ===================================== rts/sm/CNF.h ===================================== @@ -15,9 +15,6 @@ #include "BeginPrivate.h" -void initCompact (void); -void exitCompact (void); - StgCompactNFData *compactNew (Capability *cap, StgWord size); void compactResize(Capability *cap, ===================================== testsuite/tests/codeGen/should_compile/T16449_1.hs ===================================== @@ -0,0 +1,8 @@ +module T16449_1 where + +import Data.Bits (setBit) + +f :: Int +f = foldl setter 0 $ zip [0..] [()] + where + setter v (ix, _) = setBit v ix ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -59,3 +59,5 @@ test('T15155', test('T15155l', when(unregisterised(), skip), makefile_test, []) + +test('T16449_1', normal, compile, ['']) ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Int + +-- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. +main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr ===================================== @@ -0,0 +1 @@ +T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,3 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) +test('T16449_2', exit_code(1), compile_and_run, ['']) ===================================== testsuite/tests/ffi/should_fail/T16702.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE RankNTypes #-} + +module T16702 where + +import Foreign.C.Types +import Foreign.Ptr +import Data.Kind (Type) + +foreign import ccall "math.h pow" + c_pow :: CDouble + -> forall (a :: Type). CDouble + -> forall (b :: Type). CDouble + +foreign import ccall "malloc" + malloc1 :: CSize -> forall a. IO (Ptr a) + +foreign import ccall "malloc" + malloc2 :: Show a => CSize -> IO (Ptr a) + +foreign import ccall "malloc" + malloc3 :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/T16702.stderr ===================================== @@ -0,0 +1,29 @@ + +T16702.hs:12:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "math.h pow" c_pow + :: CDouble + -> forall (a :: Type). CDouble -> forall (b :: Type). CDouble + +T16702.hs:17:1: error: + • Unacceptable result type in foreign declaration: + Unexpected nested forall + • When checking declaration: + foreign import ccall safe "malloc" malloc1 + :: CSize -> forall a. IO (Ptr a) + +T16702.hs:20:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc2 + :: Show a => CSize -> IO (Ptr a) + +T16702.hs:23:1: error: + • Unacceptable argument type in foreign declaration: + ‘Show a’ cannot be marshalled in a foreign call + • When checking declaration: + foreign import ccall safe "malloc" malloc3 + :: CSize -> Show a => IO (Ptr a) ===================================== testsuite/tests/ffi/should_fail/all.T ===================================== @@ -14,6 +14,7 @@ test('T5664', normal, compile_fail, ['-v0']) test('T7506', normal, compile_fail, ['']) test('T7243', normal, compile_fail, ['']) test('T10461', normal, compile_fail, ['']) +test('T16702', normal, compile_fail, ['']) # UnsafeReenter tests implementation of an undefined behavior (calling Haskell # from an unsafe foreign function) and only makes sense in non-threaded way View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c8d1989a19faa65287c976fecfdbde96995d367...26736f3c71df568f5fb71e2fb25d2534efb94759 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c8d1989a19faa65287c976fecfdbde96995d367...26736f3c71df568f5fb71e2fb25d2534efb94759 You're receiving 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 Jun 1 10:29:36 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 01 Jun 2019 06:29:36 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf253902b862_1c953faa1a2fc124926750@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: f9758aaf by Sebastian Graf at 2019-06-01T10:29:23Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 9 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -312,155 +238,23 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,7 +36,8 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable import NameEnv @@ -48,199 +53,219 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> symmetric (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state + | x == y -> boring - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + | otherwise -> extendSubstAndSolve x e2 tms + (_, PmExprVar{}) -> symmetric - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + symmetric = unify tms (e2, e1) --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +273,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f9758aaf530556f4b9bc5d63005f654c552a599c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f9758aaf530556f4b9bc5d63005f654c552a599c You're receiving 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 Jun 1 15:19:02 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 01 Jun 2019 11:19:02 -0400 Subject: [Git][ghc/ghc][master] Fix rewriting invalid shifts to errors Message-ID: <5cf297665862d_1c953faa182258609392e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 6 changed files: - compiler/prelude/PrelRules.hs - + testsuite/tests/codeGen/should_compile/T16449_1.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_run/T16449_2.hs - + testsuite/tests/codeGen/should_run/T16449_2.stderr - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -467,13 +467,16 @@ shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr -- Used for shift primops -- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word# -- SllOp, SrlOp :: Word# -> Int# -> Word# --- See Note [Guarding against silly shifts] shiftRule shift_op = do { dflags <- getDynFlags ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs ; case e1 of _ | shift_len == 0 -> return e1 + -- See Note [Guarding against silly shifts] + | shift_len < 0 || shift_len > wordSizeInBits dflags + -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + ("Bad shift length " ++ show shift_len) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) ===================================== testsuite/tests/codeGen/should_compile/T16449_1.hs ===================================== @@ -0,0 +1,8 @@ +module T16449_1 where + +import Data.Bits (setBit) + +f :: Int +f = foldl setter 0 $ zip [0..] [()] + where + setter v (ix, _) = setBit v ix ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -59,3 +59,5 @@ test('T15155', test('T15155l', when(unregisterised(), skip), makefile_test, []) + +test('T16449_1', normal, compile, ['']) ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Int + +-- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. +main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr ===================================== @@ -0,0 +1 @@ +T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,3 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) +test('T16449_2', exit_code(1), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1503da32d26fb59fb6ebb620bfd0f8c08638f627 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1503da32d26fb59fb6ebb620bfd0f8c08638f627 You're receiving 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 Jun 1 15:19:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 01 Jun 2019 11:19:38 -0400 Subject: [Git][ghc/ghc][master] rts: Remove unused decls from CNF.h Message-ID: <5cf2978a190eb_1c95e21eacc9420c1@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 1 changed file: - rts/sm/CNF.h Changes: ===================================== rts/sm/CNF.h ===================================== @@ -15,9 +15,6 @@ #include "BeginPrivate.h" -void initCompact (void); -void exitCompact (void); - StgCompactNFData *compactNew (Capability *cap, StgWord size); void compactResize(Capability *cap, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2e297b36169208939528d962724679c5756e9e7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2e297b36169208939528d962724679c5756e9e7c You're receiving 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 Jun 1 15:45:38 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 01 Jun 2019 11:45:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/16718 Message-ID: <5cf29da2b513_1c953faa185e5fb894482e@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/16718 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/16718 You're receiving 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 Jun 1 18:14:12 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 01 Jun 2019 14:14:12 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf2c074849c7_1c95587c79c9511fd@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 3b089293 by Sebastian Graf at 2019-06-01T18:13:54Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 9 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2751,3 +2665,4 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -241,7 +167,10 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) +-- Translating HsConLikeOut to variables is wrong. Regarding it as a flexible +-- occurrence is just incorrect and as a rigid variable it is no better than a +-- PmExprOther. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -312,155 +241,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,10 +36,12 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +54,227 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> symmetric (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + | x == y -> boring - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + | otherwise -> extendSubstAndSolve x e2 tms + (_, PmExprVar{}) -> symmetric - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + symmetric = unify tms (e2, e1) --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +282,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b089293c6a7263a7f17148a09c78fbeecc2b04a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b089293c6a7263a7f17148a09c78fbeecc2b04a You're receiving 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 Jun 1 21:03:05 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 01 Jun 2019 17:03:05 -0400 Subject: [Git][ghc/ghc][wip/16718] Print role annotations in TemplateHaskell brackets (#16718) Message-ID: <5cf2e8098b5b7_1c95d3b2d589686df@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/16718 at Glasgow Haskell Compiler / GHC Commits: d0fff215 by Vladislav Zavialov at 2019-06-01T21:02:51Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 5 changed files: - compiler/hsSyn/HsDecls.hs - + testsuite/tests/roles/should_compile/T16718.hs - + testsuite/tests/roles/should_compile/T16718.stderr - testsuite/tests/roles/should_compile/all.T - testsuite/tests/th/T15365.stderr Changes: ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -302,6 +302,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where if isEmptyValBinds val_decls then Nothing else Just (ppr val_decls), + ppr_ds (tyClGroupRoleDecls tycl_decls), ppr_ds (tyClGroupTyClDecls tycl_decls), ppr_ds (tyClGroupInstDecls tycl_decls), ppr_ds deriv_decls, ===================================== testsuite/tests/roles/should_compile/T16718.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, TemplateHaskell #-} + +module T16718 where + +$([d| type role P phantom + data P a + |]) ===================================== testsuite/tests/roles/should_compile/T16718.stderr ===================================== @@ -0,0 +1,7 @@ +T16718.hs:(5,3)-(7,6): Splicing declarations + [d| type role P phantom + + data P a |] + ======> + type role P phantom + data P a ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,3 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) +test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/th/T15365.stderr ===================================== @@ -4,6 +4,8 @@ T15365.hs:(9,3)-(31,6): Splicing declarations pattern (:!!!) :: Bool pattern (:!!!) = True + type role (***) + type (|||) = Either data (***) class (???) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0fff215da8bd8804ae6d044a0a6be3764125899 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0fff215da8bd8804ae6d044a0a6be3764125899 You're receiving 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 Jun 1 21:27:07 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 01 Jun 2019 17:27:07 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf2edabe4336_1c953fa9eecc943096974@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: b0c7c786 by Sebastian Graf at 2019-06-01T21:26:51Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 9 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2751,3 +2665,4 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -241,7 +167,10 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) +-- Translating HsConLikeOut to variables is wrong. Regarding it as a flexible +-- occurrence is just incorrect and as a rigid variable it is no better than a +-- PmExprOther. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -312,155 +241,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,10 +36,12 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +54,228 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + | x == y -> boring - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +283,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b0c7c786a8d4231f457d21027f27f441f4fd75f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b0c7c786a8d4231f457d21027f27f441f4fd75f9 You're receiving 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 Jun 2 07:11:47 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sun, 02 Jun 2019 03:11:47 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf376b316ef7_1c953faa4382c35098346a@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: c114a8c1 by Sebastian Graf at 2019-06-02T07:11:34Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 9 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2751,3 +2665,4 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -241,7 +167,10 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) +-- Translating HsConLikeOut to variables is wrong. Regarding it as a flexible +-- occurrence is just incorrect and as a rigid variable it is no better than a +-- PmExprOther. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -312,155 +241,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,10 +36,12 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +54,228 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + | x == y -> boring - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +283,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c114a8c16eb33bd9b35fe524932ab42e358d88a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c114a8c16eb33bd9b35fe524932ab42e358d88a7 You're receiving 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 Jun 2 14:05:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 02 Jun 2019 10:05:48 -0400 Subject: [Git][ghc/ghc][wip/T16715] make: Fix bindist installation Message-ID: <5cf3d7bc3e65a_1c95d3b2d5899383@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16715 at Glasgow Haskell Compiler / GHC Commits: 77d18eea by Ben Gamari at 2019-06-02T14:05:40Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 2 changed files: - ghc.mk - ghc/ghc.mk Changes: ===================================== ghc.mk ===================================== @@ -1037,7 +1037,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/77d18eea62fdeedc46a8f0b14e1d9d51bcd3a530 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/77d18eea62fdeedc46a8f0b14e1d9d51bcd3a530 You're receiving 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 Jun 2 14:12:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 02 Jun 2019 10:12:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-windows-ghc Message-ID: <5cf3d9628ae9c_1c95d3b2d589953d5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/bump-windows-ghc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/bump-windows-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 Jun 2 19:08:13 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sun, 02 Jun 2019 15:08:13 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf41e9d5b23a_1c953faa4382c35010258fb@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 57871c70 by Sebastian Graf at 2019-06-02T19:06:49Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 11 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -578,7 +579,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -626,7 +627,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -652,7 +653,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1457,7 +1458,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1654,7 +1655,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1672,21 +1673,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2053,8 +2048,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2116,7 +2110,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2136,7 +2131,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2401,7 +2397,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2414,7 +2410,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2478,21 +2474,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2532,10 +2522,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2546,7 +2537,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2618,8 +2609,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2633,87 +2624,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2751,3 +2665,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,13 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +54,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +71,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +147,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +158,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +166,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr -hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) +-- Translating HsVar to flexible meta variables in the unification problem is +-- incorrect. These already have a fixed but unknown definition. It's better to +-- regard them as rigid meta variables (which we can't at this point). +-- Remember, this is the expression rather than the pattern match syntax. +-- For an example for why we don't want this, consider `dictVarsAreTypeIndexed` +-- in `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- If it weren't for dictionary variables, we'd still face the same issues as +-- the HsConLikeOut case below. Better translate it as PmExprOther. +-- hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -312,155 +250,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -32,10 +36,12 @@ import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +54,227 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> symmetric (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state + | x == y -> boring - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + | otherwise -> extendSubstAndSolve x e2 tms + (_, PmExprVar{}) -> symmetric - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + symmetric = unify tms (e2, e1) --- | Extend the substitution and solve the (possibly updated) constraints. +-- | Extend the substitution if compatible with refutable shapes, reject +-- (@Nothing@) otherwise. extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e TmS{ tm_pos = pos, tm_neg = neg } + | isRefutable x e' neg -- NB: e', the flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +282,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -324,6 +324,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,42 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible +-- meta variables. If we did, we'd get a warning that the +-- first two cases were redundant, implying the latter two are +-- not. Arguably this might be better than not warning at all, +-- but it's very surprising having to supply the third case +-- but not the first two cases. And it's probably buggy +-- somwhere else. Delete this when we detect that all but the +-- last case is redundant. +consAreRigid :: Int +consAreRigid = case (False, False) of + (True, False) -> 0 + (False, True) -> 1 + (True, True) -> 2 + (False, False) -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we +-- did, the following would warn that the first two cases were +-- redundant, which is clearly wrong (the first case is the +-- only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement +-- 'hsExprToPmExpr' in terms of 'CoreExpr', we'd see the type +-- application and all would be well. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case (d :: D Int, d :: D Bool) of + (A, B) -> 0 + (B, A) -> 1 + (A, A) -> 2 + (B, B) -> 3 ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -120,3 +120,5 @@ test('EmptyCase009', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('EmptyCase010', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/57871c70e86492fbf0c08f24a2d91c5f7341d223 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/57871c70e86492fbf0c08f24a2d91c5f7341d223 You're receiving 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 Jun 2 19:39:04 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 02 Jun 2019 15:39:04 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] 40 commits: Break up `Settings` into smaller structs Message-ID: <5cf425d87456e_1c953faa4382c35010312a6@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 111c4df9 by Vladislav Zavialov at 2019-06-02T19:30:06Z WIP: Top-level kind signatures - - - - - bb0a631c by Vladislav Zavialov at 2019-06-02T19:30:06Z TLKSs instead of CUSKs in tests - - - - - 30 changed files: - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/hsSyn/HsDecls.hs - compiler/hsSyn/HsExtension.hs - compiler/hsSyn/HsInstances.hs - compiler/hsSyn/HsTypes.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - + compiler/main/FileSettings.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/184750ca908737dd5a9811f1f76b947f66d07a64...bb0a631ce3d53b6e3b2b1e567a71cc91a32a418d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/184750ca908737dd5a9811f1f76b947f66d07a64...bb0a631ce3d53b6e3b2b1e567a71cc91a32a418d You're receiving 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 Jun 2 21:54:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 02 Jun 2019 17:54:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Fix rewriting invalid shifts to errors Message-ID: <5cf445a1296f1_1c953fa9efcad784104008f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - f6fe90d3 by Takenobu Tani at 2019-06-02T21:54:36Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 8f8c0eb8 by Takenobu Tani at 2019-06-02T21:54:36Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - 805fc5f8 by Takenobu Tani at 2019-06-02T21:54:36Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 788c8723 by Ben Gamari at 2019-06-02T21:54:36Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 9 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - compiler/prelude/PrelRules.hs - rts/sm/CNF.h - + testsuite/tests/codeGen/should_compile/T16449_1.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_run/T16449_2.hs - + testsuite/tests/codeGen/should_run/T16449_2.stderr - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== .circleci/prepare-system.sh ===================================== @@ -30,6 +30,7 @@ BuildFlavour=$BUILD_FLAVOUR ifneq "\$(BuildFlavour)" "" include mk/flavours/\$(BuildFlavour).mk endif +GhcLibHcOpts+=-haddock EOF case "$(uname)" in ===================================== .gitlab-ci.yml ===================================== @@ -552,14 +552,14 @@ validate-x86_64-linux-fedora27: cache: paths: - cabal-cache - - ghc-8.6.2 + - ghc-8.6.5 - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.6.2" + GHC_VERSION: "8.6.5" # due to #16574 this currently fails allow_failure: true script: @@ -601,13 +601,14 @@ nightly-i386-windows-hadrian: allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.6.2" + GHC_VERSION: "8.6.5" BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-mingw32.tar.xz" script: - | python boot bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" + - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1" - bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -467,13 +467,16 @@ shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr -- Used for shift primops -- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word# -- SllOp, SrlOp :: Word# -> Int# -> Word# --- See Note [Guarding against silly shifts] shiftRule shift_op = do { dflags <- getDynFlags ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs ; case e1 of _ | shift_len == 0 -> return e1 + -- See Note [Guarding against silly shifts] + | shift_len < 0 || shift_len > wordSizeInBits dflags + -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + ("Bad shift length " ++ show shift_len) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) ===================================== rts/sm/CNF.h ===================================== @@ -15,9 +15,6 @@ #include "BeginPrivate.h" -void initCompact (void); -void exitCompact (void); - StgCompactNFData *compactNew (Capability *cap, StgWord size); void compactResize(Capability *cap, ===================================== testsuite/tests/codeGen/should_compile/T16449_1.hs ===================================== @@ -0,0 +1,8 @@ +module T16449_1 where + +import Data.Bits (setBit) + +f :: Int +f = foldl setter 0 $ zip [0..] [()] + where + setter v (ix, _) = setBit v ix ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -59,3 +59,5 @@ test('T15155', test('T15155l', when(unregisterised(), skip), makefile_test, []) + +test('T16449_1', normal, compile, ['']) ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Prim +import GHC.Int + +-- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. +main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr ===================================== @@ -0,0 +1 @@ +T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,3 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) +test('T16449_2', exit_code(1), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/26736f3c71df568f5fb71e2fb25d2534efb94759...788c8723fbee7e0e8a451ff0cab1b7ca434830e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/26736f3c71df568f5fb71e2fb25d2534efb94759...788c8723fbee7e0e8a451ff0cab1b7ca434830e8 You're receiving 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 Jun 3 02:54:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 02 Jun 2019 22:54:47 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Add `-haddock` option under ci condition to fix #16415 Message-ID: <5cf48bf7635a0_1c953faa3679999010449e4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 2 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml Changes: ===================================== .circleci/prepare-system.sh ===================================== @@ -30,6 +30,7 @@ BuildFlavour=$BUILD_FLAVOUR ifneq "\$(BuildFlavour)" "" include mk/flavours/\$(BuildFlavour).mk endif +GhcLibHcOpts+=-haddock EOF case "$(uname)" in ===================================== .gitlab-ci.yml ===================================== @@ -608,6 +608,7 @@ nightly-i386-windows-hadrian: python boot bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" + - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1" - bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2e297b36169208939528d962724679c5756e9e7c...c4f94320a7048a7f263d8d952d4e12cc0227cf72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2e297b36169208939528d962724679c5756e9e7c...c4f94320a7048a7f263d8d952d4e12cc0227cf72 You're receiving 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 Jun 3 02:55:22 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 02 Jun 2019 22:55:22 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Use GHC 8.6.5 for Windows CI builds Message-ID: <5cf48c1a88a75_1c953faa4382c35010481eb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -552,14 +552,14 @@ validate-x86_64-linux-fedora27: cache: paths: - cabal-cache - - ghc-8.6.2 + - ghc-8.6.5 - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.6.2" + GHC_VERSION: "8.6.5" # due to #16574 this currently fails allow_failure: true script: @@ -601,7 +601,7 @@ nightly-i386-windows-hadrian: allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.6.2" + GHC_VERSION: "8.6.5" BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-mingw32.tar.xz" script: - | View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/799b1d26977b5841aa580e07c8f8e65356eed785 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/799b1d26977b5841aa580e07c8f8e65356eed785 You're receiving 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 Jun 3 06:11:40 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 02:11:40 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] 73 commits: Add PlainPanic for throwing exceptions without depending on pprint Message-ID: <5cf4ba1c2d41_1c953fa9efcb5c0410599d8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - cd28b81c by Sebastian Graf at 2019-06-03T06:11:37Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/iface/BinFingerprint.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/57871c70e86492fbf0c08f24a2d91c5f7341d223...cd28b81c3648201f0bacc03d9becb70507736dc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/57871c70e86492fbf0c08f24a2d91c5f7341d223...cd28b81c3648201f0bacc03d9becb70507736dc5 You're receiving 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 Jun 3 08:23:45 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 04:23:45 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf4d9116f4c4_1c953fa9f344f2641071631@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 579dad5f by Sebastian Graf at 2019-06-03T08:23:31Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 13 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible +-- meta variables. If we did, we'd get a warning that the +-- first two cases were redundant, implying the latter two are +-- not. Arguably this might be better than not warning at all, +-- but it's very surprising having to supply the third case +-- but not the first two cases. And it's probably buggy +-- somwhere else. Delete this when we detect that all but the +-- last case is redundant. +consAreRigid :: Int +consAreRigid = case (False, False) of + (True, False) -> 0 + (False, True) -> 1 + (True, True) -> 2 + (False, False) -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we +-- did, the following would warn that the first two cases were +-- redundant, which is clearly wrong (the first case is the +-- only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement +-- 'hsExprToPmExpr' in terms of 'CoreExpr', we'd see the type +-- application and all would be well. +-- The solution is to look into the outer 'HsWrap' and +-- determine whether we apply or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case (d :: D Int, d :: D Bool) of + (A, B) -> 0 + (B, A) -> 1 + (A, A) -> 2 + (B, B) -> 3 ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -120,3 +120,7 @@ test('EmptyCase009', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('EmptyCase010', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/579dad5f62270322d8cf5a9d3942c53a8c3c2d81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/579dad5f62270322d8cf5a9d3942c53a8c3c2d81 You're receiving 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 Jun 3 10:30:13 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 06:30:13 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf4f6b55e2f9_1c95426b23c10887b8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: fae2c459 by Sebastian Graf at 2019-06-03T10:30:00Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 14 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,42 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that the first two cases were redundant, +-- implying the latter two are not. Arguably this might be better than not +-- warning at all, but it's very surprising having to supply the third case but +-- not the first two cases. And it's probably buggy somwhere else. Delete this +-- when we detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case (False, False) of + (True, False) -> 0 + (False, True) -> 1 + (True, True) -> 2 + (False, False) -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the type application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -120,3 +120,7 @@ test('EmptyCase009', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('EmptyCase010', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fae2c45982adbfb33d39ca2b63b431ef6435504e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fae2c45982adbfb33d39ca2b63b431ef6435504e You're receiving 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 Jun 3 10:33:00 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 06:33:00 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf4f75ca1f9d_1c95e4e26a010894b2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: a4a2ef61 by Sebastian Graf at 2019-06-03T10:32:49Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 14 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,42 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that the first two cases were redundant, +-- implying the latter two are not. Arguably this might be better than not +-- warning at all, but it's very surprising having to supply the third case but +-- not the first two cases. And it's probably buggy somwhere else. Delete this +-- when we detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case (False, False) of + (True, False) -> 0 + (False, True) -> 1 + (True, True) -> 2 + (False, False) -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -120,3 +120,7 @@ test('EmptyCase009', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('EmptyCase010', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a4a2ef61ce39ff67aa9bd67e6c3e69ec40c4c2ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a4a2ef61ce39ff67aa9bd67e6c3e69ec40c4c2ed You're receiving 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 Jun 3 11:37:57 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 07:37:57 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf50695b4cc8_1c95426b23c1105226@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: c94e029e by Sebastian Graf at 2019-06-03T11:37:45Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 14 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -120,3 +120,7 @@ test('EmptyCase009', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('EmptyCase010', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c94e029ec4cc27a8cd8bc3687675c155bd002749 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c94e029ec4cc27a8cd8bc3687675c155bd002749 You're receiving 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 Jun 3 12:49:46 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 08:49:46 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf5176a74d4b_1c953fa9ee19ee4811115d5@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: 1d71b802 by Sebastian Graf at 2019-06-03T12:49:32Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 15 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - + testsuite/tests/pmcheck/should_compile/T12949.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | Nothing <- find (== x) set = x:set + | otherwise = set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/T12949.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T12949 where + +class Foo a where + foo :: Maybe a + +data Result a b = Neither | This a | That b | Both a b + +q :: forall a b . (Foo a, Foo b) => Result a b +q = case foo :: Maybe a of + Nothing -> case foo :: Maybe b of + Nothing -> Neither + Just c -> That c + Just i -> case foo :: Maybe b of + Nothing -> This i + Just c -> Both i c ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -94,8 +94,13 @@ test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T12949', [], compile, ['-fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) test('T12957a', [], compile, ['-fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # EmptyCase test('T10746', [], compile, ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1d71b80229bb3cef8ee9fbe0c0dd8460f7bf68c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1d71b80229bb3cef8ee9fbe0c0dd8460f7bf68c4 You're receiving 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 Jun 3 13:33:53 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 09:33:53 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf521c114c90_1c953fa9efcad78411478e5@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: affd1ceb by Sebastian Graf at 2019-06-03T13:33:41Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 15 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - + testsuite/tests/pmcheck/should_compile/T12949.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmEq -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmEq , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = (x, vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmEq +mkPosEq x l = (x, PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmEq +mkIdEq x = (x, PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,7 +2403,7 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmEq) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs @@ -2420,7 +2416,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq genCaseTmCs1 Nothing _ = emptyBag genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmEq) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmEq -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,8 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit - -- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +type TmEq = (Id, PmExpr) -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +159,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +167,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +233,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +256,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -48,199 +55,244 @@ import NameEnv -- | The type of substitutions. type PmVarEnv = NameEnv PmExpr --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !PmVarEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [3,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + +-- | Flatten the triangular subsitution. +flattenPmVarEnv :: PmVarEnv -> PmVarEnv +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmEq -> Maybe TmState +solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, _) -> extendSubstAndSolve x e2 tms + (_, PmExprVar y) -> extendSubstAndSolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is not @y@, where @y@ is in the equivalence class +-- represented by @x at . extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) +extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _assert_is_not_cyclic ) + isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + = Nothing + | otherwise + = Just (TmS new_pos new_neg) where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + new_pos = extendNameEnv pos x e + (y, e') = varDeepLookup new_pos x + -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' + neg' | x == y = neg + | otherwise = case lookupDNameEnv neg x of + Nothing -> neg + Just nalts -> + alterDNameEnv (delNulls (unionLists nalts)) neg y + new_neg = delFromDNameEnv neg' x + _assert_is_not_cyclic = case e of + PmExprVar z -> fst (varDeepLookup pos z) /= x + _ -> True -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmEq] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +300,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | elem x set = set + | otherwise = x:set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/T12949.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T12949 where + +class Foo a where + foo :: Maybe a + +data Result a b = Neither | This a | That b | Both a b + +q :: forall a b . (Foo a, Foo b) => Result a b +q = case foo :: Maybe a of + Nothing -> case foo :: Maybe b of + Nothing -> Neither + Just c -> That c + Just i -> case foo :: Maybe b of + Nothing -> This i + Just c -> Both i c ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -94,8 +94,13 @@ test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T12949', [], compile, ['-fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) test('T12957a', [], compile, ['-fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # EmptyCase test('T10746', [], compile, ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/affd1ceb4f1f080fc1cf639bbcf1b544bb0b92df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/affd1ceb4f1f080fc1cf639bbcf1b544bb0b92df You're receiving 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 Jun 3 15:01:22 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 03 Jun 2019 11:01:22 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 74 commits: Add PlainPanic for throwing exceptions without depending on pprint Message-ID: <5cf53642d1c45_1c953faa1cac48b411643bf@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - affd1ceb by Sebastian Graf at 2019-06-03T13:33:41Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 37a06c03 by Sebastian Graf at 2019-06-03T15:01:13Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/iface/BinFingerprint.hs - + compiler/main/CliOption.hs - compiler/main/CodeOutput.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e2f1875d8dd5c2fa92c9c84531c55b5b73e2dd6...37a06c03e24c3ef31bb7c643c3bb2c30bb3215c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e2f1875d8dd5c2fa92c9c84531c55b5b73e2dd6...37a06c03e24c3ef31bb7c643c3bb2c30bb3215c5 You're receiving 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 Jun 3 15:36:57 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 03 Jun 2019 11:36:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16735 Message-ID: <5cf53e998d249_1c953fa9efcad7841173111@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T16735 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16735 You're receiving 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 Jun 3 15:58:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 11:58:03 -0400 Subject: [Git][ghc/ghc][wip/run-bindisttest] 37 commits: Use binary search to speedup checkUnload Message-ID: <5cf5438b366f7_1c953fa9efcad7841182368@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/run-bindisttest at Glasgow Haskell Compiler / GHC Commits: f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - a007121e by Ben Gamari at 2019-06-03T15:57:54Z gitlab-ci: Run bindisttest during CI - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/coreSyn/CoreArity.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - compiler/prelude/PrelRules.hs - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - docs/users_guide/runtime_control.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Arr.hs - libraries/base/GHC/Conc/Sync.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7300ee87460c498d45ae47399f6a8db57babed7f...a007121e168e0de890872f446b8d70d836db936a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7300ee87460c498d45ae47399f6a8db57babed7f...a007121e168e0de890872f446b8d70d836db936a You're receiving 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 Jun 3 16:22:13 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 12:22:13 -0400 Subject: [Git][ghc/ghc][wip/run-bindisttest] make: Fix bindist installation Message-ID: <5cf549358b892_1c953fa9efcad7841184345@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/run-bindisttest at Glasgow Haskell Compiler / GHC Commits: 36aa1484 by Ben Gamari at 2019-06-03T16:21:54Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 2 changed files: - ghc.mk - ghc/ghc.mk Changes: ===================================== ghc.mk ===================================== @@ -1037,7 +1037,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/36aa1484727f5c7d2ada416764976d13d6f9a42d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/36aa1484727f5c7d2ada416764976d13d6f9a42d You're receiving 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 Jun 3 18:08:11 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 14:08:11 -0400 Subject: [Git][ghc/ghc][wip/T16715] 40 commits: Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cf5620bd6f3_1c953faa3354ef081201581@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16715 at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 89215c99 by Ben Gamari at 2019-06-03T18:07:30Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/coreSyn/CoreArity.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - compiler/prelude/PrelRules.hs - compiler/typecheck/TcForeign.hs - docs/users_guide/ffi-chap.rst - docs/users_guide/runtime_control.rst - ghc.mk - ghc/ghc.mk - hadrian/src/Rules/Libffi.hs - libraries/base/Data/Functor/Compose.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77d18eea62fdeedc46a8f0b14e1d9d51bcd3a530...89215c9945843e0b4338a5958485fea3e6058a1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77d18eea62fdeedc46a8f0b14e1d9d51bcd3a530...89215c9945843e0b4338a5958485fea3e6058a1c You're receiving 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 Jun 3 18:16:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 14:16:44 -0400 Subject: [Git][ghc/ghc][wip/T16715] make: Fix bindist installation Message-ID: <5cf5640cbaa74_1c953faa337165201211232@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16715 at Glasgow Haskell Compiler / GHC Commits: 59521739 by Ben Gamari at 2019-06-03T18:16:37Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 2 changed files: - ghc.mk - ghc/ghc.mk Changes: ===================================== ghc.mk ===================================== @@ -1021,6 +1021,8 @@ $(eval $(call bindist-list,.,\ $(BINDIST_LIBS) \ $(BINDIST_HI) \ $(BINDIST_EXTRAS) \ + includes/Makefile \ + $(includes_SETTINGS) \ $(includes_H_FILES) \ $(includes_DERIVEDCONSTANTS) \ $(includes_GHCCONSTANTS) \ @@ -1037,7 +1039,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/59521739010585a60e9f16e2f641d2b64a489034 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/59521739010585a60e9f16e2f641d2b64a489034 You're receiving 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 Jun 3 18:20:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 14:20:38 -0400 Subject: [Git][ghc/ghc][wip/run-bindisttest] make: Fix bindist installation Message-ID: <5cf564f6dba53_1c953fa9ee19ee48121358c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/run-bindisttest at Glasgow Haskell Compiler / GHC Commits: 713fd756 by Ben Gamari at 2019-06-03T18:19:58Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 2 changed files: - ghc.mk - ghc/ghc.mk Changes: ===================================== ghc.mk ===================================== @@ -1021,6 +1021,8 @@ $(eval $(call bindist-list,.,\ $(BINDIST_LIBS) \ $(BINDIST_HI) \ $(BINDIST_EXTRAS) \ + includes/Makefile \ + $(includes_SETTINGS) \ $(includes_H_FILES) \ $(includes_DERIVEDCONSTANTS) \ $(includes_GHCCONSTANTS) \ @@ -1037,7 +1039,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/713fd7565e156dc84cb2d33e249e409eea2b158a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/713fd7565e156dc84cb2d33e249e409eea2b158a You're receiving 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 Jun 3 20:52:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 16:52:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16741 Message-ID: <5cf5888fa20b7_1c953fa9ee19ee4812456f3@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16741 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16741 You're receiving 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 Jun 3 20:54:07 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 16:54:07 -0400 Subject: [Git][ghc/ghc][wip/T16741] testsuite: Suppress ticks in T4918 output Message-ID: <5cf588efbd4e7_1c953faa1cac48b412476dc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16741 at Glasgow Haskell Compiler / GHC Commits: 5d2d6da8 by Ben Gamari at 2019-06-03T20:53:59Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - 1 changed file: - testsuite/tests/simplCore/should_compile/Makefile Changes: ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -106,11 +106,13 @@ T4903: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903a.hs -dcore-lint '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903.hs -dcore-lint +# N.B. Suppress ticks to ensure that the test result doesn't change if `base` +# is compiled with -g. See #16741. T4918: $(RM) -f T4918.hi T4918.o T4918a.hi T4918a.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918.hs - '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4918.hi | grep 'C#' + '$(TEST_HC)' $(TEST_HC_OPTS) -dsuppress-ticks --show-iface T4918.hi | grep 'C#' EvalTest: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O EvalTest.hs -ddump-simpl -dsuppress-uniques | grep 'rght.*Dmd' | sed 's/^ *//' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5d2d6da8bb661aa2f80356d7ae4c651966aa72d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5d2d6da8bb661aa2f80356d7ae4c651966aa72d4 You're receiving 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 Jun 3 21:28:57 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 03 Jun 2019 17:28:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add `-haddock` option under ci condition to fix #16415 Message-ID: <5cf59119c1db3_1c95426b23c12828ae@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - f70a0c42 by David Eichmann at 2019-06-03T21:28:48Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - e64fb332 by Andrew Martin at 2019-06-03T21:28:49Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 30adfea0 by Alp Mestanogullari at 2019-06-03T21:28:52Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - hadrian/src/Rules/Libffi.hs - + testsuite/driver/js/Chart-2.8.0.min.js - + testsuite/driver/js/tooltip.js - testsuite/driver/perf_notes.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/ffi/should_compile/ReducingFfiSignature.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.hs - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.stderr - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/ffi/should_run/T16650a.hs - + testsuite/tests/ffi/should_run/T16650a.stdout - + testsuite/tests/ffi/should_run/T16650a_c.c - + testsuite/tests/ffi/should_run/T16650b.hs - + testsuite/tests/ffi/should_run/T16650b.stdout - + testsuite/tests/ffi/should_run/T16650b_c.c - + testsuite/tests/ffi/should_run/T16650c.hs - + testsuite/tests/ffi/should_run/T16650c.stdout - + testsuite/tests/ffi/should_run/T16650c_c.c - + testsuite/tests/ffi/should_run/T16650d.hs - + testsuite/tests/ffi/should_run/T16650d.stdout - + testsuite/tests/ffi/should_run/T16650d_c.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/788c8723fbee7e0e8a451ff0cab1b7ca434830e8...30adfea0c58166149bd3804b8622f8e794565889 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/788c8723fbee7e0e8a451ff0cab1b7ca434830e8...30adfea0c58166149bd3804b8622f8e794565889 You're receiving 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 Jun 3 22:38:06 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 18:38:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-delete-symlinks Message-ID: <5cf5a14ec6310_1c953fa9f3af834013214f9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/hadrian-delete-symlinks at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/hadrian-delete-symlinks You're receiving 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 Jun 3 22:38:27 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 18:38:27 -0400 Subject: [Git][ghc/ghc][wip/hadrian-delete-symlinks] Hadrian: Delete target symlink in createFileLinkUntracked Message-ID: <5cf5a16358c41_1c953faa3354ef0813222ec@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/hadrian-delete-symlinks at Glasgow Haskell Compiler / GHC Commits: 29478eb3 by Ben Gamari at 2019-06-03T22:38:21Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - 1 changed file: - hadrian/src/Hadrian/Utilities.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -34,6 +34,7 @@ module Hadrian.Utilities ( Dynamic, fromDynamic, toDyn, TypeRep, typeOf ) where +import Control.Applicative import Control.Monad.Extra import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) @@ -296,7 +297,9 @@ createFileLinkUntracked linkTarget link = do let dir = takeDirectory link liftIO $ IO.createDirectoryIfMissing True dir putProgressInfo =<< renderCreateFileLink linkTarget link - quietly . liftIO $ IO.createFileLink linkTarget link + quietly . liftIO $ do + IO.removeFile link <|> return () + IO.createFileLink linkTarget link -- | Link a file tracking the link target. Create the target directory if -- missing. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/29478eb3b83b05420fa04a9324c6a0b9e0f85382 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/29478eb3b83b05420fa04a9324c6a0b9e0f85382 You're receiving 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 Jun 3 22:53:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 18:53:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16738 Message-ID: <5cf5a4f87450b_1c95eb06ce8132829f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16738 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16738 You're receiving 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 Jun 3 23:07:28 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 19:07:28 -0400 Subject: [Git][ghc/ghc][wip/T16738] Maintain separate flags for C++ compiler invocations Message-ID: <5cf5a8302e051_1c95eb06ce8133294e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: 9dc5aa8b by Ben Gamari at 2019-06-03T23:07:18Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 9 changed files: - aclocal.m4 - compiler/main/SysTools.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - 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 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = map Option (words cc_args_str ++ unreg_cc_args) + cxx_args = map Option (words cxx_args_str) ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = cc_args + ld_prog = cc_prog + ld_args = cc_args ++ map Option (words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,7 +62,7 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts args2 = args0 ++ languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9dc5aa8b9e8fe0f1e6bead2fccb35d9249225d2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9dc5aa8b9e8fe0f1e6bead2fccb35d9249225d2a You're receiving 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 Jun 3 23:09:58 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 19:09:58 -0400 Subject: [Git][ghc/ghc][wip/T16738] Maintain separate flags for C++ compiler invocations Message-ID: <5cf5a8c6afa9b_1c95ed198a0133409d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: d22bec2f by Ben Gamari at 2019-06-03T23:09:47Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 10 changed files: - aclocal.m4 - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - 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 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/main/Settings.hs ===================================== @@ -119,7 +119,7 @@ sPgm_P :: Settings -> (String, [Option]) sPgm_P = toolSettings_pgm_P . sToolSettings sPgm_F :: Settings -> String sPgm_F = toolSettings_pgm_F . sToolSettings -sPgm_c :: Settings -> (String, [Option]) +sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = map Option (words cc_args_str ++ unreg_cc_args) + cxx_args = map Option (words cxx_args_str) ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = cc_args + ld_prog = cc_prog + ld_args = cc_args ++ map Option (words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,7 +62,7 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts args2 = args0 ++ languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d22bec2f9687d29082c6c71dfcdb8d42d5257b6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d22bec2f9687d29082c6c71dfcdb8d42d5257b6f You're receiving 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 Jun 3 23:27:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 19:27:54 -0400 Subject: [Git][ghc/ghc][wip/T16738] 3 commits: make: Fix bindist installation Message-ID: <5cf5acfa41fe5_1c953faa3354ef081334730@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: 59521739 by Ben Gamari at 2019-06-03T18:16:37Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 056ab647 by Ben Gamari at 2019-06-03T23:10:05Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - e49423aa by Ben Gamari at 2019-06-03T23:27:13Z DOne - - - - - 15 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - ghc.mk - ghc/ghc.mk - 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 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) + let all_paths = let paths = takeDirectory (pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/DynFlags.hs ===================================== @@ -1420,7 +1420,7 @@ pgm_P :: DynFlags -> (String,[Option]) pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags -pgm_c :: DynFlags -> (String,[Option]) +pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags @@ -3048,7 +3048,7 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" $ hasArg $ \f -> alterToolSettings $ \s -> s - { toolSettings_pgm_c = (f,[]) + { toolSettings_pgm_c = f , -- Don't pass -no-pie with -pgmc -- (see #15319) toolSettings_ccSupportsNoPie = False ===================================== compiler/main/Settings.hs ===================================== @@ -119,7 +119,7 @@ sPgm_P :: Settings -> (String, [Option]) sPgm_P = toolSettings_pgm_P . sToolSettings sPgm_F :: Settings -> String sPgm_F = toolSettings_pgm_F . sToolSettings -sPgm_c :: Settings -> (String, [Option]) +sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = words cc_args_str ++ unreg_cc_args + cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = map Option cc_args + ld_prog = cc_prog + ld_args = map Option (cc_args ++ words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Info.hs ===================================== @@ -219,7 +219,7 @@ getCompilerInfo dflags = do -- See Note [Run-time linker info]. getCompilerInfo' :: DynFlags -> IO CompilerInfo getCompilerInfo' dflags = do - let (pgm,_) = pgm_c dflags + let pgm = pgm_c dflags -- Try to grab the info from the process output. parseCompilerInfo _stdo stde _exitc -- Regular GCC ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,9 +62,9 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts - args2 = args0 ++ languageOptions ++ args ++ args1 + args2 = languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the -- user can override flags passed by GHC. See #14452. mb_env <- getGccEnv args2 @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx @@ -333,7 +337,8 @@ runMkDLL dflags args = do runWindres :: DynFlags -> [Option] -> IO () runWindres dflags args = do - let (gcc, gcc_args) = pgm_c dflags + let cc = pgm_c dflags + cc_args = map Option (sOpt_c (settings dflags)) windres = pgm_windres dflags opts = map Option (getOpts dflags opt_windres) quote x = "\"" ++ x ++ "\"" @@ -341,8 +346,7 @@ runWindres dflags args = do -- spaces then windres fails to run gcc. We therefore need -- to tell it what command to use... Option ("--preprocessor=" ++ - unwords (map quote (gcc : - map showOpt gcc_args ++ + unwords (map quote (cc : map showOpt opts ++ ["-E", "-xc", "-DRC_INVOKED"]))) -- ...but if we do that then if windres calls popen then @@ -351,7 +355,7 @@ runWindres dflags args = do -- See #1828. : Option "--use-temp-file" : args - mb_env <- getGccEnv gcc_args + mb_env <- getGccEnv cc_args runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env touch :: DynFlags -> String -> String -> IO () ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== ghc.mk ===================================== @@ -1021,6 +1021,8 @@ $(eval $(call bindist-list,.,\ $(BINDIST_LIBS) \ $(BINDIST_HI) \ $(BINDIST_EXTRAS) \ + includes/Makefile \ + $(includes_SETTINGS) \ $(includes_H_FILES) \ $(includes_DERIVEDCONSTANTS) \ $(includes_GHCCONSTANTS) \ @@ -1037,7 +1039,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d22bec2f9687d29082c6c71dfcdb8d42d5257b6f...e49423aa7a745a57234cee0436baaebbe7753443 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d22bec2f9687d29082c6c71dfcdb8d42d5257b6f...e49423aa7a745a57234cee0436baaebbe7753443 You're receiving 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 Jun 3 23:52:58 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 19:52:58 -0400 Subject: [Git][ghc/ghc][wip/T16738] Maintain separate flags for C++ compiler invocations Message-ID: <5cf5b2da9ffc5_1c953faa43bf77c8134147@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: d0c03112 by Ben Gamari at 2019-06-03T23:52:44Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 13 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - 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 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) + let all_paths = let paths = takeDirectory (pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/DynFlags.hs ===================================== @@ -1420,7 +1420,7 @@ pgm_P :: DynFlags -> (String,[Option]) pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags -pgm_c :: DynFlags -> (String,[Option]) +pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags @@ -3048,7 +3048,7 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" $ hasArg $ \f -> alterToolSettings $ \s -> s - { toolSettings_pgm_c = (f,[]) + { toolSettings_pgm_c = f , -- Don't pass -no-pie with -pgmc -- (see #15319) toolSettings_ccSupportsNoPie = False ===================================== compiler/main/Settings.hs ===================================== @@ -119,7 +119,7 @@ sPgm_P :: Settings -> (String, [Option]) sPgm_P = toolSettings_pgm_P . sToolSettings sPgm_F :: Settings -> String sPgm_F = toolSettings_pgm_F . sToolSettings -sPgm_c :: Settings -> (String, [Option]) +sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = words cc_args_str ++ unreg_cc_args + cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = map Option cc_args + ld_prog = cc_prog + ld_args = map Option (cc_args ++ words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Info.hs ===================================== @@ -219,7 +219,7 @@ getCompilerInfo dflags = do -- See Note [Run-time linker info]. getCompilerInfo' :: DynFlags -> IO CompilerInfo getCompilerInfo' dflags = do - let (pgm,_) = pgm_c dflags + let pgm = pgm_c dflags -- Try to grab the info from the process output. parseCompilerInfo _stdo stde _exitc -- Regular GCC ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,9 +62,9 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts - args2 = args0 ++ languageOptions ++ args ++ args1 + args2 = languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the -- user can override flags passed by GHC. See #14452. mb_env <- getGccEnv args2 @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx @@ -333,7 +337,8 @@ runMkDLL dflags args = do runWindres :: DynFlags -> [Option] -> IO () runWindres dflags args = do - let (gcc, gcc_args) = pgm_c dflags + let cc = pgm_c dflags + cc_args = map Option (sOpt_c (settings dflags)) windres = pgm_windres dflags opts = map Option (getOpts dflags opt_windres) quote x = "\"" ++ x ++ "\"" @@ -341,8 +346,7 @@ runWindres dflags args = do -- spaces then windres fails to run gcc. We therefore need -- to tell it what command to use... Option ("--preprocessor=" ++ - unwords (map quote (gcc : - map showOpt gcc_args ++ + unwords (map quote (cc : map showOpt opts ++ ["-E", "-xc", "-DRC_INVOKED"]))) -- ...but if we do that then if windres calls popen then @@ -351,7 +355,7 @@ runWindres dflags args = do -- See #1828. : Option "--use-temp-file" : args - mb_env <- getGccEnv gcc_args + mb_env <- getGccEnv cc_args runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env touch :: DynFlags -> String -> String -> IO () ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0c03112fde37e2354161390a946155b7c2a462d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d0c03112fde37e2354161390a946155b7c2a462d You're receiving 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 Jun 4 01:19:15 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 21:19:15 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 234 commits: [skip ci] Update CI badge in readme Message-ID: <5cf5c713c8235_1c953fa9ee19ee481348331@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 469feff3 by Ben Gamari at 2019-06-04T01:18:14Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 562fe95b by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - ffe25119 by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Make closureSize less sensitive to optimisation - - - - - 5ca9aaa2 by Ben Gamari at 2019-06-04T01:18:14Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - e6a5870a by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 72cbe65a by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 5b1b2f65 by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Mark T14272 as broken in optasm - - - - - 2e5318c1 by Ben Gamari at 2019-06-04T01:18:14Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - d8c9dc23 by Ben Gamari at 2019-06-04T01:18:54Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 21400d4a by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - b9e6bb44 by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 956eb223 by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 267b4677 by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 1c5ebccc by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 85a9059d by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Fix fragile_for test modifier - - - - - c39bba7d by Ben Gamari at 2019-06-04T01:18:55Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 97b986ee by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - cc3f9edd by Ben Gamari at 2019-06-04T01:18:55Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitignore - .gitlab-ci.yml - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmExpr.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CorePrep.hs - compiler/coreSyn/CoreUnfold.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsExpr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3eda117ef13183fd4eca3a8e65a12255bfe69d05...cc3f9eddb7bd565a5cb6e9aa9eb0d387117ac256 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3eda117ef13183fd4eca3a8e65a12255bfe69d05...cc3f9eddb7bd565a5cb6e9aa9eb0d387117ac256 You're receiving 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 Jun 4 01:20:19 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 21:20:19 -0400 Subject: [Git][ghc/ghc][wip/slowtest] testsuite: Omit profasm way for cc017 Message-ID: <5cf5c753eff5b_1c953fa9ee19ee48134958b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 593d5726 by Ben Gamari at 2019-06-04T01:19:43Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 1 changed file: - testsuite/tests/ffi/should_compile/all.T Changes: ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -34,7 +34,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/593d5726bc8f49a897f075ed9ed5a68258f2e446 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/593d5726bc8f49a897f075ed9ed5a68258f2e446 You're receiving 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 Jun 4 01:21:35 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 21:21:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16742 Message-ID: <5cf5c79fa173_1c95d5d159413501ab@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16742 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16742 You're receiving 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 Jun 4 02:09:26 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 22:09:26 -0400 Subject: [Git][ghc/ghc][wip/T16742] Allow runtimeError applications under let/app invariant Message-ID: <5cf5d2d6533df_1c95eb06ce813609cf@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: fafdc6ac by Ben Gamari at 2019-06-04T02:09:12Z Allow runtimeError applications under let/app invariant PrelRules.shiftRule can now rewrite Int# expressions to bottom due to the invalid-shift check introduced by 1503da32d26fb59fb6ebb620bfd0f8c08638f627. To accomodate this we allow known-bottoming expressions under the let/app invariant. - - - - - 2 changed files: - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreSyn.hs Changes: ===================================== compiler/coreSyn/CoreLint.hs ===================================== @@ -536,7 +536,8 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) ; checkL ( isJoinId binder || not (isUnliftedType binder_ty) || (isNonRec rec_flag && exprOkForSpeculation rhs) - || exprIsTickedString rhs) + || exprIsTickedString rhs + ) (badBndrTyMsg binder (text "unlifted")) -- Check that if the binder is top-level or recursive, it's not @@ -1018,7 +1019,7 @@ lintCoreArg fun_ty arg (ppr arg <+> dcolon <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty)))) -- check for levity polymorphism first, because otherwise isUnliftedType panics - ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) + ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg || exprIsBottom arg) (mkLetAppMsg arg) ; lintValApp arg fun_ty arg_ty } ===================================== compiler/coreSyn/CoreSyn.hs ===================================== @@ -420,9 +420,9 @@ parts of the compilation pipeline. Note [CoreSyn let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The let/app invariant - the right hand side of a non-recursive 'Let', and - the argument of an 'App', +The let/app invariant: + the right hand side of a non-recursive 'Let', and + the argument of an 'App', /may/ be of unlifted type, but only if the expression is ok-for-speculation or the 'Let' is for a join point. @@ -445,6 +445,14 @@ which will generate a @case@ if necessary The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in coreSyn/MkCore. +One notable exception to this rule is bottoming expressions. For instance, we +allow + + y::Int = I# (runtimeError ...) + +since we sometimes need to make unlifted bindings bottom (e.g. see +PrelRules.shiftRule). + Note [CoreSyn type and coercion invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow a /non-recursive/, /non-top-level/ let to bind type and View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fafdc6accc987e09fc14172ea1c6e8d70faae73c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fafdc6accc987e09fc14172ea1c6e8d70faae73c You're receiving 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 Jun 4 02:31:16 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 22:31:16 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Ensure that shift rule result type is correct Message-ID: <5cf5d7f4eafd9_1c953faa43bf77c8137042f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 3c44d909 by Ben Gamari at 2019-06-04T02:30:25Z PrelRules: Ensure that shift rule result type is correct Previously shiftRule would always produce a wordPrimTy result, despite the fact that some of the primops which it handled were of type intPrimTy. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -134,11 +134,11 @@ primOpRules nm NotIOp = mkPrimOpRule nm 1 [ unaryLit complementOp , inversePrimOp NotIOp ] primOpRules nm IntNegOp = mkPrimOpRule nm 1 [ unaryLit negOp , inversePrimOp IntNegOp ] -primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) +primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) intPrimTy , rightIdentityDynFlags zeroi ] -primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR) +primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR) intPrimTy , rightIdentityDynFlags zeroi ] -primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical +primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical intPrimTy , rightIdentityDynFlags zeroi ] -- Word operations @@ -180,8 +180,8 @@ primOpRules nm XorOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , equalArgs >> retLit zerow ] primOpRules nm NotOp = mkPrimOpRule nm 1 [ unaryLit complementOp , inversePrimOp NotOp ] -primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ] -primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ] +primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) wordPrimTy ] +primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical wordPrimTy ] -- coercions primOpRules nm Word2IntOp = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit @@ -462,12 +462,12 @@ wordOpC2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _) = wordCResult dflags (fromInteger w1 `op` fromInteger w2) wordOpC2 _ _ _ _ = Nothing -- Could find LitLit -shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr +shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> Type -> RuleM CoreExpr -- Shifts take an Int; hence third arg of op is Int -- Used for shift primops -- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word# -- SllOp, SrlOp :: Word# -> Int# -> Word# -shiftRule shift_op +shiftRule shift_op resultTy = do { dflags <- getDynFlags ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs ; case e1 of @@ -475,7 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID resultTy ("Bad shift length " ++ show shift_len) -- Do the shift at type Integer, but shift length is Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3c44d90954a64d83217f300e6508a21f13ccbb70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3c44d90954a64d83217f300e6508a21f13ccbb70 You're receiving 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 Jun 4 03:37:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 23:37:39 -0400 Subject: [Git][ghc/ghc][ghc-8.8] Fix optSemi type in Parser.y Message-ID: <5cf5e7837639a_1c953faa43bf77c81389373@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 605869c7 by Vladislav Zavialov at 2019-06-03T21:28:12Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - 1 changed file: - compiler/parser/Parser.y Changes: ===================================== compiler/parser/Parser.y ===================================== @@ -1,4 +1,3 @@ - -- -*-haskell-*- -- --------------------------------------------------------------------------- -- (c) The University of Glasgow 1997-2003 @@ -2586,7 +2585,7 @@ exp10 :: { LHsExpr GhcPs } | scc_annot exp {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) (fst $ fst $ unLoc $1) } -optSemi :: { ([Located a],Bool) } +optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/605869c7b776ce6071a31ff447998b081e0354ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/605869c7b776ce6071a31ff447998b081e0354ed You're receiving 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 Jun 4 03:41:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 23:41:38 -0400 Subject: [Git][ghc/ghc][cherry-pick-e172a6d1] 3 commits: Fix #16603 by documenting some important changes in changelogs Message-ID: <5cf5e872a6c02_1c95d5d159413916f2@gitlab.haskell.org.mail> Ben Gamari pushed to branch cherry-pick-e172a6d1 at Glasgow Haskell Compiler / GHC Commits: 334dd6da by Ryan Scott at 2019-05-08T13:31:22Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 605869c7 by Vladislav Zavialov at 2019-06-03T21:28:12Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - 07131494 by Alp Mestanogullari at 2019-06-04T03:41:36Z Enable external interpreter when TH is requested but no internal interpreter is available (cherry picked from commit e172a6d127a65b945b31306ff7b6c43320debfb4) - - - - - 4 changed files: - compiler/main/DriverPipeline.hs - compiler/parser/Parser.y - docs/users_guide/8.8.1-notes.rst - libraries/base/changelog.md Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -258,16 +258,23 @@ compileOne' m_tc_result mHscMessage then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 + -- #16331 - when no "internal interpreter" is available but we + -- need to process some TemplateHaskell or QuasiQuotes, we automatically + -- turn on -fexternal-interpreter. + dflags2 = if not internalInterpreter && needsLinker + then gopt_set dflags1 Opt_ExternalInterpreter + else dflags1 + basename = dropExtension input_fn -- We add the directory in which the .hs files resides) to the import -- path. This is needed when we try to compile the .hc file later, if it -- imports a _stub.h file that we created here. current_dir = takeDirectory basename - old_paths = includePaths dflags1 + old_paths = includePaths dflags2 !prevailing_dflags = hsc_dflags hsc_env0 dflags = - dflags1 { includePaths = addQuoteInclude old_paths [current_dir] + dflags2 { includePaths = addQuoteInclude old_paths [current_dir] , log_action = log_action prevailing_dflags } -- use the prevailing log_action / log_finaliser, -- not the one cached in the summary. This is so ===================================== compiler/parser/Parser.y ===================================== @@ -1,4 +1,3 @@ - -- -*-haskell-*- -- --------------------------------------------------------------------------- -- (c) The University of Glasgow 1997-2003 @@ -2586,7 +2585,7 @@ exp10 :: { LHsExpr GhcPs } | scc_annot exp {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) (fst $ fst $ unLoc $1) } -optSemi :: { ([Located a],Bool) } +optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -23,6 +23,21 @@ Full details Language ~~~~~~~~ +- GHC now supports visible kind applications, as described in + `GHC proposal #15 `__. This extends the existing + :ref:`visible type applications ` feature to permit + type applications at the type level (e.g., ``f :: Proxy ('Just @Bool 'True)``) in + addition to the term level (e.g., ``g = Just @Bool True``). + +- GHC now allows explicitly binding type variables in type family instances and + rewrite rules, as described in + `GHC proposal #7 `__. For instance: :: + + type family G a b where + forall x y. G [x] (Proxy y) = Double + forall z. G z z = Bool + {-# RULES "example" forall a. forall (x :: a). id x = x #-} + - :extension:`ScopedTypeVariables`: The type variable that a type signature on a pattern can bring into scope can now stand for arbitrary types. Previously, they could only stand in for other type variables, but this restriction was deemed @@ -76,6 +91,13 @@ Language Compiler ~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. + Accordingly, the ``MonadFailDesugaring`` language extension is now + deprecated, as its effects are always enabled. Similarly, the + ``-Wnoncanonical-monadfail-instances`` flag is also deprecated, as there is + no longer any way to define a "non-canonical" ``Monad`` or ``MonadFail`` + instance. + - New :ghc-flag:`-keep-hscpp-files` to keep the output of the CPP pre-processor. - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. @@ -134,6 +156,13 @@ Template Haskell longer included when reifying ``C``. It's possible that this may break some code which assumes the existence of ``forall a. C a =>``. +- Template Haskell has been updated to support visible kind applications and + explicit ``foralls`` in type family instances and ``RULES``. These required + a couple of backwards-incompatible changes to the ``template-haskell`` API. + Please refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Template Haskell now supports implicit parameters and recursive do. - Template Haskell splices can now embed assembler source (:ghc-ticket:`16180`) @@ -156,6 +185,20 @@ Template Haskell ``base`` library ~~~~~~~~~~~~~~~~ +- The final phase of the ``MonadFail`` proposal has been implemented. As a + result of this change: + + - The ``fail`` method of ``Monad`` has been removed in favor of the method of + the same name in the ``MonadFail`` class. + + - ``MonadFail(fail)`` is now re-exported from the ``Prelude`` and + ``Control.Monad`` modules. + + These are breaking changes that may require you to update your code. Please + refer to the + `GHC 8.8 Migration Guide `__ + for more details. + - Support the characters from recent versions of Unicode (up to v. 12) in literals (see :ghc-ticket:`5518`). ===================================== libraries/base/changelog.md ===================================== @@ -3,6 +3,14 @@ ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* + * The final phase of the `MonadFail` proposal has been implemented: + + * The `fail` method of `Monad` has been removed in favor of the method of + the same name in the `MonadFail` class. + + * `MonadFail(fail)` is now re-exported from the `Prelude` and + `Control.Monad` modules. + * Fix `Show` instance of `Data.Fixed`: Negative numbers are now parenthesized according to their surrounding context. I.e. `Data.Fixed.show` produces syntactically correct Haskell for expressions like `Just (-1 :: Fixed E2)`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0cf2cdbb5b5bd751b0f9c9a8fce4b432688c6db5...07131494e77f4c985c2cef369238dc8e83a98a90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0cf2cdbb5b5bd751b0f9c9a8fce4b432688c6db5...07131494e77f4c985c2cef369238dc8e83a98a90 You're receiving 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 Jun 4 03:42:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 23:42:29 -0400 Subject: [Git][ghc/ghc][cherry-pick-43a43a33] 2 commits: Fix optSemi type in Parser.y Message-ID: <5cf5e8a5af35f_1c95d5d159413937bf@gitlab.haskell.org.mail> Ben Gamari pushed to branch cherry-pick-43a43a33 at Glasgow Haskell Compiler / GHC Commits: 605869c7 by Vladislav Zavialov at 2019-06-03T21:28:12Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - 0b91a029 by Krzysztof Gogolewski at 2019-06-04T03:42:27Z Handle hs-boot files in -Wmissing-home-modules (#16551) (cherry picked from commit 43a43a3319d68c1692df6acdf283109cb5c030d8) - - - - - 7 changed files: - compiler/main/GhcMake.hs - compiler/parser/Parser.y - + testsuite/tests/warnings/should_compile/T16551.stderr - + testsuite/tests/warnings/should_compile/T16551/A.hs - + testsuite/tests/warnings/should_compile/T16551/B.hs - + testsuite/tests/warnings/should_compile/T16551/B.hs-boot - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/main/GhcMake.hs ===================================== @@ -184,6 +184,10 @@ warnMissingHomeModules hsc_env mod_graph = is_my_target mod (TargetFile target_file _) | Just mod_file <- ml_hs_file (ms_location mod) = target_file == mod_file || + + -- Don't warn on B.hs-boot if B.hs is specified (#16551) + addBootSuffix target_file == mod_file || + -- We can get a file target even if a module name was -- originally specified in a command line because it can -- be converted in guessTarget (by appending .hs/.lhs). ===================================== compiler/parser/Parser.y ===================================== @@ -1,4 +1,3 @@ - -- -*-haskell-*- -- --------------------------------------------------------------------------- -- (c) The University of Glasgow 1997-2003 @@ -2586,7 +2585,7 @@ exp10 :: { LHsExpr GhcPs } | scc_annot exp {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) (fst $ fst $ unLoc $1) } -optSemi :: { ([Located a],Bool) } +optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } ===================================== testsuite/tests/warnings/should_compile/T16551.stderr ===================================== @@ -0,0 +1,3 @@ +[1 of 3] Compiling B[boot] ( T16551/B.hs-boot, T16551/B.o-boot ) +[2 of 3] Compiling A ( T16551/A.hs, T16551/A.o ) +[3 of 3] Compiling B ( T16551/B.hs, T16551/B.o ) ===================================== testsuite/tests/warnings/should_compile/T16551/A.hs ===================================== @@ -0,0 +1,2 @@ +module A where +import {-# SOURCE #-} B ===================================== testsuite/tests/warnings/should_compile/T16551/B.hs ===================================== @@ -0,0 +1,2 @@ +module B where +import A ===================================== testsuite/tests/warnings/should_compile/T16551/B.hs-boot ===================================== @@ -0,0 +1 @@ +module B where ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -22,6 +22,7 @@ test('Werror01', normal, compile, ['']) test('Werror02', normal, compile, ['']) test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules']) +test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T16551/B.hs', '-Wmissing-home-modules']) test('StarBinder', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d5ff2c3a702944e89550f4832bf46e25bebd7b3c...0b91a0292b63fbe7f620b6b005efa480d20adb3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d5ff2c3a702944e89550f4832bf46e25bebd7b3c...0b91a0292b63fbe7f620b6b005efa480d20adb3e You're receiving 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 Jun 4 03:42:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 23:42:50 -0400 Subject: [Git][ghc/ghc][wip/8-8-ghci] 7 commits: Fix #16603 by documenting some important changes in changelogs Message-ID: <5cf5e8ba32092_1c953fa9efcab1c813949a5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/8-8-ghci at Glasgow Haskell Compiler / GHC Commits: 334dd6da by Ryan Scott at 2019-05-08T13:31:22Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 605869c7 by Vladislav Zavialov at 2019-06-03T21:28:12Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - f8d24178 by Michael Sloan at 2019-06-04T03:42:46Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 7258f41b by Michael Sloan at 2019-06-04T03:42:46Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 (cherry picked from commit fe9034e9b4820214a8c703bd8a3146ce6eed37b8) - - - - - 3be42032 by Michael Sloan at 2019-06-04T03:42:46Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas (cherry picked from commit 061276ea5d265eb3c23a3698f0a10f6a764ff4b4) - - - - - a675f498 by Michael Sloan at 2019-06-04T03:42:47Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. (cherry picked from commit c01d5af31c8feb634fc3dffc84e6e7ece61ba190) - - - - - 7af05bc4 by Michael Sloan at 2019-06-04T03:42:47Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 (cherry picked from commit 64959e51bf17a9f991cc345476a40515e7b32d81) - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/codeGen/StgCmmMonad.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeLink.hs - compiler/ghci/RtClosureInspect.hs - compiler/iface/BinFingerprint.hs - compiler/main/GhcMake.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/parser/Parser.y - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/Leak.hs - ghc/GHCi/UI/Monad.hs - + ghc/GHCi/Util.hs - ghc/ghc-bin.cabal.in - includes/CodeGen.Platform.hs - libraries/base/changelog.md - − testsuite/tests/ghci/prog014/prog014.stderr - − testsuite/tests/ghci/should_fail/T14608.stderr - testsuite/tests/ghci/should_fail/all.T - testsuite/tests/ghci/should_fail/T14608.hs → testsuite/tests/ghci/should_run/T14608.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/aa3346be462d6ac5979d07f8cb8ea3c8a79f0e5c...7af05bc4f6c78df5d84a71e8e5f60235e3ced269 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/aa3346be462d6ac5979d07f8cb8ea3c8a79f0e5c...7af05bc4f6c78df5d84a71e8e5f60235e3ced269 You're receiving 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 Jun 4 03:45:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 03 Jun 2019 23:45:29 -0400 Subject: [Git][ghc/ghc][wip/T16742] 2 commits: Allow runtimeError applications under let/app invariant Message-ID: <5cf5e95948e9d_1c953faa43bf77c81397617@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 1b50fdcb by Ben Gamari at 2019-06-04T03:44:27Z Allow runtimeError applications under let/app invariant PrelRules.shiftRule can now rewrite Int# expressions to bottom due to the invalid-shift check introduced by 1503da32d26fb59fb6ebb620bfd0f8c08638f627. To accomodate this we allow known-bottoming expressions under the let/app invariant. - - - - - 80203523 by Ben Gamari at 2019-06-04T03:44:27Z PrelRules: Ensure that shift rule result type is correct Previously shiftRule would always produce a wordPrimTy result, despite the fact that some of the primops which it handled were of type intPrimTy. - - - - - 3 changed files: - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreSyn.hs - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/coreSyn/CoreLint.hs ===================================== @@ -536,7 +536,8 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) ; checkL ( isJoinId binder || not (isUnliftedType binder_ty) || (isNonRec rec_flag && exprOkForSpeculation rhs) - || exprIsTickedString rhs) + || exprIsTickedString rhs + ) (badBndrTyMsg binder (text "unlifted")) -- Check that if the binder is top-level or recursive, it's not @@ -1018,7 +1019,7 @@ lintCoreArg fun_ty arg (ppr arg <+> dcolon <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty)))) -- check for levity polymorphism first, because otherwise isUnliftedType panics - ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) + ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg || exprIsBottom arg) (mkLetAppMsg arg) ; lintValApp arg fun_ty arg_ty } ===================================== compiler/coreSyn/CoreSyn.hs ===================================== @@ -420,9 +420,9 @@ parts of the compilation pipeline. Note [CoreSyn let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The let/app invariant - the right hand side of a non-recursive 'Let', and - the argument of an 'App', +The let/app invariant: + the right hand side of a non-recursive 'Let', and + the argument of an 'App', /may/ be of unlifted type, but only if the expression is ok-for-speculation or the 'Let' is for a join point. @@ -445,6 +445,14 @@ which will generate a @case@ if necessary The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in coreSyn/MkCore. +One notable exception to this rule is bottoming expressions. For instance, we +allow + + y::Int = I# (runtimeError ...) + +since we sometimes need to make unlifted bindings bottom (e.g. see +PrelRules.shiftRule). + Note [CoreSyn type and coercion invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow a /non-recursive/, /non-top-level/ let to bind type and ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -134,11 +134,11 @@ primOpRules nm NotIOp = mkPrimOpRule nm 1 [ unaryLit complementOp , inversePrimOp NotIOp ] primOpRules nm IntNegOp = mkPrimOpRule nm 1 [ unaryLit negOp , inversePrimOp IntNegOp ] -primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) +primOpRules nm ISllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) intPrimTy , rightIdentityDynFlags zeroi ] -primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR) +primOpRules nm ISraOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR) intPrimTy , rightIdentityDynFlags zeroi ] -primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical +primOpRules nm ISrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical intPrimTy , rightIdentityDynFlags zeroi ] -- Word operations @@ -180,8 +180,8 @@ primOpRules nm XorOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , equalArgs >> retLit zerow ] primOpRules nm NotOp = mkPrimOpRule nm 1 [ unaryLit complementOp , inversePrimOp NotOp ] -primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ] -primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ] +primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) wordPrimTy ] +primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical wordPrimTy ] -- coercions primOpRules nm Word2IntOp = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit @@ -462,12 +462,12 @@ wordOpC2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _) = wordCResult dflags (fromInteger w1 `op` fromInteger w2) wordOpC2 _ _ _ _ = Nothing -- Could find LitLit -shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr +shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> Type -> RuleM CoreExpr -- Shifts take an Int; hence third arg of op is Int -- Used for shift primops -- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word# -- SllOp, SrlOp :: Word# -> Int# -> Word# -shiftRule shift_op +shiftRule shift_op resultTy = do { dflags <- getDynFlags ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs ; case e1 of @@ -475,7 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID resultTy ("Bad shift length " ++ show shift_len) -- Do the shift at type Integer, but shift length is Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c44d90954a64d83217f300e6508a21f13ccbb70...802035236788df8168345c84b10fb012ef1c21df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c44d90954a64d83217f300e6508a21f13ccbb70...802035236788df8168345c84b10fb012ef1c21df You're receiving 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 Jun 4 04:33:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 00:33:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16736 Message-ID: <5cf5f4aee72bd_1c95d5d159414052c2@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16736 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16736 You're receiving 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 Jun 4 04:44:09 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 00:44:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16740 Message-ID: <5cf5f719cbded_1c953faa1cac48b414072d7@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16740 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16740 You're receiving 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 Jun 4 04:45:22 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 00:45:22 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cf5f762189d2_1c955cdc1c0140921f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 50c700f5 by Ben Gamari at 2019-06-04T04:45:10Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. This caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -1368,20 +1368,24 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + | unpk `hasKey` unpackCStringFoldrIdKey + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + , (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , c1 `cheapEqExpr` c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` c1 + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/50c700f5b8830611664cb2f1946136f48ffe5112 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/50c700f5b8830611664cb2f1946136f48ffe5112 You're receiving 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 Jun 4 04:57:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 00:57:17 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 14 commits: testsuite: Mark T14761c as broken in hpc and optasm ways Message-ID: <5cf5fa2d63027_1c953faa43bf77c814147dd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 419a31d3 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 037db742 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - aa9394a6 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 6fcd8e8d by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - b1cfd084 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 143ac611 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - ffca1e69 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - ddd029a8 by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Fix fragile_for test modifier - - - - - 6b742c47 by Ben Gamari at 2019-06-04T04:54:47Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - cd14fd5b by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 2878b15a by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 823452ea by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 16aa7cfb by Ben Gamari at 2019-06-04T04:54:47Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 3028f75c by Ben Gamari at 2019-06-04T04:56:47Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 15 changed files: - libraries/ghc-heap/tests/all.T - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/rts/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -7,5 +7,5 @@ test('heap_all', ], compile_and_run, ['']) test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [omit_ways(['ghci', 'hpc', 'prof']), expect_broken_for(16544, ['dyn', 'optasm', 'threaded2'])], compile_and_run, ['']) ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit a67b5e9e70a2a0c438d4f186fda9f38409ff1435 ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,8 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + assert ways.__class__ is list + opts.omit_ways += ways # ----- ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,4 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -88,7 +88,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) @@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, ['']) # omit threaded2, the behaviour of this test is non-deterministic with more # than one CPU. -test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) +test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -34,7 +34,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -199,4 +199,4 @@ test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c' test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) -test('T493', [], compile_and_run, ['T493_c.c']) +test('T493', [omit_ways(['ghci'])], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -1,8 +1,8 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples -test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) -test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, ['']) +test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, ['']) +test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) ===================================== testsuite/tests/programs/barton-mangler-bug/test.T ===================================== @@ -8,7 +8,7 @@ test('barton-mangler-bug', 'Plot.hi', 'Plot.o', 'PlotExample.hi', 'PlotExample.o', 'TypesettingTricks.hi', 'TypesettingTricks.o']), - omit_ways('debug') # Fails for debug way due to annotation linting timeout + omit_ways(['debug']) # Fails for debug way due to annotation linting timeout ], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -73,7 +73,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 test('T2783', [ omit_ways(['ghci']), exit_code(1) - , expect_broken_for(2783, ['threaded1']) + , fragile_for(2783, ['threaded1']) ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in @@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']), # run this test with very small stack chunks to exercise the stack # overflow/underflow machinery. -test('stack003', [ omit_ways('ghci'), # uses unboxed tuples +test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) @@ -214,7 +214,8 @@ test('T7815', [ multi_cpu_race, test('ffishutdown', [ignore_stderr, only_ways(['threaded1','threaded2'])], compile_and_run, ['']) -test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run, +# Times out in ghci way +test('T7919', [when(fast(), skip), omit_ways(['ghci'] + prof_ways)], compile_and_run, [config.ghc_th_way_flags]) test('T8035', normal, compile_and_run, ['']) ===================================== testsuite/tests/th/all.T ===================================== @@ -13,7 +13,7 @@ if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) setTestOpts(only_ways(['normal','ghci','ext-interp'])) -broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] +broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T16180","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] # ext-interp, integer-gmp and llvm is broken see #16087 def broken_ext_interp(name, opts): if name in broken_tests and config.ghc_built_by_llvm: @@ -467,7 +467,10 @@ test('T15437', expect_broken(15437), multimod_compile, test('T15985', normal, compile, ['']) test('T16133', normal, compile_fail, ['']) test('T15471', normal, multimod_compile, ['T15471.hs', '-v0']) -test('T16180', normal, compile_and_run, ['']) +test('T16180', + [when(llvm_build(), expect_broken_for(16541, ['ext-interp'])), + expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-package ghc']) test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -659,7 +659,7 @@ test('T15586', normal, compile, ['']) test('T15368', normal, compile, ['-fdefer-type-errors']) test('T15645', normal, compile, ['-Wwarn=missing-monadfail-instances']) test('T15778', normal, compile, ['']) -test('T14761c', normal, compile, ['']) +test('T14761c', expect_broken_for(16540, ['hpc', 'optasm']), compile, ['']) test('T16008', normal, compile, ['']) test('T16033', normal, compile, ['']) test('T16141', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -35,7 +35,7 @@ test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) test('tcrun021', normal, compile_and_run, ['-package containers']) -test('tcrun022', omit_ways(['ghci']), compile_and_run, ['-O']) +test('tcrun022', omit_ways(['hpc', 'ghci']), compile_and_run, ['-O']) test('tcrun023', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O']) test('tcrun024', normal, compile_and_run, ['-O']) @@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, ['']) +test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcTypeSymbolSimpleRun', normal, compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) ===================================== testsuite/tests/utils/should_run/all.T ===================================== @@ -1,6 +1,6 @@ test('T14854', [only_ways(threaded_ways), - omit_ways('ghci'), + omit_ways(['ghci']), reqlib('random'), ignore_stderr], compile_and_run, ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -26,4 +26,4 @@ test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T1655 test('StarBinder', normal, compile, ['']) -test('Overflow', normal, compile, ['']) +test('Overflow', expect_broken_for(16543, ['hpc']), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/593d5726bc8f49a897f075ed9ed5a68258f2e446...3028f75c0462b13fbcf7900dd615ac44a9395730 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/593d5726bc8f49a897f075ed9ed5a68258f2e446...3028f75c0462b13fbcf7900dd615ac44a9395730 You're receiving 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 Jun 4 05:09:11 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 01:09:11 -0400 Subject: [Git][ghc/ghc][master] TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cf5fcf770a1_1c95ca32d001415566@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - 5 changed files: - + testsuite/driver/js/Chart-2.8.0.min.js - + testsuite/driver/js/tooltip.js - testsuite/driver/perf_notes.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py Changes: ===================================== testsuite/driver/js/Chart-2.8.0.min.js ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/driver/js/tooltip.js ===================================== @@ -0,0 +1,108 @@ +/* + * This is mostly copied from the example in https://www.chartjs.org/docs/latest/configuration/tooltip.html#external-custom-tooltips. + */ + +setCustomTooltip = function(chartInput, extraTextByLabel) { + chartInput.options = chartInput.options || {}; + chartInput.options.tooltips = chartInput.options.tooltips || {}; + chartInput.options.tooltips.enabled = false; + chartInput.options.tooltips.custom = function (tooltipModel) { + // `this` will be the overall tooltip + var canvas = this._chart.canvas; + return customTooltip(canvas, tooltipModel, extraTextByLabel); + } + + return chartInput; +} +customTooltip = function(canvas, tooltipModel, extraTextByLabel) { + // Tooltip Element + var tooltipEl = document.getElementById('chartjs-tooltip'); + + // Create element on first render + if (!tooltipEl) { + tooltipEl = document.createElement('div'); + tooltipEl.id = 'chartjs-tooltip'; + tooltipEl.innerHTML = '
'; + document.body.appendChild(tooltipEl); + } + + // Hide if no tooltip + if (tooltipModel.opacity === 0) { + tooltipEl.style.opacity = 0; + return; + } + + // Set caret Position + tooltipEl.classList.remove('above', 'below', 'no-transform'); + if (tooltipModel.yAlign) { + tooltipEl.classList.add(tooltipModel.yAlign); + } else { + tooltipEl.classList.add('no-transform'); + } + + function getBody(bodyItem) { + return bodyItem.lines; + } + + // Set Text + if (tooltipModel.body) { + var titleLines = tooltipModel.title || []; + var bodyLines = tooltipModel.body.map(getBody); + + var innerHtml = ''; + + titleLines.forEach(function(title) { + innerHtml += '' + title + ''; + }); + innerHtml += ''; + + bodyLines.forEach(function(body, i) { + var colors = tooltipModel.labelColors[i]; + var style = 'background:' + colors.backgroundColor; + style += '; border-color:' + colors.borderColor; + style += '; border-width: 2px'; + var span = ''; + innerHtml += '' + span + body + ''; + }); + + // Set extra text. + if (tooltipModel.dataPoints[0]) + { + var tooltipItem = tooltipModel.dataPoints[0]; + var extra = extraTextByLabel[tooltipItem.label]; + innerHtml += '
' + escapeHtml(extra) + ''; + } + + innerHtml += ''; + + var tableRoot = tooltipEl.querySelector('table'); + tableRoot.innerHTML = innerHtml; + } + + var position = canvas.getBoundingClientRect(); + + // Display, position, and set styles for font + tooltipEl.style.opacity = 1; + tooltipEl.style.position = 'absolute'; + tooltipEl.style.left = '10px' + tooltipEl.style.top = '10px' + tooltipEl.style.fontFamily = tooltipModel._bodyFontFamily; + tooltipEl.style.fontSize = tooltipModel.bodyFontSize + 'px'; + tooltipEl.style.fontStyle = tooltipModel._bodyFontStyle; + tooltipEl.style.padding = tooltipModel.yPadding + 'px ' + tooltipModel.xPadding + 'px'; + tooltipEl.style.pointerEvents = 'none'; +} + +function escapeHtml(unsafe) { + if(unsafe) { + return unsafe + .replace(/&/g, "&") + .replace(//g, ">") + .replace(/"/g, """) + .replace(/'/g, "'") + .replace(/\n/g, "
"); + } else { + return ''; + } + } ===================================== testsuite/driver/perf_notes.py ===================================== @@ -9,6 +9,9 @@ # (which defaults to 'local' if not given by --test-env). # +import colorsys +import tempfile +import json import argparse import re import subprocess @@ -18,7 +21,7 @@ import sys from collections import namedtuple from math import ceil, trunc -from testutil import passed, failBecause +from testutil import passed, failBecause, testing_metrics # Check if "git rev-parse" can be run successfully. @@ -115,12 +118,21 @@ def get_allowed_perf_changes(commit='HEAD'): global _get_allowed_perf_changes_cache commit = commit_hash(commit) if not commit in _get_allowed_perf_changes_cache: - commitByteStr = subprocess.check_output(\ - ['git', '--no-pager', 'log', '-n1', '--format=%B', commit]) _get_allowed_perf_changes_cache[commit] \ - = parse_allowed_perf_changes(commitByteStr.decode()) + = parse_allowed_perf_changes(get_commit_message(commit)) return _get_allowed_perf_changes_cache[commit] +# Get the commit message of any commit . +# This is cached (keyed on the full commit hash). +_get_commit_message = {} +def get_commit_message(commit='HEAD'): + global _get_commit_message + commit = commit_hash(commit) + if not commit in _get_commit_message: + _get_commit_message[commit] = subprocess.check_output(\ + ['git', '--no-pager', 'log', '-n1', '--format=%B', commit]).decode() + return _get_commit_message[commit] + def parse_allowed_perf_changes(commitMsg): # Helper regex. Non-capturing unless postfixed with Cap. s = r"(?:\s*\n?\s+)" # Space, possible new line with an indent. @@ -297,21 +309,27 @@ def baseline_commit_log(commit): global _baseline_depth_commit_log commit = commit_hash(commit) if not commit in _baseline_depth_commit_log: - n = BaselineSearchDepth - output = subprocess.check_output(['git', 'log', '--format=%H', '-n' + str(n), commit]).decode() - hashes = list(filter(is_commit_hash, output.split('\n'))) - - # We only got 10 results (expecting 75) in a CI pipeline (issue #16662). - # It's unclear from the logs what went wrong. Since no exception was - # thrown, we can assume the `git log` call above succeeded. The best we - # can do for now is improve logging. - actualN = len(hashes) - if actualN != n: - print("Expected " + str(n) + " hashes, but git gave " + str(actualN) + ":\n" + output) - _baseline_depth_commit_log[commit] = hashes + _baseline_depth_commit_log[commit] = commit_log(commit, BaselineSearchDepth) return _baseline_depth_commit_log[commit] +# Get the commit hashes for the last n commits from and +# including the input commit. The output commits are all commit hashes. +# str -> [str] +def commit_log(commitOrRange, n=None): + nArgs = ['-n' + str(n)] if n != None else [] + output = subprocess.check_output(['git', 'log', '--format=%H'] + nArgs + [commitOrRange]).decode() + hashes = list(filter(is_commit_hash, output.split('\n'))) + + # We only got 10 results (expecting 75) in a CI pipeline (issue #16662). + # It's unclear from the logs what went wrong. Since no exception was + # thrown, we can assume the `git log` call above succeeded. The best we + # can do for now is improve logging. + actualN = len(hashes) + if n != None and actualN != n: + print("Expected " + str(n) + " hashes, but git gave " + str(actualN) + ":\n" + output) + return hashes + # Cache of baseline values. This is a dict of dicts indexed on: # (useCiNamespace, commit) -> (test_env, test, metric, way) -> baseline # (bool , str ) -> (str , str , str , str) -> float @@ -355,7 +373,6 @@ def baseline_metric(commit, name, test_env, metric, way): # gets the metric of a given commit # (Bool, Int) -> (float | None) def commit_metric(useCiNamespace, depth): - global _commit_metric_cache currentCommit = depth_to_commit(depth) # Get test environment. @@ -364,44 +381,7 @@ def baseline_metric(commit, name, test_env, metric, way): # This can happen when no best fit ci test is found. return None - # Check for cached value. - cacheKeyA = (useCiNamespace, currentCommit) - cacheKeyB = (effective_test_env, name, metric, way) - if cacheKeyA in _commit_metric_cache: - return _commit_metric_cache[cacheKeyA].get(cacheKeyB) - - # Cache miss. - # Calculate baselines from the current commit's git note. - # Note that the git note may contain data for other tests. All tests' - # baselines will be collected and cached for future use. - allCommitMetrics = get_perf_stats( - currentCommit, - namespace(useCiNamespace)) - - # Collect recorded values by cacheKeyB. - values_by_cache_key_b = {} - for perfStat in allCommitMetrics: - currentCacheKey = (perfStat.test_env, perfStat.test, \ - perfStat.metric, perfStat.way) - currentValues = values_by_cache_key_b.setdefault(currentCacheKey, []) - currentValues.append(float(perfStat.value)) - - # Calculate and baseline (average of values) by cacheKeyB. - baseline_by_cache_key_b = {} - for currentCacheKey, currentValues in values_by_cache_key_b.items(): - baseline_by_cache_key_b[currentCacheKey] = Baseline( \ - PerfStat( \ - currentCacheKey[0], - currentCacheKey[1], - currentCacheKey[3], - currentCacheKey[2], - sum(currentValues) / len(currentValues)), - currentCommit, - depth) - - # Save baselines to the cache. - _commit_metric_cache[cacheKeyA] = baseline_by_cache_key_b - return baseline_by_cache_key_b.get(cacheKeyB) + return get_commit_metric(namespace(useCiNamespace), currentCommit, effective_test_env, name, metric, way) # Searches through previous commits trying local then ci for each commit in. def search(useCiNamespace, depth): @@ -414,7 +394,7 @@ def baseline_metric(commit, name, test_env, metric, way): # Check for a metric on this commit. current_metric = commit_metric(useCiNamespace, depth) if current_metric != None: - return current_metric + return Baseline(current_metric, depth_to_commit(depth), depth) # Metric is not available. # If tried local, now try CI. @@ -432,6 +412,60 @@ def baseline_metric(commit, name, test_env, metric, way): # Start search from parent commit using local name space. return search(False, 1) +# Same as get_commit_metric(), but converts the result to a string or keeps it +# as None. +def get_commit_metric_value_str_or_none(gitNoteRef, commit, test_env, name, metric, way): + metric = get_commit_metric(gitNoteRef, commit, test_env, name, metric, way) + if metric == None: + return None + return str(metric.value) + +# gets the average commit metric from git notes. +# gitNoteRef: git notes ref sapce e.g. "perf" or "ci/perf" +# commit: git commit +# test_env: test environment +# name: test name +# metric: test metric +# way: test way +# returns: PerfStat | None if stats don't exist for the given input +def get_commit_metric(gitNoteRef, commit, test_env, name, metric, way): + global _commit_metric_cache + assert test_env != None + commit = commit_hash(commit) + + # Check for cached value. + cacheKeyA = (gitNoteRef, commit) + cacheKeyB = (test_env, name, metric, way) + if cacheKeyA in _commit_metric_cache: + return _commit_metric_cache[cacheKeyA].get(cacheKeyB) + + # Cache miss. + # Calculate baselines from the current commit's git note. + # Note that the git note may contain data for other tests. All tests' + # baselines will be collected and cached for future use. + allCommitMetrics = get_perf_stats(commit, gitNoteRef) + + # Collect recorded values by cacheKeyB. + values_by_cache_key_b = {} + for perfStat in allCommitMetrics: + currentCacheKey = (perfStat.test_env, perfStat.test, \ + perfStat.metric, perfStat.way) + currentValues = values_by_cache_key_b.setdefault(currentCacheKey, []) + currentValues.append(float(perfStat.value)) + + # Calculate and baseline (average of values) by cacheKeyB. + baseline_by_cache_key_b = {} + for currentCacheKey, currentValues in values_by_cache_key_b.items(): + baseline_by_cache_key_b[currentCacheKey] = PerfStat( \ + currentCacheKey[0], + currentCacheKey[1], + currentCacheKey[3], + currentCacheKey[2], + sum(currentValues) / len(currentValues)) + + # Save baselines to the cache. + _commit_metric_cache[cacheKeyA] = baseline_by_cache_key_b + return baseline_by_cache_key_b.get(cacheKeyB) # Check test stats. This prints the results for the user. # actual: the PerfStat with actual value. @@ -492,18 +526,32 @@ def check_stats_change(actual, baseline, tolerance_dev, allowed_perf_changes = { return (change, result) +# Generate a css color (rgb) string based off of the hash of the input. +def hash_rgb_str(x): + res = 10000.0 + rgb = colorsys.hsv_to_rgb((abs(int(hash(x))) % res)/res, 1.0, 0.9) + return "rgb(" + str(int(rgb[0] * 255)) + ", " + str(int(rgb[1] * 255)) + ", " + str(int(rgb[2] * 255)) + ")" + if __name__ == '__main__': parser = argparse.ArgumentParser() - parser.add_argument("--test-env", - help="The given test environment to be compared.") - parser.add_argument("--test-name", - help="If given, filters table to include only \ - tests matching the given regular expression.") parser.add_argument("--add-note", nargs=3, help="Development only. --add-note N commit seed \ Adds N fake metrics to the given commit using the random seed.") + parser.add_argument("--chart", nargs='?', default=None, action='store', const='./PerformanceChart.html', + help='Create a chart of the results an save it to the given file. Default to "./PerformanceChart.html".') + parser.add_argument("--ci", action='store_true', + help="Use ci results. You must fetch these with:\n " \ + + "$ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf") + parser.add_argument("--test-env", + help="The given test environment to be compared. Use 'local' for localy run results. If using --ci, see .gitlab-ci file for TEST_ENV settings.") + parser.add_argument("--test-name", + help="Filters for tests matching the given regular expression.") + parser.add_argument("--metric", + help="Test metric (one of " + str(testing_metrics()) + ").") + parser.add_argument("--way", + help="Test way (one of " + str(testing_metrics()) + ").") parser.add_argument("commits", nargs=argparse.REMAINDER, - help="The rest of the arguments will be the commits that will be used.") + help="Either a list of commits or a single commit range (e.g. HEAD~10..HEAD).") args = parser.parse_args() env = 'local' @@ -517,16 +565,29 @@ if __name__ == '__main__': # Main logic of the program when called from the command-line. # + ref = 'perf' + if args.ci: + ref = 'ci/perf' + commits = args.commits if args.commits: - for c in args.commits: - metrics += [CommitAndStat(c, stat) for stat in get_perf_stats(c)] + # Commit range + if len(commits) == 1 and ".." in commits[0]: + commits = list(reversed(commit_log(commits[0]))) + for c in commits: + metrics += [CommitAndStat(c, stat) for stat in get_perf_stats(c, ref)] + + if args.metric: + metrics = [test for test in metrics if test.stat.metric == args.metric] + + if args.way: + metrics = [test for test in metrics if test.stat.way == args.way] if args.test_env: metrics = [test for test in metrics if test.stat.test_env == args.test_env] if args.test_name: nameRe = re.compile(args.test_name) - metrics = [test for test in metrics if nameRe.search(test.test)] + metrics = [test for test in metrics if nameRe.search(test.stat.test)] if args.add_note: def note_gen(n, commit, delta=''): @@ -548,66 +609,119 @@ if __name__ == '__main__': note_gen(args.add_note[0],args.add_note[1],args.add_note[2]) # - # String utilities for pretty-printing + # Chart # + def metricAt(commit, testName, testMetric): + values2 = [float(t.stat.value) for t in metrics if t.commit == commit \ + and t.stat.test == testName \ + and t.stat.metric == testMetric] + if values2 == []: + return None + else: + return (sum(values2) / len(values2)) - row_fmt = '{:18}' * len(args.commits) - commits = row_fmt.format(*[c[:10] for c in args.commits]) - - def cmtline(insert): - return row_fmt.format(*[insert for c in args.commits]).strip() - - def header(unit): - first_line = "{:27}{:30}".format(' ',' ') + cmtline(unit) - second_line = ("{:27}{:30}".format('Test','Metric') + commits).strip() - - # Test Metric c1 c2 c3 ... - print("-" * (len(second_line)+1)) - print(first_line) - print(second_line) - print("-" * (len(second_line)+1)) - - def commit_string(test, flag): - def delta(v1, v2): - return round((100 * (v1 - v2)/v2),2) - - # Get the average value per commit (or None if that commit contains no metrics). - # Note: if the test environment is not set, this will combine metrics from all test environments. - averageValuesOrNones = [] - for commit in args.commits: - values = [float(t.stat.value) for t in metrics if t.commit == commit and t.stat.test == test] - if values == []: - averageValuesOrNones.append(None) - else: - averageValuesOrNones.append(sum(values) / len(values)) - - if flag == 'metrics': - strings = [str(v) if v != None else '-' for v in averageValuesOrNones] - if flag == 'percentages': - # If the baseline commit has no stats, then we can not produce any percentages. - baseline = averageValuesOrNones[0] - if baseline == None: - strings = ['-' for v in averageValuesOrNones] - else: - baseline = float(baseline) - strings = ['-' if val == None else str(delta(baseline,float(val))) + '%' for val in averageValuesOrNones] - - return row_fmt.format(*strings).strip() + testSeries = list(set([(test.stat.test_env, test.stat.test, test.stat.metric, test.stat.way) for test in metrics])) # - # The pretty-printed output + # Use Chart.js to visualize the data. # - header('commit') - # Printing out metrics. - all_tests = sorted(set([(test.stat.test, test.stat.metric) for test in metrics])) - for test, metric in all_tests: - print("{:27}{:30}".format(test, metric) + commit_string(test,'metrics')) + if args.chart: + commitMsgs = dict([(h, get_commit_message(h)) for h in commits]) + chartData = { + 'type': 'line', + 'data': { + 'labels': [commitMsgs[h].split("\n")[0] + " (" + \ + (h[:8] if is_commit_hash(h) else h) + \ + ")" for h in commits], + 'datasets': [{ + 'label': name + "(" + way + ") " + metric + " - " + env, + 'data': [get_commit_metric_value_str_or_none(ref, commit, env, name, metric, way) \ + for commit in commits], + + 'fill': 'false', + 'spanGaps': 'true', + 'lineTension': 0, + 'backgroundColor': hash_rgb_str((env, name, metric, way)), + 'borderColor': hash_rgb_str((env, name, metric, way)) + } for (env, name, metric, way) in testSeries] + }, + 'options': {} + } + - # Has no meaningful output if there is no commit to compare to. - if not singleton_commit: - header('percent') + # Try use local Chart.js file else use online version. + tooltipjsFilePath = sys.path[0] + "/js/tooltip.js" + chartjsFilePath = sys.path[0] + "/js/Chart-2.8.0.min.js" + tooltipjsTag = None + try: + tooltipjsFile = open(tooltipjsFilePath, "r") + tooltipjsTag = '' + tooltipjsFile.close() + except: + print("Failed to load custom tooltip: " + chartjsFilePath + ".") + tooltipjsTag = None + try: + chartjsFile = open(chartjsFilePath, "r") + chartjsTag = '' + chartjsFile.close() + except: + print("Failed to load " + chartjsFilePath + ", reverting to online Chart.js.") + chartjsTag = '' + + file = open(args.chart, "w+t") + print(\ + "" + \ + '\n' + \ + (tooltipjsTag if tooltipjsTag != None else '') + \ + chartjsTag + \ + '' + \ + '' + \ + ""\ + , file=file) + file.close() + exit(0) + + # + # String utilities for pretty-printing + # - # Printing out percentages. - for test, metric in all_tests: - print("{:27}{:30}".format(test, metric) + commit_string(test,'percentages')) + # T1234 T1234 + # max_bytes max_bytes + # normal normal + # commit x86_64-darwin i386-linux-deb9 + # -------------------------------------------- + # HEAD 9123 9123 + # 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 "" + + headerCols = [ ["","","","Commit"] ] \ + + [ [name, metric, way, env] for (env, name, metric, way) in testSeries ] + dataCols = [ commits ] \ + + [ [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) ===================================== testsuite/driver/testlib.py ===================================== @@ -19,7 +19,7 @@ import collections import subprocess from testglobals import config, ghc_env, default_testopts, brokens, t, TestResult -from testutil import strip_quotes, lndir, link_or_copy_file, passed, failBecause, failBecauseStderr, str_fail, str_pass +from testutil import strip_quotes, lndir, link_or_copy_file, passed, failBecause, failBecauseStderr, str_fail, str_pass, testing_metrics from cpu_features import have_cpu_feature import perf_notes as Perf from perf_notes import MetricChange @@ -384,9 +384,6 @@ def collect_compiler_stats(metric='all',deviation=20): def collect_stats(metric='all', deviation=20): return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m, d) -def testing_metrics(): - return ['bytes allocated', 'peak_megabytes_allocated', 'max_bytes_used'] - # This is an internal function that is used only in the implementation. # 'is_compiler_stats_test' is somewhat of an unfortunate name. # If the boolean is set to true, it indicates that this test is one that ===================================== testsuite/driver/testutil.py ===================================== @@ -57,6 +57,10 @@ def lndir(srcdir, dstdir): os.mkdir(dst) lndir(src, dst) +# All possible test metric strings. +def testing_metrics(): + return ['bytes allocated', 'peak_megabytes_allocated', 'max_bytes_used'] + # On Windows, os.symlink is not defined with Python 2.7, but is in Python 3 # when using msys2, as GHC does. Unfortunately, only Administrative users have # the privileges necessary to create symbolic links by default. Consequently we View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/286827be471f9efa67303d57b979e0c32cb8936e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/286827be471f9efa67303d57b979e0c32cb8936e You're receiving 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 Jun 4 05:09:49 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 01:09:49 -0400 Subject: [Git][ghc/ghc][master] Use a better strategy for determining the offset applied to foreign function... Message-ID: <5cf5fd1d15091_1c953faa3354ef0814185c4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 23 changed files: - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - + testsuite/tests/ffi/should_compile/ReducingFfiSignature.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.hs - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.stderr - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/ffi/should_run/T16650a.hs - + testsuite/tests/ffi/should_run/T16650a.stdout - + testsuite/tests/ffi/should_run/T16650a_c.c - + testsuite/tests/ffi/should_run/T16650b.hs - + testsuite/tests/ffi/should_run/T16650b.stdout - + testsuite/tests/ffi/should_run/T16650b_c.c - + testsuite/tests/ffi/should_run/T16650c.hs - + testsuite/tests/ffi/should_run/T16650c.stdout - + testsuite/tests/ffi/should_run/T16650c_c.c - + testsuite/tests/ffi/should_run/T16650d.hs - + testsuite/tests/ffi/should_run/T16650d.stdout - + testsuite/tests/ffi/should_run/T16650d_c.c - testsuite/tests/ffi/should_run/all.T Changes: ===================================== compiler/codeGen/StgCmmExpr.hs ===================================== @@ -577,7 +577,7 @@ isSimpleScrut _ _ = return False isSimpleOp :: StgOp -> [StgArg] -> FCode Bool -- True iff the op cannot block or allocate -isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe) +isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _ _) _ = return $! not (playSafe safe) -- dataToTag# evalautes its argument, see Note [dataToTag#] in primops.txt.pp isSimpleOp (StgPrimOp DataToTagOp) _ = return False isSimpleOp (StgPrimOp op) stg_args = do ===================================== compiler/codeGen/StgCmmForeign.hs ===================================== @@ -34,7 +34,6 @@ import CmmUtils import MkGraph import Type import RepType -import TysPrim import CLabel import SMRep import ForeignCall @@ -44,20 +43,26 @@ import Outputable import UniqSupply import BasicTypes +import TyCoRep +import TysPrim +import Util (zipEqual) + import Control.Monad ----------------------------------------------------------------------------- -- Code generation for Foreign Calls ----------------------------------------------------------------------------- --- | emit code for a foreign call, and return the results to the sequel. --- +-- | Emit code for a foreign call, and return the results to the sequel. +-- Precondition: the length of the arguments list is the same as the +-- arity of the foreign function. cgForeignCall :: ForeignCall -- the op + -> Type -- type of foreign function -> [StgArg] -- x,y arguments -> Type -- result type -> FCode ReturnKind -cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty +cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_ty = do { dflags <- getDynFlags ; let -- in the stdcall calling convention, the symbol needs @size appended -- to it, where size is the total number of bytes of arguments. We @@ -70,7 +75,7 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty -- ToDo: this might not be correct for 64-bit API arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType dflags arg) (wORD_SIZE dflags) - ; cmm_args <- getFCallArgs stg_args + ; cmm_args <- getFCallArgs stg_args typ ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty ; let ((call_args, arg_hints), cmm_target) = case target of @@ -492,43 +497,128 @@ stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags) closureField :: DynFlags -> ByteOff -> ByteOff closureField dflags off = off + fixedHdrSize dflags --- ----------------------------------------------------------------------------- +-- Note [Unlifted boxed arguments to foreign calls] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- -- For certain types passed to foreign calls, we adjust the actual --- value passed to the call. For ByteArray#/Array# we pass the --- address of the actual array, not the address of the heap object. - -getFCallArgs :: [StgArg] -> FCode [(CmmExpr, ForeignHint)] +-- value passed to the call. For ByteArray#, Array#, SmallArray#, +-- and ArrayArray#, we pass the address of the array's payload, not +-- the address of the heap object. For example, consider +-- foreign import "c_foo" foo :: ByteArray# -> Int# -> IO () +-- At a Haskell call like `foo x y`, we'll generate a C call that +-- is more like +-- c_foo( x+8, y ) +-- where the "+8" takes the heap pointer (x :: ByteArray#) and moves +-- it past the header words of the ByteArray object to point directly +-- to the data inside the ByteArray#. (The exact offset depends +-- on the target architecture and on profiling) By contrast, (y :: Int#) +-- requires no such adjustment. +-- +-- This adjustment is performed by 'add_shim'. The size of the +-- adjustment depends on the type of heap object. But +-- how can we determine that type? There are two available options. +-- We could use the types of the actual values that the foreign call +-- has been applied to, or we could use the types present in the +-- foreign function's type. Prior to GHC 8.10, we used the former +-- strategy since it's a little more simple. However, in issue #16650 +-- and more compellingly in the comments of +-- https://gitlab.haskell.org/ghc/ghc/merge_requests/939, it was +-- demonstrated that this leads to bad behavior in the presence +-- of unsafeCoerce#. Returning to the above example, suppose the +-- Haskell call looked like +-- foo (unsafeCoerce# p) +-- where the types of expressions comprising the arguments are +-- p :: (Any :: TYPE 'UnliftedRep) +-- i :: Int# +-- so that the unsafe-coerce is between Any and ByteArray#. +-- These two types have the same kind (they are both represented by +-- a heap pointer) so no GC errors will occur if we do this unsafe coerce. +-- By the time this gets to the code generator the cast has been +-- discarded so we have +-- foo p y +-- But we *must* adjust the pointer to p by a ByteArray# shim, +-- *not* by an Any shim (the Any shim involves no offset at all). +-- +-- To avoid this bad behavior, we adopt the second strategy: use +-- the types present in the foreign function's type. +-- In collectStgFArgTypes, we convert the foreign function's +-- type to a list of StgFArgType. Then, in add_shim, we interpret +-- these as numeric offsets. + +getFCallArgs :: + [StgArg] + -> Type -- the type of the foreign function + -> FCode [(CmmExpr, ForeignHint)] -- (a) Drop void args -- (b) Add foreign-call shim code -- It's (b) that makes this differ from getNonVoidArgAmodes - -getFCallArgs args - = do { mb_cmms <- mapM get args +-- Precondition: args and typs have the same length +-- See Note [Unlifted boxed arguments to foreign calls] +getFCallArgs args typ + = do { mb_cmms <- mapM get (zipEqual "getFCallArgs" args (collectStgFArgTypes typ)) ; return (catMaybes mb_cmms) } where - get arg | null arg_reps - = return Nothing - | otherwise - = do { cmm <- getArgAmode (NonVoid arg) - ; dflags <- getDynFlags - ; return (Just (add_shim dflags arg_ty cmm, hint)) } - where - arg_ty = stgArgType arg - arg_reps = typePrimRep arg_ty - hint = typeForeignHint arg_ty - -add_shim :: DynFlags -> Type -> CmmExpr -> CmmExpr -add_shim dflags arg_ty expr - | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon - = cmmOffsetB dflags expr (arrPtrsHdrSize dflags) - - | tycon == smallArrayPrimTyCon || tycon == smallMutableArrayPrimTyCon - = cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags) - - | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon - = cmmOffsetB dflags expr (arrWordsHdrSize dflags) - - | otherwise = expr + get (arg,typ) + | null arg_reps + = return Nothing + | otherwise + = do { cmm <- getArgAmode (NonVoid arg) + ; dflags <- getDynFlags + ; return (Just (add_shim dflags typ cmm, hint)) } + where + arg_ty = stgArgType arg + arg_reps = typePrimRep arg_ty + hint = typeForeignHint arg_ty + +-- The minimum amount of information needed to determine +-- the offset to apply to an argument to a foreign call. +-- See Note [Unlifted boxed arguments to foreign calls] +data StgFArgType + = StgPlainType + | StgArrayType + | StgSmallArrayType + | StgByteArrayType + +-- See Note [Unlifted boxed arguments to foreign calls] +add_shim :: DynFlags -> StgFArgType -> CmmExpr -> CmmExpr +add_shim dflags ty expr = case ty of + StgPlainType -> expr + StgArrayType -> cmmOffsetB dflags expr (arrPtrsHdrSize dflags) + StgSmallArrayType -> cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags) + StgByteArrayType -> cmmOffsetB dflags expr (arrWordsHdrSize dflags) + +-- From a function, extract information needed to determine +-- the offset of each argument when used as a C FFI argument. +-- See Note [Unlifted boxed arguments to foreign calls] +collectStgFArgTypes :: Type -> [StgFArgType] +collectStgFArgTypes = go [] + where + -- Skip foralls + go bs (ForAllTy _ res) = go bs res + go bs (AppTy{}) = reverse bs + go bs (TyConApp{}) = reverse bs + go bs (LitTy{}) = reverse bs + go bs (TyVarTy{}) = reverse bs + go _ (CastTy{}) = panic "myCollectTypeArgs: CastTy" + go _ (CoercionTy{}) = panic "myCollectTypeArgs: CoercionTy" + go bs (FunTy {ft_arg = arg, ft_res=res}) = + go (typeToStgFArgType arg:bs) res + +-- Choose the offset based on the type. For anything other +-- than an unlifted boxed type, there is no offset. +-- See Note [Unlifted boxed arguments to foreign calls] +typeToStgFArgType :: Type -> StgFArgType +typeToStgFArgType typ + | tycon == arrayPrimTyCon = StgArrayType + | tycon == mutableArrayPrimTyCon = StgArrayType + | tycon == arrayArrayPrimTyCon = StgArrayType + | tycon == mutableArrayArrayPrimTyCon = StgArrayType + | tycon == smallArrayPrimTyCon = StgSmallArrayType + | tycon == smallMutableArrayPrimTyCon = StgSmallArrayType + | tycon == byteArrayPrimTyCon = StgByteArrayType + | tycon == mutableByteArrayPrimTyCon = StgByteArrayType + | otherwise = StgPlainType where - tycon = tyConAppTyCon (unwrapType arg_ty) - -- should be a tycon app, since this is a foreign call + -- should be a tycon app, since this is a foreign call + tycon = tyConAppTyCon (unwrapType typ) + ===================================== compiler/codeGen/StgCmmPrim.hs ===================================== @@ -71,8 +71,8 @@ cgOpApp :: StgOp -- The op -> FCode ReturnKind -- Foreign calls -cgOpApp (StgFCallOp fcall _) stg_args res_ty - = cgForeignCall fcall stg_args res_ty +cgOpApp (StgFCallOp fcall ty _) stg_args res_ty + = cgForeignCall fcall ty stg_args res_ty -- Note [Foreign call results] -- tagToEnum# is special: we need to pull the constructor ===================================== compiler/stgSyn/CoreToStg.hs ===================================== @@ -539,7 +539,7 @@ coreToStgApp _ f args ticks = do -- A regular foreign call. FCallId call -> ASSERT( saturated ) - StgOpApp (StgFCallOp call (idUnique f)) args' res_ty + StgOpApp (StgFCallOp call (idType f) (idUnique f)) args' res_ty TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args') _other -> StgApp f args' ===================================== compiler/stgSyn/StgSyn.hs ===================================== @@ -686,10 +686,14 @@ data StgOp | StgPrimCallOp PrimCall - | StgFCallOp ForeignCall Unique + | StgFCallOp ForeignCall Type Unique -- The Unique is occasionally needed by the C pretty-printer -- (which lacks a unique supply), notably when generating a - -- typedef for foreign-export-dynamic + -- typedef for foreign-export-dynamic. The Type, which is + -- obtained from the foreign import declaration itself, is + -- needed by the stg-to-cmm pass to determine the offset to + -- apply to unlifted boxed arguments in StgCmmForeign. + -- See Note [Unlifted boxed arguments to foreign calls] {- ************************************************************************ @@ -860,7 +864,7 @@ pprStgAlt indent (con, params, expr) pprStgOp :: StgOp -> SDoc pprStgOp (StgPrimOp op) = ppr op pprStgOp (StgPrimCallOp op)= ppr op -pprStgOp (StgFCallOp op _) = ppr op +pprStgOp (StgFCallOp op _ _) = ppr op instance Outputable AltType where ppr PolyAlt = text "Polymorphic" ===================================== testsuite/tests/ffi/should_compile/ReducingFfiSignature.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module ReducingFfiSignature + ( c_pow_1 + , c_pow_2 + , c_pow_3 + ) where + +import Foreign.C.Types (CDouble(..)) +import Data.Kind (Type) + +type family Foo (x :: Type) + +type instance Foo Int = CDouble +type instance Foo Bool = CDouble -> CDouble +type instance Foo CDouble = CDouble -> CDouble -> CDouble + +foreign import ccall "math.h pow" + c_pow_1 :: CDouble -> CDouble -> Foo Int + +foreign import ccall "math.h pow" + c_pow_2 :: CDouble -> Foo Bool + +foreign import ccall "math.h pow" + c_pow_3 :: Foo CDouble ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -23,6 +23,7 @@ test('cc011', normal, compile, ['']) test('cc012', normal, compile, ['']) test('cc013', normal, compile, ['']) test('cc014', normal, compile, ['']) +test('ReducingFfiSignature', normal, compile, ['']) test('ffi-deriv1', normal, compile, ['']) test('T1357', normal, compile, ['']) test('T3624', normal, compile, ['']) ===================================== testsuite/tests/ffi/should_fail/NonreducingFfiSignature.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module NonreducingFfiSignature (c_pow) where + +import Foreign.C.Types (CDouble(..)) +import Data.Kind (Type) + +type family Foo (x :: Type) + +foreign import ccall "math.h pow" + c_pow :: CDouble -> CDouble -> Foo Int ===================================== testsuite/tests/ffi/should_fail/NonreducingFfiSignature.stderr ===================================== @@ -0,0 +1,6 @@ +NonreducingFfiSignature.hs:12:1: + Unacceptable result type in foreign declaration: + ‘Foo Int’ cannot be marshalled in a foreign call + When checking declaration: + foreign import ccall safe "math.h pow" c_pow + :: CDouble -> CDouble -> Foo Int ===================================== testsuite/tests/ffi/should_fail/all.T ===================================== @@ -10,6 +10,7 @@ test('ccfail004', [extra_files(['Ccfail004A.hs'])], multimod_compile_fail, ['ccf test('ccfail005', normal, compile_fail, ['']) test('ccall_value', normal, compile_fail, ['']) test('capi_value_function', normal, compile_fail, ['']) +test('NonreducingFfiSignature', normal, compile_fail, ['']) test('T5664', normal, compile_fail, ['-v0']) test('T7506', normal, compile_fail, ['']) test('T7243', normal, compile_fail, ['']) ===================================== testsuite/tests/ffi/should_run/T16650a.hs ===================================== @@ -0,0 +1,47 @@ +{-# language GADTSyntax #-} +{-# language KindSignatures #-} +{-# language UnliftedFFITypes #-} +{-# language ForeignFunctionInterface #-} +{-# language MagicHash #-} +{-# language UnboxedTuples #-} + +-- Test for shims when passing a ByteArray# to a foreign function. +-- The bad behavior here was initially observed in the MR +-- https://gitlab.haskell.org/ghc/ghc/merge_requests/939, +-- but this test has been named after issue #16650 since it +-- is closely related to the unexpected behavior there. + +import GHC.Exts +import GHC.Word +import GHC.IO +import Data.Kind (Type) + +main :: IO () +main = do + mb0 <- luckySingleton + print =<< readByteArray mb0 0 + case box mb0 of + Box x -> print =<< c_head_bytearray (unsafeCoerce# x) + +foreign import ccall unsafe "head_bytearray" + c_head_bytearray :: MutableByteArray# RealWorld -> IO Word8 + +data Box :: Type where + Box :: (Any :: TYPE 'UnliftedRep) -> Box + +data MutableByteArray :: Type where + MutableByteArray :: MutableByteArray# RealWorld -> MutableByteArray + +box :: MutableByteArray -> Box +{-# noinline box #-} +box (MutableByteArray x) = Box (unsafeCoerce# x) + +luckySingleton :: IO MutableByteArray +luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of + (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of + s2 -> (# s2, MutableByteArray marr# #) + +readByteArray :: MutableByteArray -> Int -> IO Word8 +readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 -> + case readWord8Array# b# i# s0 of + (# s1, w #) -> (# s1, W8# w #) ===================================== testsuite/tests/ffi/should_run/T16650a.stdout ===================================== @@ -0,0 +1,2 @@ +42 +42 ===================================== testsuite/tests/ffi/should_run/T16650a_c.c ===================================== @@ -0,0 +1,7 @@ +#include + +// Take the first element of a byte array. The array +// must have length >= 1. +uint8_t head_bytearray (uint8_t *arr) { + return arr[0]; +} ===================================== testsuite/tests/ffi/should_run/T16650b.hs ===================================== @@ -0,0 +1,69 @@ +{-# language GADTSyntax #-} +{-# language KindSignatures #-} +{-# language UnliftedFFITypes #-} +{-# language ForeignFunctionInterface #-} +{-# language MagicHash #-} +{-# language UnboxedTuples #-} + +-- Test for shims when passing an array of unlifted values +-- to a foreign function. +-- See test T16650a for more commentary. + +import GHC.Exts +import GHC.Word +import GHC.IO +import Data.Kind (Type) + +main :: IO () +main = do + mb0 <- luckySingleton + mb1 <- luckySingleton + mbs <- newByteArrays 2 + writeByteArrays mbs 0 mb0 + writeByteArrays mbs 1 mb0 + case box mbs of + Box x -> print =<< c_is_doubleton_homogeneous (unsafeCoerce# x) + writeByteArrays mbs 1 mb1 + case box mbs of + Box x -> print =<< c_is_doubleton_homogeneous (unsafeCoerce# x) + +foreign import ccall unsafe "is_doubleton_homogenous" + c_is_doubleton_homogeneous :: MutableArrayArray# RealWorld -> IO Word8 + +data Box :: Type where + Box :: (Any :: TYPE 'UnliftedRep) -> Box + +-- An array of bytes +data MutableByteArray :: Type where + MutableByteArray :: MutableByteArray# RealWorld -> MutableByteArray + +-- A mutable array of mutable byte arrays +data MutableByteArrays :: Type where + MutableByteArrays :: MutableArrayArray# RealWorld -> MutableByteArrays + +box :: MutableByteArrays -> Box +{-# noinline box #-} +box (MutableByteArrays x) = Box (unsafeCoerce# x) + +luckySingleton :: IO MutableByteArray +luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of + (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of + s2 -> (# s2, MutableByteArray marr# #) + +readByteArray :: MutableByteArray -> Int -> IO Word8 +readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 -> + case readWord8Array# b# i# s0 of + (# s1, w #) -> (# s1, W8# w #) + +-- Write a mutable byte array to the array of mutable byte arrays +-- at the given index. +writeByteArrays :: MutableByteArrays -> Int -> MutableByteArray -> IO () +writeByteArrays (MutableByteArrays maa#) (I# i#) (MutableByteArray a) = IO $ \s0 -> + case writeMutableByteArrayArray# maa# i# a s0 of + s1 -> (# s1, () #) + +-- Allocate a new array of mutable byte arrays. All elements are +-- uninitialized. Attempting to read them will cause a crash. +newByteArrays :: Int -> IO MutableByteArrays +newByteArrays (I# len#) = IO $ \s0 -> case newArrayArray# len# s0 of + (# s1, a# #) -> (# s1, MutableByteArrays a# #) ===================================== testsuite/tests/ffi/should_run/T16650b.stdout ===================================== @@ -0,0 +1,2 @@ +1 +0 ===================================== testsuite/tests/ffi/should_run/T16650b_c.c ===================================== @@ -0,0 +1,17 @@ +#include + +// Check to see if the first two elements in the array are +// the same pointer. Technically, GHC only promises that this is +// deterministic for arrays of unlifted identity-supporting +// types (MutableByteArray#, TVar#, MutVar#, etc.). However, +// in the tests, we assume that even for types that do not +// support identity (all lifted types, ByteArray#, Array#, etc.), +// GHC initializes every element in an array to the same pointer +// with newArray#. This is the GHC's actual behavior, and if +// newArray# stopped behaving this way, even if it wouldn't +// be a semantic bug, it would be a performance bug. Consequently, +// we assume this behavior in tests T16650c and T16650d. +uint8_t is_doubleton_homogenous (void **arr) { + return (arr[0] == arr[1]); +} + ===================================== testsuite/tests/ffi/should_run/T16650c.hs ===================================== @@ -0,0 +1,43 @@ +{-# language GADTSyntax #-} +{-# language KindSignatures #-} +{-# language UnliftedFFITypes #-} +{-# language ForeignFunctionInterface #-} +{-# language MagicHash #-} +{-# language UnboxedTuples #-} +{-# language ExplicitForAll #-} + +-- Test for shims when passing an array of lifted values +-- to a foreign function. +-- See test T16650a for more commentary. + +import GHC.Exts +import GHC.Word +import GHC.IO +import Data.Kind (Type) + +main :: IO () +main = do + mbs <- newArray 2 ((+55) :: Int -> Int) + case box mbs of + Box x -> print =<< c_is_doubleton_homogeneous (unsafeCoerce# x) + +foreign import ccall unsafe "is_doubleton_homogenous" + c_is_doubleton_homogeneous :: forall (a :: Type). + MutableArray# RealWorld a -> IO Word8 + +data Box :: Type where + Box :: (Any :: TYPE 'UnliftedRep) -> Box + +-- An array of unary integer functions +data MutableArray :: Type where + MutableArray :: MutableArray# RealWorld (Int -> Int) -> MutableArray + +box :: MutableArray -> Box +{-# noinline box #-} +box (MutableArray x) = Box (unsafeCoerce# x) + +-- Allocate a new array of unary integer functions. +newArray :: Int -> (Int -> Int) -> IO MutableArray +newArray (I# len#) x = IO $ \s0 -> case newArray# len# x s0 of + (# s1, a# #) -> (# s1, MutableArray a# #) + ===================================== testsuite/tests/ffi/should_run/T16650c.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/ffi/should_run/T16650c_c.c ===================================== @@ -0,0 +1,7 @@ +#include + +// See T16650b_c.c for commentary. +uint8_t is_doubleton_homogenous (void **arr) { + return (arr[0] == arr[1]); +} + ===================================== testsuite/tests/ffi/should_run/T16650d.hs ===================================== @@ -0,0 +1,45 @@ +{-# language GADTSyntax #-} +{-# language KindSignatures #-} +{-# language UnliftedFFITypes #-} +{-# language ForeignFunctionInterface #-} +{-# language MagicHash #-} +{-# language UnboxedTuples #-} +{-# language ExplicitForAll #-} + +-- Test for shims when passing an array of lifted values +-- to a foreign function. +-- See test T16650a for more commentary. + +import GHC.Exts +import GHC.Word +import GHC.IO +import Data.Kind (Type) + +main :: IO () +main = do + mbs <- newSmallArray 2 ((+55) :: Int -> Int) + case box mbs of + Box x -> print =<< c_is_doubleton_homogeneous (unsafeCoerce# x) + +foreign import ccall unsafe "is_doubleton_homogenous" + c_is_doubleton_homogeneous :: forall (a :: Type). + SmallMutableArray# RealWorld a -> IO Word8 + +data Box :: Type where + Box :: (Any :: TYPE 'UnliftedRep) -> Box + +-- An array of unary integer functions +data SmallMutableArray :: Type where + SmallMutableArray :: SmallMutableArray# RealWorld (Int -> Int) + -> SmallMutableArray + +box :: SmallMutableArray -> Box +{-# noinline box #-} +box (SmallMutableArray x) = Box (unsafeCoerce# x) + +-- Allocate a new array of unary integer functions. +newSmallArray :: Int -> (Int -> Int) -> IO SmallMutableArray +newSmallArray (I# len#) x = IO $ \s0 -> case newSmallArray# len# x s0 of + (# s1, a# #) -> (# s1, SmallMutableArray a# #) + + ===================================== testsuite/tests/ffi/should_run/T16650d.stdout ===================================== @@ -0,0 +1 @@ +1 ===================================== testsuite/tests/ffi/should_run/T16650d_c.c ===================================== @@ -0,0 +1,7 @@ +#include + +// See T16650b_c.c for commentary. +uint8_t is_doubleton_homogenous (void **arr) { + return (arr[0] == arr[1]); +} + ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,6 +191,14 @@ test('T12134', [omit_ways(['ghci'])], compile_and_run, ['T12134_c.c']) test('T12614', [omit_ways(['ghci'])], compile_and_run, ['T12614_c.c']) +test('T16650a', [omit_ways(['ghci'])], compile_and_run, ['T16650a_c.c']) + +test('T16650b', [omit_ways(['ghci'])], compile_and_run, ['T16650b_c.c']) + +test('T16650c', [omit_ways(['ghci'])], compile_and_run, ['T16650c_c.c']) + +test('T16650d', [omit_ways(['ghci'])], compile_and_run, ['T16650d_c.c']) + test('PrimFFIInt8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt8_c.c']) test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/db78ac6f5d69618ff143ab4b572e7f58a1805687 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/db78ac6f5d69618ff143ab4b572e7f58a1805687 You're receiving 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 Jun 4 05:10:24 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 01:10:24 -0400 Subject: [Git][ghc/ghc][master] Hadrian: fix OSX build failure and add an OSX/Hadrian CI job Message-ID: <5cf5fd40f241_1c95eb06ce8142185e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 2 changed files: - .gitlab-ci.yml - hadrian/src/Rules/Libffi.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,46 @@ validate-x86_64-darwin: - cabal-cache - toolchain +validate-x86_64-darwin-hadrian: + <<: *only-default + stage: full-build + tags: + - x86_64-darwin + variables: + GHC_VERSION: 8.6.3 + MACOSX_DEPLOYMENT_TARGET: "10.7" + ac_cv_func_clock_gettime: "no" + LANG: "en_US.UTF-8" + CONFIGURE_ARGS: --with-intree-gmp + TEST_ENV: "x86_64-darwin" + before_script: + - git clean -xdf && git submodule foreach git clean -xdf + - python3 .gitlab/fix-submodules.py + - git submodule sync --recursive + - git submodule update --init --recursive + - git checkout .gitmodules + - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + + - bash .gitlab/darwin-init.sh + - PATH="`pwd`/toolchain/bin:$PATH" + script: + - cabal update + - ./boot + - ./configure $CONFIGURE_ARGS + - hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist + - hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml + - mv _build/bindist/ghc*.tar.xz ghc.tar.xz + after_script: + - cp -Rf $HOME/.cabal cabal-cache + artifacts: + when: always + expire_in: 2 week + reports: + junit: junit.xml + paths: + - ghc.tar.xz + - junit.xml + .validate-linux: extends: .validate tags: ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -178,7 +178,7 @@ libffiRules = do | windows = "dll" | osx = "dylib" | otherwise = "so" - filepat = "lib" ++ libffiName'' ++ "*." ++ dynlibext ++ "*" + filepat = "lib" ++ libffiName'' ++ "." ++ dynlibext ++ "*" liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat] writeFileLines dynLibMan dynLibFiles View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/114b014f7ed346727241c78ef3e0bf965d94edfc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/114b014f7ed346727241c78ef3e0bf965d94edfc You're receiving 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 Jun 4 05:41:18 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 01:41:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cf6047e4f4e9_1c953faa1834a6dc1429383@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 08ad49ff by Xavier Denis at 2019-06-04T05:41:13Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 77372654 by Ben Gamari at 2019-06-04T05:41:14Z gitlab-ci: Run bindisttest during CI - - - - - 65c43671 by Ben Gamari at 2019-06-04T05:41:14Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - f7e4e4e0 by Alp Mestanogullari at 2019-06-04T05:41:15Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 30 changed files: - .gitlab-ci.yml - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - + testsuite/driver/js/Chart-2.8.0.min.js - + testsuite/driver/js/tooltip.js - testsuite/driver/perf_notes.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/ffi/should_compile/ReducingFfiSignature.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.hs - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.stderr - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/ffi/should_run/T16650a.hs - + testsuite/tests/ffi/should_run/T16650a.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/30adfea0c58166149bd3804b8622f8e794565889...f7e4e4e0e2c2ac650bf8f4f31eac4d2b7c0fd23e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/30adfea0c58166149bd3804b8622f8e794565889...f7e4e4e0e2c2ac650bf8f4f31eac4d2b7c0fd23e You're receiving 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 Jun 4 13:49:40 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 09:49:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch cherry-pick-0dde64f2 Message-ID: <5cf676f4a86e0_1c953faa1612b5b01496482@gitlab.haskell.org.mail> Ben Gamari pushed new branch cherry-pick-0dde64f2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/cherry-pick-0dde64f2 You're receiving 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 Jun 4 13:52:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 09:52:32 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cf677a0b70a0_1c953faa4115f1f015003ca@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: bb92dcde by Ben Gamari at 2019-06-04T13:52:24Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. This caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, exprIsHNF, exprType, stripTicksTopE, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,24 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , c1 `cheapEqExpr` c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` c1 + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb92dcde40ebb5460f319e344925f8f9c4ae92c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb92dcde40ebb5460f319e344925f8f9c4ae92c2 You're receiving 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 Jun 4 15:32:18 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 04 Jun 2019 11:32:18 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf68f023e108_1c953faa4392547815403dc@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: dbfe5a91 by Sebastian Graf at 2019-06-04T15:31:53Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. - - - - - 15 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - + testsuite/tests/pmcheck/should_compile/T12949.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmVarCt +mkPosEq x l = TVC x (PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,22 +2403,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr --- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +162,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +170,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +236,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +259,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), TmVarCtEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -45,202 +52,261 @@ import NameEnv %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr + +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [3]@, then trying to solve a 'TmVarCt' +-- like @x ~ 3@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !TmVarCtEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprLit', 'PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [4,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | Flatten the triangular subsitution. +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + nalts = fromMaybe [] (lookupDNameEnv neg x) + neg' = alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a 'PmExprCon' or 'PmExprLit' +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _is_whnf e ) + isRefutable x e neg + = Nothing + | otherwise + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) + where + _is_whnf PmExprCon{} = True + _is_whnf PmExprLit{} = True + _is_whnf _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +314,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | elem x set = set + | otherwise = x:set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/T12949.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T12949 where + +class Foo a where + foo :: Maybe a + +data Result a b = Neither | This a | That b | Both a b + +q :: forall a b . (Foo a, Foo b) => Result a b +q = case foo :: Maybe a of + Nothing -> case foo :: Maybe b of + Nothing -> Neither + Just c -> That c + Just i -> case foo :: Maybe b of + Nothing -> This i + Just c -> Both i c ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -94,8 +94,13 @@ test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T12949', [], compile, ['-fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) test('T12957a', [], compile, ['-fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # EmptyCase test('T10746', [], compile, ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dbfe5a91022b87710f1214bcad0478f447c696b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dbfe5a91022b87710f1214bcad0478f447c696b7 You're receiving 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 Jun 4 16:39:58 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 04 Jun 2019 12:39:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16608 Message-ID: <5cf69edea70f2_1c9527f33c815678cf@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T16608 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16608 You're receiving 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 Jun 4 16:59:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 12:59:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16748 Message-ID: <5cf6a3849a9e1_1c953faa1822ce581572763@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16748 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16748 You're receiving 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 Jun 4 17:08:24 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 13:08:24 -0400 Subject: [Git][ghc/ghc][wip/T16748] 2 commits: testsuite: Add support for generating OpenMetrics comparisons Message-ID: <5cf6a588a7f8e_1c953faa43925478157423c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16748 at Glasgow Haskell Compiler / GHC Commits: 4638602d by Ben Gamari at 2019-06-04T17:05:18Z testsuite: Add support for generating OpenMetrics comparisons This adds a flag to the perf_notes script, `--openmetrics`, allowing it to produce OpenMetrics output summarizing the largest changes between two commits. This can be fed to GitLab for visualization. See #16748. - - - - - bd2525f4 by Ben Gamari at 2019-06-04T17:08:05Z gitlab-ci: Collect OpenMetrics report - - - - - 2 changed files: - .gitlab-ci.yml - testsuite/driver/perf_notes.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -227,6 +227,16 @@ hadrian-ghc-in-ghci: - | THREADS=`mk/detect-cpu-count.sh` make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE + - | + # Generate OpenMetrics summary + if [ -n "$CI_MERGE_REQUEST_SOURCE_BRANCH_SHA" ]; then + testsuite/driver/perf_notes.py \ + --test-env=$TEST_ENV --openmetrics \ + $CI_MERGE_REQUEST_SOURCE_BRANCH_SHA $CI_COMMIT_SHA \ + > metrics.txt + else + echo "No base commit, skipping OpenMetrics generation..." + fi - | # Push git notes. METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh @@ -234,6 +244,7 @@ hadrian-ghc-in-ghci: artifacts: reports: junit: junit.xml + metrics: metrics.txt expire_in: 2 week paths: - ghc-*.tar.xz ===================================== testsuite/driver/perf_notes.py ===================================== @@ -503,6 +503,8 @@ if __name__ == '__main__': parser.add_argument("--add-note", nargs=3, help="Development only. --add-note N commit seed \ Adds N fake metrics to the given commit using the random seed.") + parser.add_argument("--openmetrics", action="store_true", + help="Produce an OpenMetrics report comparing two commits' metrics") parser.add_argument("--ref", type=str, default='perf', help="Git notes ref") parser.add_argument("commits", nargs=argparse.REMAINDER, @@ -576,6 +578,13 @@ if __name__ == '__main__': print(second_line) print("-" * (len(second_line)+1)) + def get_metric_avg(commit, test): + values = [float(t.stat.value) for t in metrics if t.commit == commit and t.stat.test == test] + if values == []: + return None + else: + return sum(values) / len(values) + def commit_string(test, flag): def delta(v1, v2): return round((100 * (v1 - v2)/v2),2) @@ -584,11 +593,7 @@ if __name__ == '__main__': # Note: if the test environment is not set, this will combine metrics from all test environments. averageValuesOrNones = [] for commit in args.commits: - values = [float(t.stat.value) for t in metrics if t.commit == commit and t.stat.test == test] - if values == []: - averageValuesOrNones.append(None) - else: - averageValuesOrNones.append(sum(values) / len(values)) + averageValuesOrNones.append(get_metric_avg(commit, test)) if flag == 'metrics': strings = [str(v) if v != None else '-' for v in averageValuesOrNones] @@ -606,17 +611,40 @@ if __name__ == '__main__': # # The pretty-printed output # - - header('commit') - # Printing out metrics. all_tests = sorted(set([(test.stat.test, test.stat.metric) for test in metrics])) - for test, metric in all_tests: - print("{:27}{:30}".format(test, metric) + commit_string(test,'metrics')) - - # Has no meaningful output if there is no commit to compare to. - if not singleton_commit: - header('percent') + if args.openmetrics: + if len(args.commits) == 2: + ref_commit, commit = args.commits + else: + raise ValueError("--openmetrics expects precisely two commits to compare") - # Printing out percentages. + metrics_by_test = {} + for test, metric in all_tests: + ref = get_metric_avg(ref_commit, test) + val = get_metric_avg(commit, test) + metrics_by_test[(test, metric)] = (ref, val) + + def rel_change(x): + (_, (ref, val)) = x + return (val - ref) / ref + sorted_metrics = sorted(metrics_by_test.items(), key=rel_change) + + num_results = 20 + to_render = sorted_metrics[:num_results] + sorted_metrics[-num_results:] + print('# Top {n} changes between {ref_commit} and {commit}'.format(n=num_results, ref_commit=ref_commit, commit=commit)) + for ((test, metric), (ref, val)) in to_render: + print("# {}/{}: {:10} -> {:10}: {:2.2}%".format(test, metric, ref, val, (val-ref) / ref * 100.0)) + print("{:27} {:30} {:10}".format(test, metric, val)) + else: + header('commit') + # Printing out metrics. for test, metric in all_tests: - print("{:27}{:30}".format(test, metric) + commit_string(test,'percentages')) + print("{:27}{:30}".format(test, metric) + commit_string(test,'metrics')) + + # Has no meaningful output if there is no commit to compare to. + if not singleton_commit: + header('percent') + + # Printing out percentages. + for test, metric in all_tests: + print("{:27}{:30}".format(test, metric) + commit_string(test,'percentages')) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96dbe869050a82133718581cb841787e5cb8d316...bd2525f442ae28155f17e339b7276f1033e01edf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96dbe869050a82133718581cb841787e5cb8d316...bd2525f442ae28155f17e339b7276f1033e01edf You're receiving 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 Jun 4 17:14:13 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 13:14:13 -0400 Subject: [Git][ghc/ghc][wip/T16748] gitlab-ci: Collect OpenMetrics report Message-ID: <5cf6a6e5cb83_1c953faa4115f1f0157496c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16748 at Glasgow Haskell Compiler / GHC Commits: eacddcc3 by Ben Gamari at 2019-06-04T17:14:02Z gitlab-ci: Collect OpenMetrics report - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -227,6 +227,17 @@ hadrian-ghc-in-ghci: - | THREADS=`mk/detect-cpu-count.sh` make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE + - | + # Generate OpenMetrics summary + if [ -n "$CI_MERGE_REQUEST_SOURCE_BRANCH_SHA" ]; then + testsuite/driver/perf_notes.py \ + --test-env=$TEST_ENV --openmetrics \ + $CI_MERGE_REQUEST_SOURCE_BRANCH_SHA \ + $CI_COMMIT_SHA \ + > metrics.txt + else + echo "No base commit, skipping OpenMetrics generation..." + fi - | # Push git notes. METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh @@ -234,6 +245,7 @@ hadrian-ghc-in-ghci: artifacts: reports: junit: junit.xml + metrics: metrics.txt expire_in: 2 week paths: - ghc-*.tar.xz View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/eacddcc3f35a1b4fb2e4030363dc2156cd36db96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/eacddcc3f35a1b4fb2e4030363dc2156cd36db96 You're receiving 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 Jun 4 18:05:09 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 04 Jun 2019 14:05:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-librts-symlinks Message-ID: <5cf6b2d52018a_1c953faa41186d7c15841cc@gitlab.haskell.org.mail> David Eichmann pushed new branch wip/hadrian-librts-symlinks at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/hadrian-librts-symlinks You're receiving 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 Jun 4 18:08:48 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 04 Jun 2019 14:08:48 -0400 Subject: [Git][ghc/ghc][wip/hadrian-librts-symlinks] Hadrian: Track RTS library symlink targets Message-ID: <5cf6b3b08f674_1c953faa3346ee441584430@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/hadrian-librts-symlinks at Glasgow Haskell Compiler / GHC Commits: d9db26c1 by David Eichmann at 2019-06-04T18:07:53Z Hadrian: Track RTS library symlink targets This requires creating RTS library symlinks when registering, outside of the rule for the registered library file. - - - - - 5 changed files: - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -16,7 +16,7 @@ module Hadrian.Utilities ( BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, -- * File system operations - copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile, + copyFile, copyFileUntracked, createFileLink, fixFile, makeExecutable, moveFile, removeFile, createDirectory, copyDirectory, moveDirectory, removeDirectory, @@ -289,15 +289,6 @@ infixl 1 <&> isGeneratedSource :: FilePath -> Action Bool isGeneratedSource file = buildRoot <&> (`isPrefixOf` file) --- | Link a file (without tracking the link target). Create the target directory --- if missing. -createFileLinkUntracked :: FilePath -> FilePath -> Action () -createFileLinkUntracked linkTarget link = do - let dir = takeDirectory link - liftIO $ IO.createDirectoryIfMissing True dir - putProgressInfo =<< renderCreateFileLink linkTarget link - quietly . liftIO $ IO.createFileLink linkTarget link - -- | Link a file tracking the link target. Create the target directory if -- missing. createFileLink :: FilePath -> FilePath -> Action () @@ -306,7 +297,10 @@ createFileLink linkTarget link = do then linkTarget else takeDirectory link -/- linkTarget need [source] - createFileLinkUntracked linkTarget link + let dir = takeDirectory link + liftIO $ IO.createDirectoryIfMissing True dir + putProgressInfo =<< renderCreateFileLink linkTarget link + quietly . liftIO $ IO.createFileLink linkTarget link -- | Copy a file tracking the source. Create the target directory if missing. copyFile :: FilePath -> FilePath -> Action () ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -11,7 +11,7 @@ import Expression hiding (way, package) import Oracles.ModuleFiles import Packages import Rules.Gmp -import Rules.Rts (needRtsLibffiTargets) +import Rules.Register import Target import Utilities @@ -85,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgRegisteredLibraryFile deps + registerPackages deps objs <- libraryObjects context build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath] @@ -144,28 +144,6 @@ libraryObjects context at Context{..} = do need $ noHsObjs ++ hsObjs return (noHsObjs ++ hsObjs) --- | Return extra library targets. -extraTargets :: Context -> Action [FilePath] -extraTargets context - | package context == rts = needRtsLibffiTargets (Context.stage context) - | otherwise = return [] - --- | Given a library 'Package' this action computes all of its targets. Needing --- all the targets should build the library such that it is ready to be --- registered into the package database. --- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. -libraryTargets :: Bool -> Context -> Action [FilePath] -libraryTargets includeGhciLib context at Context {..} = do - libFile <- pkgLibraryFile context - ghciLib <- pkgGhciLibraryFile context - ghci <- if includeGhciLib && not (wayUnit Dynamic way) - then interpretInContext context $ getContextData buildGhciLib - else return False - extra <- extraTargets context - return $ [ libFile ] - ++ [ ghciLib | ghci ] - ++ extra - -- | Coarse-grain 'need': make sure all given libraries are fully built. needLibrary :: [Context] -> Action () needLibrary cs = need =<< concatMapM (libraryTargets True) cs ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -15,6 +15,7 @@ import Settings.Default import Target import Utilities import Rules.Library +import Rules.Register -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () @@ -96,8 +97,7 @@ buildProgram bin ctx@(Context{..}) rs = do -- but when building the program, we link against the *ghc-pkg registered* library e.g. -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so -- so we use pkgRegisteredLibraryFile instead. - need =<< mapM pkgRegisteredLibraryFile - =<< contextDependencies ctx + registerPackages =<< contextDependencies ctx cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,7 +1,11 @@ -module Rules.Register (configurePackageRules, registerPackageRules) where +module Rules.Register ( + configurePackageRules, registerPackageRules, registerPackages, + libraryTargets + ) where import Base import Context +import Expression ( getContextData ) import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal @@ -12,7 +16,9 @@ import Rules.Rts import Settings import Target import Utilities -import Rules.Library + +import Hadrian.Haskell.Cabal.Type +import qualified Text.Parsec as Parsec import Distribution.Version (Version) import qualified Distribution.Parsec as Cabal @@ -21,7 +27,6 @@ import qualified Distribution.Types.PackageId as Cabal import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO -import qualified Text.Parsec as Parsec -- * Configuring @@ -63,6 +68,15 @@ parseToBuildSubdirectory root = do -- * Registering +registerPackages :: [Context] -> Action () +registerPackages ctxs = do + need =<< mapM pkgRegisteredLibraryFile ctxs + + -- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). + forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do + ways <- interpretInContext ctx (getLibraryWays <> getRtsWays) + needRtsSymLinks (stage ctx) ways + -- | Register a package and initialise the corresponding package database if -- need be. Note that we only register packages in 'Stage0' and 'Stage1'. registerPackageRules :: [(Resource, Int)] -> Stage -> Rules () @@ -118,9 +132,6 @@ buildConf _ context at Context {..} conf = do Cabal.copyPackage context Cabal.registerPackage context - -- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). - when (package == rts) (needRtsSymLinks stage ways) - -- The above two steps produce an entry in the package database, with copies -- of many of the files we have build, e.g. Haskell interface files. We need -- to record this side effect so that Shake can cache these files too. @@ -171,3 +182,25 @@ parseCabalName = fmap f . Cabal.eitherParsec where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + +-- | Return extra library targets. +extraTargets :: Context -> Action [FilePath] +extraTargets context + | package context == rts = needRtsLibffiTargets (Context.stage context) + | otherwise = return [] + +-- | Given a library 'Package' this action computes all of its targets. Needing +-- all the targets should build the library such that it is ready to be +-- registered into the package database. +-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. +libraryTargets :: Bool -> Context -> Action [FilePath] +libraryTargets includeGhciLib context at Context {..} = do + libFile <- pkgLibraryFile context + ghciLib <- pkgGhciLibraryFile context + ghci <- if includeGhciLib && not (wayUnit Dynamic way) + then interpretInContext context $ getContextData buildGhciLib + else return False + extra <- extraTargets context + return $ [ libFile ] + ++ [ ghciLib | ghci ] + ++ extra \ No newline at end of file ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -17,7 +17,7 @@ rtsRules = priority 3 $ do root -/- "//libHSrts_*-ghc*.dylib", root -/- "//libHSrts-ghc*.so", root -/- "//libHSrts-ghc*.dylib"] - |%> \ rtsLibFilePath' -> createFileLinkUntracked + |%> \ rtsLibFilePath' -> createFileLink (addRtsDummyVersion $ takeFileName rtsLibFilePath') rtsLibFilePath' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9db26c147389164484d90a5ca5a832e67ca1f62 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d9db26c147389164484d90a5ca5a832e67ca1f62 You're receiving 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 Jun 4 18:31:25 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Tue, 04 Jun 2019 14:31:25 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add documentation in user guide Message-ID: <5cf6b8fd49eef_1c953faa41186d7c1590016@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 4617c0f7 by Matthías Páll Gissurarson at 2019-06-04T18:31:15Z Add documentation in user guide - - - - - 2 changed files: - compiler/typecheck/TcRnTypes.hs - docs/users_guide/extending_ghc.rst Changes: ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -4026,12 +4026,14 @@ data HoleFitPlugin = HoleFitPlugin { candPlugin :: CandPlugin , fitPlugin :: FitPlugin } --- | HoleFitPluginR allows plugins to use an internal TcRef for tracking state. +-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can +-- track internal state. Note the existential quantification, ensuring that +-- the state cannot be modified from outside the plugin. data HoleFitPluginR = forall s. HoleFitPluginR { hfPluginInit :: TcM (TcRef s) -- ^ Initializes the TcRef to be passed to the plugin , holeFitPluginR :: TcRef s -> HoleFitPlugin - -- ^ + -- ^ The function defining the plugin itself , hfPluginStop :: TcRef s -> TcM () - -- ^ Cleanup of state, guaranteed to be called even on error. + -- ^ Cleanup of state, guaranteed to be called even on error } ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -833,6 +833,329 @@ output: typeCheckPlugin (tc): {$trModule = Module (TrNameS "main"#) (TrNameS "A"#), a = ()} +.. _hole-fit-plugins + +Hole fit plugins +~~~~~~~~~~~~~~~~ + +Hole-fit plugins are plugins that are called when a typed-hole error message is +being generated, and allows you to access information about the typed-hole at +compile time, and allows you to customize valid hole fit suggestions. + +Using hole-fit plugins, you can extend the behavior of valid hole fit +suggestions to use e.g. Hoogle or other external tools to find and/or synthesize +valid hole fits, with the same information about the typed-hole that GHC uses. + +There are two access points are bundled together for defining hole fit plugins, +namely a candidate plugin and a fit plugin, for modifying the candidates to be +checked and fits respectively. + + +:: + + type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] + + type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] + + data HoleFitPlugin = HoleFitPlugin + { candPlugin :: CandPlugin + -- ^ A plugin for modifying hole fit candidates before they're checked + , fitPlugin :: FitPlugin + -- ^ A plugin for modifying valid hole fits after they've been found. + } + +Where ``TypedHole`` contains all the information about the hole available to GHC +at error generation. + +:: + + data TypedHole = TyH { relevantCts :: Cts + -- ^ Any relevant Cts to the hole + , implics :: [Implication] + -- ^ The nested implications of the hole with the + -- innermost implication first. + , holeCt :: Maybe Ct + -- ^ The hole constraint itself, if available. + } + +``HoleFitPlugins`` are then defined as follows + +:: + + plugin :: Plugin + plugin = defaultPlugin { + holeFitPlugin = (fmap . fmap) fromPureHFPlugin hfPlugin + } + + + hfPlugin :: [CommandLineOption] -> Maybe HoleFitPlugin + + +Where ``fromPureHFPlugin :: HoleFitPlugin -> HoleFitPluginR`` is a convencience +function provided in the ``TcHoleErrors`` module, for defining plugins that do +not require internal state. + + +Stateful hole fit plugins +^^^^^^^^^^^^^^^^^^^^^^^^^ + + +``HoleFitPlugins`` are wrapped in a ``HoleFitPluginR``, which provides a +``TcRef`` for the plugin to use to track internal state, and to facilitate +communication between the candidate and fit plugin. + +:: + + -- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can + -- track internal state. Note the existential quantification, ensuring that + -- the state cannot be modified from outside the plugin. + data HoleFitPluginR = forall s. HoleFitPluginR + { hfPluginInit :: TcM (TcRef s) + -- ^ Initializes the TcRef to be passed to the plugin + , holeFitPluginR :: TcRef s -> HoleFitPlugin + -- ^ The function defining the plugin itself + , hfPluginStop :: TcRef s -> TcM () + -- ^ Cleanup of state, guaranteed to be called even on error + } + +The plugin is then defined as by providing a value for the ``holeFitPlugin`` +field, a function that takes the ``CommandLineOption`` strings that are passed +to the compiler using the :ghc-flag:`-fplugin-opt` flags and returns a +``HoleFitPluginR``. This function can be used to pass the ``CommandLineOption`` +strings along to the candidate and fit plugins respectively. + + + +Hole fit plugin example +^^^^^^^^^^^^^^^^^^^^^^^ + +The following plugins allows users to limit the search for valid hole fits to +certain modules, to sort the hole fits by where they originated (in ascending or +descending order), as well as allowing users to put a limit on how much time is +spent on searching for valid hole fits, after which new searches are aborted. + +:: + + {-# LANGUAGE TypeApplications, RecordWildCards #-} + module HolePlugin where + + import GhcPlugins hiding ((<>)) + + import TcHoleErrors + + import Data.List (stripPrefix, sortOn) + + import TcRnTypes + + import TcRnMonad + + import Data.Time (UTCTime, NominalDiffTime) + import qualified Data.Time as Time + + import Text.Read + + + data HolePluginState = HPS { timeAlloted :: Maybe NominalDiffTime + , elapsedTime :: NominalDiffTime + , timeCurStarted :: UTCTime } + + bumpElapsed :: NominalDiffTime -> HolePluginState -> HolePluginState + bumpElapsed ad (HPS a e t) = HPS a (e + ad) t + + setAlloted :: Maybe NominalDiffTime -> HolePluginState -> HolePluginState + setAlloted a (HPS _ e t) = HPS a e t + + setCurStarted :: UTCTime -> HolePluginState -> HolePluginState + setCurStarted nt (HPS a e _) = HPS a e nt + + hpStartState :: HolePluginState + hpStartState = HPS Nothing zero undefined + where zero = fromInteger @NominalDiffTime 0 + + initPlugin :: [CommandLineOption] -> TcM (TcRef HolePluginState) + initPlugin [msecs] = newTcRef $ hpStartState { timeAlloted = alloted } + where + errMsg = "Invalid amount of milliseconds given to plugin: " <> show msecs + alloted = case readMaybe @Integer msecs of + Just millisecs -> Just $ fromInteger @NominalDiffTime millisecs / 1000 + _ -> error errMsg + initPlugin _ = newTcRef hpStartState + + fromModule :: HoleFitCandidate -> [String] + fromModule (GreHFCand gre) = + map (moduleNameString . importSpecModule) $ gre_imp gre + fromModule _ = [] + + toHoleFitCommand :: TypedHole -> String -> Maybe String + toHoleFitCommand TyH{holeCt = Just (CHoleCan _ h)} str + = stripPrefix ("_" <> str) $ occNameString $ holeOcc h + toHoleFitCommand _ _ = Nothing + + -- | This candidate plugin filters the candidates by module, + -- using the name of the hole as module to search in + modFilterTimeoutP :: [CommandLineOption] -> TcRef HolePluginState -> CandPlugin + modFilterTimeoutP _ ref hole cands = do + curTime <- liftIO Time.getCurrentTime + HPS {..} <- readTcRef ref + updTcRef ref (setCurStarted curTime) + return $ case timeAlloted of + -- If we're out of time we remove all the candidates. Then nothing is checked. + Just sofar | elapsedTime > sofar -> [] + _ -> case toHoleFitCommand hole "only_" of + + Just modName -> filter (inScopeVia modName) cands + _ -> cands + where inScopeVia modNameStr cand@(GreHFCand _) = + elem (toModName modNameStr) $ fromModule cand + inScopeVia _ _ = False + toModName = replace '_' '.' + replace :: Eq a => a -> a -> [a] -> [a] + replace _ _ [] = [] + replace a b (x:xs) = (if x == a then b else x):replace a b xs + + modSortP :: [CommandLineOption] -> TcRef HolePluginState -> FitPlugin + modSortP _ ref hole hfs = do + curTime <- liftIO Time.getCurrentTime + HPS {..} <- readTcRef ref + updTcRef ref $ bumpElapsed (Time.diffUTCTime curTime timeCurStarted) + return $ case timeAlloted of + -- If we're out of time, remove any candidates, so nothing is checked. + Just sofar | elapsedTime > sofar -> [RawHoleFit $ text msg] + _ -> case toHoleFitCommand hole "sort_by_mod" of + -- If only_ is on, the fits will all be from the same module. + Just ('_':'d':'e':'s':'c':_) -> reverse hfs + Just _ -> orderByModule hfs + _ -> hfs + where orderByModule :: [HoleFit] -> [HoleFit] + orderByModule = sortOn (fmap fromModule . mbHFCand) + mbHFCand :: HoleFit -> Maybe HoleFitCandidate + mbHFCand HoleFit {hfCand = c} = Just c + mbHFCand _ = Nothing + msg = hang (text "Error: The time ran out, and the search was aborted for this hole.") + 7 $ text "Try again with a longer timeout." + + plugin :: Plugin + plugin = defaultPlugin { holeFitPlugin = holeFitP, pluginRecompile = purePlugin} + + holeFitP :: [CommandLineOption] -> Maybe HoleFitPluginR + holeFitP opts = Just (HoleFitPluginR initP pluginDef stopP) + where initP = initPlugin opts + stopP = const $ return () + pluginDef ref = HoleFitPlugin { candPlugin = modFilterTimeoutP opts ref + , fitPlugin = modSortP opts ref } + +When you then compile a module containing the following + +:: + + {-# OPTIONS -fplugin=HolePlugin + -fplugin-opt=HolePlugin:600 + -funclutter-valid-hole-fits #-} + module Main where + + import Prelude hiding (head, last) + + import Data.List (head, last) + + + f, g, h, i, j :: [Int] -> Int + f = _too_long + j = _ + i = _sort_by_mod_desc + g = _only_Data_List + h = _only_Prelude + + main :: IO () + main = return () + + +The output is as follows: + +.. code-block:: none + + Main.hs:12:5: error: + • Found hole: _too_long :: [Int] -> Int + Or perhaps ‘_too_long’ is mis-spelled, or not in scope + • In the expression: _too_long + In an equation for ‘f’: f = _too_long + • Relevant bindings include + f :: [Int] -> Int (bound at Main.hs:12:1) + Valid hole fits include + Error: The time ran out, and the search was aborted for this hole. + Try again with a longer timeout. + | + 12 | f = _too_long + | ^^^^^^^^^ + + Main.hs:13:5: error: + • Found hole: _ :: [Int] -> Int + • In the expression: _ + In an equation for ‘j’: j = _ + • Relevant bindings include + j :: [Int] -> Int (bound at Main.hs:13:1) + Valid hole fits include + j :: [Int] -> Int + f :: [Int] -> Int + g :: [Int] -> Int + h :: [Int] -> Int + i :: [Int] -> Int + head :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + | + 13 | j = _ + | ^ + + Main.hs:14:5: error: + • Found hole: _sort_by_mod_desc :: [Int] -> Int + Or perhaps ‘_sort_by_mod_desc’ is mis-spelled, or not in scope + • In the expression: _sort_by_mod_desc + In an equation for ‘i’: i = _sort_by_mod_desc + • Relevant bindings include + i :: [Int] -> Int (bound at Main.hs:14:1) + Valid hole fits include + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + last :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + | + 14 | i = _sort_by_mod_desc + | ^^^^^^^^^^^^^^^^^ + + Main.hs:15:5: error: + • Found hole: _only_Data_List :: [Int] -> Int + Or perhaps ‘_only_Data_List’ is mis-spelled, or not in scope + • In the expression: _only_Data_List + In an equation for ‘g’: g = _only_Data_List + • Relevant bindings include + g :: [Int] -> Int (bound at Main.hs:15:1) + Valid hole fits include + head :: forall a. [a] -> a + last :: forall a. [a] -> a + | + 15 | g = _only_Data_List + | ^^^^^^^^^^^^^^^ + + Main.hs:16:5: error: + • Found hole: _only_Prelude :: [Int] -> Int + Or perhaps ‘_only_Prelude’ is mis-spelled, or not in scope + • In the expression: _only_Prelude + In an equation for ‘h’: h = _only_Prelude + • Relevant bindings include + h :: [Int] -> Int (bound at Main.hs:16:1) + Valid hole fits include + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + | + 16 | h = _only_Prelude + | ^^^^^^^^^^^^^ + + .. _plugin_recompilation: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4617c0f7203654f5081f014a0b90f05288f97a42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4617c0f7203654f5081f014a0b90f05288f97a42 You're receiving 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 Jun 4 18:41:35 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 14:41:35 -0400 Subject: [Git][ghc/ghc][master] Add GHCi :instances command Message-ID: <5cf6bb5f84bae_1c953faa41186d7c15915ed@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 12 changed files: - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/ghci064.hs - + testsuite/tests/ghci/scripts/ghci064.script - + testsuite/tests/ghci/scripts/ghci064.stdout Changes: ===================================== compiler/main/GHC.hs ===================================== @@ -219,6 +219,8 @@ module GHC ( Kind, PredType, ThetaType, pprForAll, pprThetaArrowTy, + parseInstanceHead, + getInstancesForType, -- ** Entities TyThing(..), ===================================== compiler/main/HscMain.hs ===================================== @@ -67,6 +67,7 @@ module HscMain , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType , hscParseExpr + , hscParseType , hscCompileCoreExpr -- * Low-level exports for hooks , hscCompileCoreExpr' @@ -113,6 +114,7 @@ import SrcLoc import TcRnDriver import TcIface ( typecheckIface ) import TcRnMonad +import TcHsSyn ( ZonkFlexi (DefaultFlexi) ) import NameCache ( initNameCache ) import LoadIface ( ifaceStats, initExternalPackageState ) import PrelInfo @@ -1761,7 +1763,7 @@ hscKcType hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ty <- hscParseType str - ioMsgMaybe $ tcRnType hsc_env normalise ty + ioMsgMaybe $ tcRnType hsc_env DefaultFlexi normalise ty hscParseExpr :: String -> Hsc (LHsExpr GhcPs) hscParseExpr expr = do ===================================== compiler/main/InteractiveEval.hs ===================================== @@ -30,6 +30,8 @@ module InteractiveEval ( exprType, typeKind, parseName, + parseInstanceHead, + getInstancesForType, getDocs, GetDocsFailure(..), showModule, @@ -102,6 +104,19 @@ import GHC.Exts import Data.Array import Exception +import TcRnDriver ( runTcInteractive, tcRnType ) +import TcHsSyn ( ZonkFlexi (SkolemiseFlexi) ) + +import TcEnv (tcGetInstEnvs) + +import Inst (instDFunType) +import TcSimplify (solveWanteds) +import TcRnMonad +import TcEvidence +import Data.Bifunctor (second) + +import TcSMonad (runTcS) + -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -937,6 +952,161 @@ typeKind :: GhcMonad m => Bool -> String -> m (Type, Kind) typeKind normalise str = withSession $ \hsc_env -> do liftIO $ hscKcType hsc_env normalise str +-- ---------------------------------------------------------------------------- +-- Getting the class instances for a type + +{- + Note [Querying instances for a type] + + Here is the implementation of GHC proposal 41. + (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0041-ghci-instances.rst) + + The objective is to take a query string representing a (partial) type, and + report all the class single-parameter class instances available to that type. + Extending this feature to multi-parameter typeclasses is left as future work. + + The general outline of how we solve this is: + + 1. Parse the type, leaving skolems in the place of type-holes. + 2. For every class, get a list of all instances that match with the query type. + 3. For every matching instance, ask GHC for the context the instance dictionary needs. + 4. Format and present the results, substituting our query into the instance + and simplifying the context. + + For example, given the query "Maybe Int", we want to return: + + instance Show (Maybe Int) + instance Read (Maybe Int) + instance Eq (Maybe Int) + .... + + [Holes in queries] + + Often times we want to know what instances are available for a polymorphic type, + like `Maybe a`, and we'd like to return instances such as: + + instance Show a => Show (Maybe a) + .... + + These queries are expressed using type holes, so instead of `Maybe a` the user writes + `Maybe _`, we parse the type and during zonking, we skolemise it, replacing the holes + with (un-named) type variables. + + When zonking the type holes we have two real choices: replace them with Any or replace + them with skolem typevars. Using skolem type variables ensures that the output is more + intuitive to end users, and there is no difference in the results between Any and skolems. + +-} + +-- Find all instances that match a provided type +getInstancesForType :: GhcMonad m => Type -> m [ClsInst] +getInstancesForType ty = withSession $ \hsc_env -> do + liftIO $ runInteractiveHsc hsc_env $ do + ioMsgMaybe $ runTcInteractive hsc_env $ do + matches <- findMatchingInstances ty + fmap catMaybes . forM matches $ uncurry checkForExistence + +-- Parse a type string and turn any holes into skolems +parseInstanceHead :: GhcMonad m => String -> m Type +parseInstanceHead str = withSession $ \hsc_env0 -> do + (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ty <- hscParseType str + ioMsgMaybe $ tcRnType hsc_env SkolemiseFlexi True ty + + return ty + +-- Get all the constraints required of a dictionary binding +getDictionaryBindings :: PredType -> TcM WantedConstraints +getDictionaryBindings theta = do + dictName <- newName (mkDictOcc (mkVarOcc "magic")) + let dict_var = mkVanillaGlobal dictName theta + loc <- getCtLocM (GivenOrigin UnkSkol) Nothing + let wCs = mkSimpleWC [CtDerived + { ctev_pred = varType dict_var + , ctev_loc = loc + }] + + return wCs + +{- + When we've found an instance that a query matches against, we still need to + check that all the instance's constraints are satisfiable. checkForExistence + creates an instance dictionary and verifies that any unsolved constraints + mention a type-hole, meaning it is blocked on an unknown. + + If the instance satisfies this condition, then we return it with the query + substituted into the instance and all constraints simplified, for example given: + + instance D a => C (MyType a b) where + + and the query `MyType _ String` + + the unsolved constraints will be [D _] so we apply the substitution: + + { a -> _; b -> String} + + and return the instance: + + instance D _ => C (MyType _ String) + +-} + +checkForExistence :: ClsInst -> [DFunInstType] -> TcM (Maybe ClsInst) +checkForExistence res mb_inst_tys = do + (tys, thetas) <- instDFunType (is_dfun res) mb_inst_tys + + wanteds <- forM thetas getDictionaryBindings + (residuals, _) <- second evBindMapBinds <$> runTcS (solveWanteds (unionsWC wanteds)) + + let all_residual_constraints = bagToList $ wc_simple residuals + let preds = map ctPred all_residual_constraints + if all isSatisfiablePred preds && (null $ wc_impl residuals) + then return . Just $ substInstArgs tys preds res + else return Nothing + + where + + -- Stricter version of isTyVarClassPred that requires all TyConApps to have at least + -- one argument or for the head to be a TyVar. The reason is that we want to ensure + -- that all residual constraints mention a type-hole somewhere in the constraint, + -- meaning that with the correct choice of a concrete type it could be possible for + -- the constraint to be discharged. + isSatisfiablePred :: PredType -> Bool + isSatisfiablePred ty = case getClassPredTys_maybe ty of + Just (_, tys@(_:_)) -> all isTyVarTy tys + _ -> isTyVarTy ty + + empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType (idType $ is_dfun res))) + + {- Create a ClsInst with instantiated arguments and constraints. + + The thetas are the list of constraints that couldn't be solved because + they mention a type-hole. + -} + substInstArgs :: [Type] -> [PredType] -> ClsInst -> ClsInst + substInstArgs tys thetas inst = let + subst = foldl' (\a b -> uncurry (extendTvSubstAndInScope a) b) empty_subst (zip dfun_tvs tys) + -- Build instance head with arguments substituted in + tau = mkClassPred cls (substTheta subst args) + -- Constrain the instance with any residual constraints + phi = mkPhiTy thetas tau + sigma = mkForAllTys (map (\v -> Bndr v Inferred) dfun_tvs) phi + + in inst { is_dfun = (is_dfun inst) { varType = sigma }} + where + (dfun_tvs, _, cls, args) = instanceSig inst + +-- Find instances where the head unifies with the provided type +findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])] +findMatchingInstances ty = do + ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs + let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local + + concat <$> mapM (\cls -> do + let (matches, _, _) = lookupInstEnv True ies cls [ty] + return matches) allClasses + ----------------------------------------------------------------------------- -- Compile an expression, run it, and deliver the result ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2418,10 +2418,11 @@ tcRnImportDecls hsc_env import_decls -- tcRnType just finds the kind of a type tcRnType :: HscEnv + -> ZonkFlexi -> Bool -- Normalise the returned type -> LHsType GhcPs -> IO (Messages, Maybe (Type, Kind)) -tcRnType hsc_env normalise rdr_type +tcRnType hsc_env flexi normalise rdr_type = runTcInteractive hsc_env $ setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType] do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs) @@ -2444,7 +2445,9 @@ tcRnType hsc_env normalise rdr_type -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ; kvs <- kindGeneralize kind - ; ty <- zonkTcTypeToType ty + ; e <- mkEmptyZonkEnv flexi + + ; ty <- zonkTcTypeToTypeX e ty -- Do validity checking on type ; checkValidType (GhciCtxt True) ty ===================================== compiler/types/InstEnv.hs ===================================== @@ -21,7 +21,7 @@ module InstEnv ( emptyInstEnv, extendInstEnv, deleteFromInstEnv, deleteDFunFromInstEnv, identicalClsInstHead, - extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, + extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, instEnvClasses, memberInstEnv, instIsVisible, classInstances, instanceBindFun, @@ -427,6 +427,9 @@ instEnvElts :: InstEnv -> [ClsInst] instEnvElts ie = [elt | ClsIE elts <- eltsUDFM ie, elt <- elts] -- See Note [InstEnv determinism] +instEnvClasses :: InstEnv -> [Class] +instEnvClasses ie = [is_cls e | ClsIE (e : _) <- eltsUDFM ie] + -- | Test if an instance is visible, by checking that its origin module -- is in 'VisibleOrphanModules'. -- See Note [Instance lookup and orphan instances] ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -107,6 +107,11 @@ Compiler only convenient workaround was to enable `-fobject-code` for all modules. +GHCi +~~~~ + +- Added a command `:instances` to show the class instances available for a type. + Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -2539,6 +2539,38 @@ commonly used commands. The ``:loc-at`` command requires :ghci-cmd:`:set +c` to be set. +.. ghci-cmd:: :instances ⟨type⟩ + + Displays all the class instances available to the argument ⟨type⟩. + The command will match ⟨type⟩ with the first parameter of every + instance and then check that all constraints are satisfiable. + + When combined with ``-XPartialTypeSignatures``, a user can insert + wildcards into a query and learn the constraints required of each + wildcard for ⟨type⟩ match with an instance. + + The output is a listing of all matching instances, simplified and + instantiated as much as possible. + + For example: + + .. code-block:: none + >:instances Maybe (Maybe Int) + instance Eq (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Ord (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Show (Maybe (Maybe Int)) -- Defined in ‘GHC.Show’ + instance Read (Maybe (Maybe Int)) -- Defined in ‘GHC.Read’ + + >:set -XPartialTypeSignatures -fno-warn-partial-type-signatures + + >:instances Maybe _ + instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ + instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Semigroup (Maybe _) -- Defined in ‘GHC.Base’ + instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ + instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ + .. ghci-cmd:: :main; ⟨arg1⟩ ... ⟨argn⟩ When a program is compiled and executed, it can use the ``getArgs`` ===================================== ghc/GHCi/UI.hs ===================================== @@ -223,7 +223,8 @@ ghciCommands = map mkCmd [ ("unadd", keepGoingPaths unAddModule, completeFilename), ("undef", keepGoing undefineMacro, completeMacro), ("unset", keepGoing unsetOptions, completeSetOptions), - ("where", keepGoing whereCmd, noCompletion) + ("where", keepGoing whereCmd, noCompletion), + ("instances", keepGoing' instancesCmd, completeExpression) ] ++ map mkCmdHidden [ -- hidden commands ("all-types", keepGoing' allTypesCmd), ("complete", keepGoing completeCmd), @@ -1779,6 +1780,19 @@ handleGetDocsFailure no_docs = do NoDocsInIface {} -> InstallationError msg InteractiveName -> ProgramError msg +----------------------------------------------------------------------------- +-- :instances + +instancesCmd :: String -> InputT GHCi () +instancesCmd "" = + throwGhcException (CmdLineError "syntax: ':instances '") +instancesCmd s = do + handleSourceError GHC.printException $ do + ty <- GHC.parseInstanceHead s + res <- GHC.getInstancesForType ty + + printForUser $ vcat $ map ppr res + ----------------------------------------------------------------------------- -- :load, :add, :reload ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -106,7 +106,7 @@ test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']), when(config.have_ext_interp, extra_ways(['ghci-ext']))], ghci_script, ['ghci062.script']) test('ghci063', normal, ghci_script, ['ghci063.script']) - +test('ghci064', normal, ghci_script, ['ghci064.script']) test('T2452', [extra_hc_opts("-fno-implicit-import-qualified")], ghci_script, ['T2452.script']) test('T2766', normal, ghci_script, ['T2766.script']) ===================================== testsuite/tests/ghci/scripts/ghci064.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances, TypeFamilies #-} +import Data.Kind (Type) + +class MyShow a where + myshow :: a -> String + +instance MyShow a => MyShow [a] where + myshow xs = concatMap myshow xs + +data T = MkT + +instance MyShow T where + myshow x = "Used generic instance" + +instance MyShow [T] where + myshow xs = "Used more specific instance" + + +type family F a :: Type +type instance F [a] = a -> F a +type instance F Int = Bool ===================================== testsuite/tests/ghci/scripts/ghci064.script ===================================== @@ -0,0 +1,21 @@ +-- Test :instances +:instances Maybe + +:set -XPartialTypeSignatures -fno-warn-partial-type-signatures +-- Test queries with holes +:instances Maybe _ + +:load ghci064 + +-- Test that overlapping instances are all reported in the results +:instances [_] +:instances [T] + +-- Test that we can find instances for type families + +:instances F Int + +-- Test to make sure that the constraints of returned instances are all properly verified +-- We don't want the command to return an Applicative or Monad instance for tuple because +-- there is no Int Monoid instance. +:instances (,) Int ===================================== testsuite/tests/ghci/scripts/ghci064.stdout ===================================== @@ -0,0 +1,35 @@ +instance GHC.Base.Alternative Maybe -- Defined in ‘GHC.Base’ +instance Applicative Maybe -- Defined in ‘GHC.Base’ +instance Functor Maybe -- Defined in ‘GHC.Base’ +instance Monad Maybe -- Defined in ‘GHC.Base’ +instance GHC.Base.MonadPlus Maybe -- Defined in ‘GHC.Base’ +instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ +instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ +instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ +instance Semigroup _ => Semigroup (Maybe _) + -- Defined in ‘GHC.Base’ +instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ +instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ +instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’ +instance Monoid [_] -- Defined in ‘GHC.Base’ +instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’ +instance Semigroup [_] -- Defined in ‘GHC.Base’ +instance Show _ => Show [_] -- Defined in ‘GHC.Show’ +instance Read _ => Read [_] -- Defined in ‘GHC.Read’ +instance [safe] MyShow _ => MyShow [_] + -- Defined at ghci064.hs:7:10 +instance Monoid [T] -- Defined in ‘GHC.Base’ +instance Semigroup [T] -- Defined in ‘GHC.Base’ +instance [safe] MyShow [T] -- Defined at ghci064.hs:7:10 +instance [safe] MyShow [T] -- Defined at ghci064.hs:15:10 +instance Eq Bool -- Defined in ‘GHC.Classes’ +instance Ord Bool -- Defined in ‘GHC.Classes’ +instance Show Bool -- Defined in ‘GHC.Show’ +instance Read Bool -- Defined in ‘GHC.Read’ +instance Enum Bool -- Defined in ‘GHC.Enum’ +instance Bounded Bool -- Defined in ‘GHC.Enum’ +instance Data.Bits.Bits Bool -- Defined in ‘Data.Bits’ +instance Data.Bits.FiniteBits Bool -- Defined in ‘Data.Bits’ +instance GHC.Arr.Ix Bool -- Defined in ‘GHC.Arr’ +instance Functor ((,) Int) -- Defined in ‘GHC.Base’ +instance Foldable ((,) Int) -- Defined in ‘Data.Foldable’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/002594b731c40334b33eb883275e9c274c68e9ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/002594b731c40334b33eb883275e9c274c68e9ac You're receiving 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 Jun 4 18:42:11 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 14:42:11 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Run bindisttest during CI Message-ID: <5cf6bb833441a_1c959cc57a0159653d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - 3 changed files: - .gitlab-ci.yml - ghc.mk - ghc/ghc.mk Changes: ===================================== .gitlab-ci.yml ===================================== @@ -217,6 +217,8 @@ hadrian-ghc-in-ghci: - | THREADS=`mk/detect-cpu-count.sh` make V=0 -j$THREADS WERROR=-Werror + - | + make bindisttest - | make binary-dist TAR_COMP_OPTS="-1" - | @@ -650,6 +652,7 @@ nightly-i386-windows-hadrian: - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" + - bash -c "PATH=`pwd`/toolchain/bin:$PATH make bindisttest" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1" - bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' tags: ===================================== ghc.mk ===================================== @@ -1021,6 +1021,8 @@ $(eval $(call bindist-list,.,\ $(BINDIST_LIBS) \ $(BINDIST_HI) \ $(BINDIST_EXTRAS) \ + includes/Makefile \ + $(includes_SETTINGS) \ $(includes_H_FILES) \ $(includes_DERIVEDCONSTANTS) \ $(includes_GHCCONSTANTS) \ @@ -1037,7 +1039,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/002594b731c40334b33eb883275e9c274c68e9ac...c16f3297401f8f1f0f5d289867725ad185ac5a40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/002594b731c40334b33eb883275e9c274c68e9ac...c16f3297401f8f1f0f5d289867725ad185ac5a40 You're receiving 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 Jun 4 18:43:20 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 14:43:20 -0400 Subject: [Git][ghc/ghc][master] Hadrian: profiling and debug enabled ways support -eventlog too Message-ID: <5cf6bbc8bf687_1c953fa9ee6aafa416022dc@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -176,10 +176,12 @@ wayGhcArgs = do , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS" , (Debug `wayUnit` way) ? arg "-optc-DDEBUG" , (Profiling `wayUnit` way) ? arg "-prof" - , (Logging `wayUnit` way) ? arg "-eventlog" + , supportsEventlog way ? arg "-eventlog" , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] + where supportsEventlog w = any (`wayUnit` w) [Logging, Profiling, Debug] + packageGhcArgs :: Args packageGhcArgs = do package <- getPackage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba4e3934abc82e0ba2bec51842315819910d1018 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba4e3934abc82e0ba2bec51842315819910d1018 You're receiving 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 Jun 4 19:08:38 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Tue, 04 Jun 2019 15:08:38 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add a test for hole fit plugins Message-ID: <5cf6c1b6e94a8_1c953faa4383bfbc1605049@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 36239989 by Matthías Páll Gissurarson at 2019-06-04T19:08:26Z Add a test for hole fit plugins - - - - - 8 changed files: - testsuite/tests/plugins/Makefile - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal - + testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs - + testsuite/tests/plugins/hole-fit-plugin/Makefile - + testsuite/tests/plugins/hole-fit-plugin/Setup.hs - + testsuite/tests/plugins/test-hole-plugin.hs - + testsuite/tests/plugins/test-hole-plugin.stderr Changes: ===================================== testsuite/tests/plugins/Makefile ===================================== @@ -130,3 +130,7 @@ T16104: T16260: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin -fplugin-trustworthy + +.PHONY: HoleFitPlugin +HoleFitPlugin: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 HoleFitPlugin.hs -package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf ===================================== testsuite/tests/plugins/all.T ===================================== @@ -200,8 +200,16 @@ test('T16104', ], makefile_test, []) + test('T16260', [extra_files(['simple-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T16260 TOP={top}') ], makefile_test, []) + +test('test-hole-plugin', + [extra_files(['hole-fit-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hole-fit-plugin package.hole-fit-plugin TOP={top}'), + extra_hc_opts("-package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf ") + ], + compile, ['-fdefer-typed-holes']) ===================================== testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal ===================================== @@ -0,0 +1,11 @@ +name: HoleFitPlugin +cabal-version: >= 1.24 +build-type: Simple +version: 1.0.0 + + +library + default-language: Haskell2010 + build-depends: base, ghc, time + exposed-modules: HoleFitPlugin + ghc-options: -Wall ===================================== testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs ===================================== @@ -0,0 +1,89 @@ +{-# LANGUAGE TypeApplications, RecordWildCards #-} +module HoleFitPlugin where + +import GhcPlugins hiding ((<>)) + +import TcHoleErrors + +import Data.List (stripPrefix, sortOn) + +import TcRnTypes + +import TcRnMonad + +import Text.Read + + + +data HolePluginState = HPS { holesChecked :: Int + , holesLimit :: Maybe Int} + +bumpHolesChecked :: HolePluginState -> HolePluginState +bumpHolesChecked (HPS h l) = HPS (h + 1) l + +initPlugin :: [CommandLineOption] -> TcM (TcRef HolePluginState) +initPlugin [limit] = newTcRef $ HPS 0 $ + case readMaybe @Int limit of + Just number -> Just number + _ -> error $ "Invalid argument to plugin: " <> show limit +initPlugin _ = newTcRef $ HPS 0 Nothing + +fromModule :: HoleFitCandidate -> [String] +fromModule (GreHFCand gre) = + map (moduleNameString . importSpecModule) $ gre_imp gre +fromModule _ = [] + +toHoleFitCommand :: TypedHole -> String -> Maybe String +toHoleFitCommand TyH{holeCt = Just (CHoleCan _ h)} str + = stripPrefix ("_" <> str) $ occNameString $ holeOcc h +toHoleFitCommand _ _ = Nothing + + +-- | This candidate plugin filters the candidates by module, +-- using the name of the hole as module to search in +modFilterTimeoutP :: [CommandLineOption] -> TcRef HolePluginState -> CandPlugin +modFilterTimeoutP _ ref hole cands = do + updTcRef ref bumpHolesChecked + HPS {..} <- readTcRef ref + return $ case holesLimit of + -- If we're out of checks, remove any candidates, so nothing is checked. + Just limit | holesChecked > limit -> [] + _ -> case toHoleFitCommand hole "only_" of + Just modName -> filter (inScopeVia modName) cands + _ -> cands + where inScopeVia modNameStr cand@(GreHFCand _) = + elem (toModName modNameStr) $ fromModule cand + inScopeVia _ _ = False + toModName = replace '_' '.' + replace :: Eq a => a -> a -> [a] -> [a] + replace _ _ [] = [] + replace a b (x:xs) = (if x == a then b else x):replace a b xs + + +modSortP :: [CommandLineOption] -> TcRef HolePluginState -> FitPlugin +modSortP _ ref hole hfs = do + HPS {..} <- readTcRef ref + return $ case holesLimit of + Just limit | holesChecked > limit -> [RawHoleFit $ text msg] + _ -> case toHoleFitCommand hole "sort_by_mod" of + -- If only_ is on, the fits will all be from the same module. + Just ('_':'d':'e':'s':'c':_) -> reverse hfs + Just _ -> orderByModule hfs + _ -> hfs + where orderByModule :: [HoleFit] -> [HoleFit] + orderByModule = sortOn (fmap fromModule . mbHFCand) + mbHFCand :: HoleFit -> Maybe HoleFitCandidate + mbHFCand HoleFit {hfCand = c} = Just c + mbHFCand _ = Nothing + msg = "Error: Too many holes were checked, and the search aborted for" + <> "this hole. Try again with a higher limit." + +plugin :: Plugin +plugin = defaultPlugin { holeFitPlugin = holeFitP, pluginRecompile = purePlugin} + +holeFitP :: [CommandLineOption] -> Maybe HoleFitPluginR +holeFitP opts = Just (HoleFitPluginR initP pluginDef stopP) + where initP = initPlugin opts + stopP = const $ return () + pluginDef ref = HoleFitPlugin { candPlugin = modFilterTimeoutP opts ref + , fitPlugin = modSortP opts ref } ===================================== testsuite/tests/plugins/hole-fit-plugin/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + "$(GHC_PKG)" init pkg.$*/local.package.conf + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 ===================================== testsuite/tests/plugins/hole-fit-plugin/Setup.hs ===================================== @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain ===================================== testsuite/tests/plugins/test-hole-plugin.hs ===================================== @@ -0,0 +1,19 @@ +{-# OPTIONS -fplugin=HoleFitPlugin + -fplugin-opt=HoleFitPlugin:4 + -funclutter-valid-hole-fits #-} +module Main where + +import Prelude hiding (head, last) + +import Data.List (head, last) + + +f, g, h, i, j :: [Int] -> Int +f = _too_long +j = _ +i = _sort_by_mod_desc +g = _only_Data_List +h = _only_Prelude + +main :: IO () +main = return () ===================================== testsuite/tests/plugins/test-hole-plugin.stderr ===================================== @@ -0,0 +1,66 @@ + +test-hole-plugin.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _too_long :: [Int] -> Int + Or perhaps ‘_too_long’ is mis-spelled, or not in scope + • In the expression: _too_long + In an equation for ‘f’: f = _too_long + • Relevant bindings include + f :: [Int] -> Int (bound at test-hole-plugin.hs:12:1) + Valid hole fits include + Error: Too many holes were checked, and the search aborted forthis hole. Try again with a higher limit. + +test-hole-plugin.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Int] -> Int + • In the expression: _ + In an equation for ‘j’: j = _ + • Relevant bindings include + j :: [Int] -> Int (bound at test-hole-plugin.hs:13:1) + Valid hole fits include + j :: [Int] -> Int + f :: [Int] -> Int + i :: [Int] -> Int + g :: [Int] -> Int + h :: [Int] -> Int + head :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + +test-hole-plugin.hs:14:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _sort_by_mod_desc :: [Int] -> Int + Or perhaps ‘_sort_by_mod_desc’ is mis-spelled, or not in scope + • In the expression: _sort_by_mod_desc + In an equation for ‘i’: i = _sort_by_mod_desc + • Relevant bindings include + i :: [Int] -> Int (bound at test-hole-plugin.hs:14:1) + Valid hole fits include + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + last :: forall a. [a] -> a + (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) + +test-hole-plugin.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _only_Data_List :: [Int] -> Int + Or perhaps ‘_only_Data_List’ is mis-spelled, or not in scope + • In the expression: _only_Data_List + In an equation for ‘g’: g = _only_Data_List + • Relevant bindings include + g :: [Int] -> Int (bound at test-hole-plugin.hs:15:1) + Valid hole fits include + head :: forall a. [a] -> a + last :: forall a. [a] -> a + +test-hole-plugin.hs:16:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _only_Prelude :: [Int] -> Int + Or perhaps ‘_only_Prelude’ is mis-spelled, or not in scope + • In the expression: _only_Prelude + In an equation for ‘h’: h = _only_Prelude + • Relevant bindings include + h :: [Int] -> Int (bound at test-hole-plugin.hs:16:1) + Valid hole fits include + length :: forall (t :: * -> *) a. Foldable t => t a -> Int + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/36239989ba692c4a4d4a707be9882eb8d5f0dde8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/36239989ba692c4a4d4a707be9882eb8d5f0dde8 You're receiving 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 Jun 4 19:14:16 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 04 Jun 2019 15:14:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add GHCi :instances command Message-ID: <5cf6c308925cd_1c959cc57a016095bf@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 950efc74 by Matthew Pickering at 2019-06-04T19:14:08Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - e0cef1b8 by Ben Gamari at 2019-06-04T19:14:09Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - 24 changed files: - .gitlab-ci.yml - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/eventlog-formats.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Ghc.hs - includes/rts/EventLogFormat.h - rts/ProfHeap.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/ghci064.hs - + testsuite/tests/ghci/scripts/ghci064.script - + testsuite/tests/ghci/scripts/ghci064.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -217,6 +217,8 @@ hadrian-ghc-in-ghci: - | THREADS=`mk/detect-cpu-count.sh` make V=0 -j$THREADS WERROR=-Werror + - | + make bindisttest - | make binary-dist TAR_COMP_OPTS="-1" - | @@ -650,6 +652,7 @@ nightly-i386-windows-hadrian: - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" + - bash -c "PATH=`pwd`/toolchain/bin:$PATH make bindisttest" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1" - bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' tags: ===================================== compiler/main/GHC.hs ===================================== @@ -219,6 +219,8 @@ module GHC ( Kind, PredType, ThetaType, pprForAll, pprThetaArrowTy, + parseInstanceHead, + getInstancesForType, -- ** Entities TyThing(..), ===================================== compiler/main/HscMain.hs ===================================== @@ -67,6 +67,7 @@ module HscMain , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType , hscParseExpr + , hscParseType , hscCompileCoreExpr -- * Low-level exports for hooks , hscCompileCoreExpr' @@ -113,6 +114,7 @@ import SrcLoc import TcRnDriver import TcIface ( typecheckIface ) import TcRnMonad +import TcHsSyn ( ZonkFlexi (DefaultFlexi) ) import NameCache ( initNameCache ) import LoadIface ( ifaceStats, initExternalPackageState ) import PrelInfo @@ -1761,7 +1763,7 @@ hscKcType hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ty <- hscParseType str - ioMsgMaybe $ tcRnType hsc_env normalise ty + ioMsgMaybe $ tcRnType hsc_env DefaultFlexi normalise ty hscParseExpr :: String -> Hsc (LHsExpr GhcPs) hscParseExpr expr = do ===================================== compiler/main/InteractiveEval.hs ===================================== @@ -30,6 +30,8 @@ module InteractiveEval ( exprType, typeKind, parseName, + parseInstanceHead, + getInstancesForType, getDocs, GetDocsFailure(..), showModule, @@ -102,6 +104,19 @@ import GHC.Exts import Data.Array import Exception +import TcRnDriver ( runTcInteractive, tcRnType ) +import TcHsSyn ( ZonkFlexi (SkolemiseFlexi) ) + +import TcEnv (tcGetInstEnvs) + +import Inst (instDFunType) +import TcSimplify (solveWanteds) +import TcRnMonad +import TcEvidence +import Data.Bifunctor (second) + +import TcSMonad (runTcS) + -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -937,6 +952,161 @@ typeKind :: GhcMonad m => Bool -> String -> m (Type, Kind) typeKind normalise str = withSession $ \hsc_env -> do liftIO $ hscKcType hsc_env normalise str +-- ---------------------------------------------------------------------------- +-- Getting the class instances for a type + +{- + Note [Querying instances for a type] + + Here is the implementation of GHC proposal 41. + (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0041-ghci-instances.rst) + + The objective is to take a query string representing a (partial) type, and + report all the class single-parameter class instances available to that type. + Extending this feature to multi-parameter typeclasses is left as future work. + + The general outline of how we solve this is: + + 1. Parse the type, leaving skolems in the place of type-holes. + 2. For every class, get a list of all instances that match with the query type. + 3. For every matching instance, ask GHC for the context the instance dictionary needs. + 4. Format and present the results, substituting our query into the instance + and simplifying the context. + + For example, given the query "Maybe Int", we want to return: + + instance Show (Maybe Int) + instance Read (Maybe Int) + instance Eq (Maybe Int) + .... + + [Holes in queries] + + Often times we want to know what instances are available for a polymorphic type, + like `Maybe a`, and we'd like to return instances such as: + + instance Show a => Show (Maybe a) + .... + + These queries are expressed using type holes, so instead of `Maybe a` the user writes + `Maybe _`, we parse the type and during zonking, we skolemise it, replacing the holes + with (un-named) type variables. + + When zonking the type holes we have two real choices: replace them with Any or replace + them with skolem typevars. Using skolem type variables ensures that the output is more + intuitive to end users, and there is no difference in the results between Any and skolems. + +-} + +-- Find all instances that match a provided type +getInstancesForType :: GhcMonad m => Type -> m [ClsInst] +getInstancesForType ty = withSession $ \hsc_env -> do + liftIO $ runInteractiveHsc hsc_env $ do + ioMsgMaybe $ runTcInteractive hsc_env $ do + matches <- findMatchingInstances ty + fmap catMaybes . forM matches $ uncurry checkForExistence + +-- Parse a type string and turn any holes into skolems +parseInstanceHead :: GhcMonad m => String -> m Type +parseInstanceHead str = withSession $ \hsc_env0 -> do + (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do + hsc_env <- getHscEnv + ty <- hscParseType str + ioMsgMaybe $ tcRnType hsc_env SkolemiseFlexi True ty + + return ty + +-- Get all the constraints required of a dictionary binding +getDictionaryBindings :: PredType -> TcM WantedConstraints +getDictionaryBindings theta = do + dictName <- newName (mkDictOcc (mkVarOcc "magic")) + let dict_var = mkVanillaGlobal dictName theta + loc <- getCtLocM (GivenOrigin UnkSkol) Nothing + let wCs = mkSimpleWC [CtDerived + { ctev_pred = varType dict_var + , ctev_loc = loc + }] + + return wCs + +{- + When we've found an instance that a query matches against, we still need to + check that all the instance's constraints are satisfiable. checkForExistence + creates an instance dictionary and verifies that any unsolved constraints + mention a type-hole, meaning it is blocked on an unknown. + + If the instance satisfies this condition, then we return it with the query + substituted into the instance and all constraints simplified, for example given: + + instance D a => C (MyType a b) where + + and the query `MyType _ String` + + the unsolved constraints will be [D _] so we apply the substitution: + + { a -> _; b -> String} + + and return the instance: + + instance D _ => C (MyType _ String) + +-} + +checkForExistence :: ClsInst -> [DFunInstType] -> TcM (Maybe ClsInst) +checkForExistence res mb_inst_tys = do + (tys, thetas) <- instDFunType (is_dfun res) mb_inst_tys + + wanteds <- forM thetas getDictionaryBindings + (residuals, _) <- second evBindMapBinds <$> runTcS (solveWanteds (unionsWC wanteds)) + + let all_residual_constraints = bagToList $ wc_simple residuals + let preds = map ctPred all_residual_constraints + if all isSatisfiablePred preds && (null $ wc_impl residuals) + then return . Just $ substInstArgs tys preds res + else return Nothing + + where + + -- Stricter version of isTyVarClassPred that requires all TyConApps to have at least + -- one argument or for the head to be a TyVar. The reason is that we want to ensure + -- that all residual constraints mention a type-hole somewhere in the constraint, + -- meaning that with the correct choice of a concrete type it could be possible for + -- the constraint to be discharged. + isSatisfiablePred :: PredType -> Bool + isSatisfiablePred ty = case getClassPredTys_maybe ty of + Just (_, tys@(_:_)) -> all isTyVarTy tys + _ -> isTyVarTy ty + + empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType (idType $ is_dfun res))) + + {- Create a ClsInst with instantiated arguments and constraints. + + The thetas are the list of constraints that couldn't be solved because + they mention a type-hole. + -} + substInstArgs :: [Type] -> [PredType] -> ClsInst -> ClsInst + substInstArgs tys thetas inst = let + subst = foldl' (\a b -> uncurry (extendTvSubstAndInScope a) b) empty_subst (zip dfun_tvs tys) + -- Build instance head with arguments substituted in + tau = mkClassPred cls (substTheta subst args) + -- Constrain the instance with any residual constraints + phi = mkPhiTy thetas tau + sigma = mkForAllTys (map (\v -> Bndr v Inferred) dfun_tvs) phi + + in inst { is_dfun = (is_dfun inst) { varType = sigma }} + where + (dfun_tvs, _, cls, args) = instanceSig inst + +-- Find instances where the head unifies with the provided type +findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])] +findMatchingInstances ty = do + ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs + let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local + + concat <$> mapM (\cls -> do + let (matches, _, _) = lookupInstEnv True ies cls [ty] + return matches) allClasses + ----------------------------------------------------------------------------- -- Compile an expression, run it, and deliver the result ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2418,10 +2418,11 @@ tcRnImportDecls hsc_env import_decls -- tcRnType just finds the kind of a type tcRnType :: HscEnv + -> ZonkFlexi -> Bool -- Normalise the returned type -> LHsType GhcPs -> IO (Messages, Maybe (Type, Kind)) -tcRnType hsc_env normalise rdr_type +tcRnType hsc_env flexi normalise rdr_type = runTcInteractive hsc_env $ setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType] do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs) @@ -2444,7 +2445,9 @@ tcRnType hsc_env normalise rdr_type -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ; kvs <- kindGeneralize kind - ; ty <- zonkTcTypeToType ty + ; e <- mkEmptyZonkEnv flexi + + ; ty <- zonkTcTypeToTypeX e ty -- Do validity checking on type ; checkValidType (GhciCtxt True) ty ===================================== compiler/types/InstEnv.hs ===================================== @@ -21,7 +21,7 @@ module InstEnv ( emptyInstEnv, extendInstEnv, deleteFromInstEnv, deleteDFunFromInstEnv, identicalClsInstHead, - extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, + extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, instEnvClasses, memberInstEnv, instIsVisible, classInstances, instanceBindFun, @@ -427,6 +427,9 @@ instEnvElts :: InstEnv -> [ClsInst] instEnvElts ie = [elt | ClsIE elts <- eltsUDFM ie, elt <- elts] -- See Note [InstEnv determinism] +instEnvClasses :: InstEnv -> [Class] +instEnvClasses ie = [is_cls e | ClsIE (e : _) <- eltsUDFM ie] + -- | Test if an instance is visible, by checking that its origin module -- is in 'VisibleOrphanModules'. -- See Note [Instance lookup and orphan instances] ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -107,6 +107,11 @@ Compiler only convenient workaround was to enable `-fobject-code` for all modules. +GHCi +~~~~ + +- Added a command `:instances` to show the class instances available for a type. + Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -84,6 +84,14 @@ in length a single sample may need to be split among multiple ``EVENT_HEAP_PROF_SAMPLE`` events. The precise format of the census entries is determined by the break-down type. +At the end of the sample period the ``EVENT_HEAP_PROF_SAMPLE_END`` event if +emitted. This is useful to properly delimit the sampling period and to record +the total time spent profiling. + + + * ``EVENT_HEAP_PROF_SAMPLE_END`` + * ``Word64``: sample number + Cost-centre break-down ^^^^^^^^^^^^^^^^^^^^^^ ===================================== docs/users_guide/ghci.rst ===================================== @@ -2539,6 +2539,38 @@ commonly used commands. The ``:loc-at`` command requires :ghci-cmd:`:set +c` to be set. +.. ghci-cmd:: :instances ⟨type⟩ + + Displays all the class instances available to the argument ⟨type⟩. + The command will match ⟨type⟩ with the first parameter of every + instance and then check that all constraints are satisfiable. + + When combined with ``-XPartialTypeSignatures``, a user can insert + wildcards into a query and learn the constraints required of each + wildcard for ⟨type⟩ match with an instance. + + The output is a listing of all matching instances, simplified and + instantiated as much as possible. + + For example: + + .. code-block:: none + >:instances Maybe (Maybe Int) + instance Eq (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Ord (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Show (Maybe (Maybe Int)) -- Defined in ‘GHC.Show’ + instance Read (Maybe (Maybe Int)) -- Defined in ‘GHC.Read’ + + >:set -XPartialTypeSignatures -fno-warn-partial-type-signatures + + >:instances Maybe _ + instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ + instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Semigroup (Maybe _) -- Defined in ‘GHC.Base’ + instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ + instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ + .. ghci-cmd:: :main; ⟨arg1⟩ ... ⟨argn⟩ When a program is compiled and executed, it can use the ``getArgs`` ===================================== ghc.mk ===================================== @@ -1021,6 +1021,8 @@ $(eval $(call bindist-list,.,\ $(BINDIST_LIBS) \ $(BINDIST_HI) \ $(BINDIST_EXTRAS) \ + includes/Makefile \ + $(includes_SETTINGS) \ $(includes_H_FILES) \ $(includes_DERIVEDCONSTANTS) \ $(includes_GHCCONSTANTS) \ @@ -1037,7 +1039,7 @@ $(eval $(call bindist-list,.,\ $(wildcard compiler/stage2/doc) \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out settings llvm-targets llvm-passes,$(INSTALL_LIBS)) \ + $(filter-out llvm-targets llvm-passes,$(INSTALL_LIBS)) \ $(RTS_INSTALL_LIBS) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ ===================================== ghc/GHCi/UI.hs ===================================== @@ -223,7 +223,8 @@ ghciCommands = map mkCmd [ ("unadd", keepGoingPaths unAddModule, completeFilename), ("undef", keepGoing undefineMacro, completeMacro), ("unset", keepGoing unsetOptions, completeSetOptions), - ("where", keepGoing whereCmd, noCompletion) + ("where", keepGoing whereCmd, noCompletion), + ("instances", keepGoing' instancesCmd, completeExpression) ] ++ map mkCmdHidden [ -- hidden commands ("all-types", keepGoing' allTypesCmd), ("complete", keepGoing completeCmd), @@ -1779,6 +1780,19 @@ handleGetDocsFailure no_docs = do NoDocsInIface {} -> InstallationError msg InteractiveName -> ProgramError msg +----------------------------------------------------------------------------- +-- :instances + +instancesCmd :: String -> InputT GHCi () +instancesCmd "" = + throwGhcException (CmdLineError "syntax: ':instances '") +instancesCmd s = do + handleSourceError GHC.printException $ do + ty <- GHC.parseInstanceHead s + res <- GHC.getInstancesForType ty + + printForUser $ vcat $ map ppr res + ----------------------------------------------------------------------------- -- :load, :add, :reload ===================================== ghc/ghc.mk ===================================== @@ -129,10 +129,7 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -settings : $(includes_SETTINGS) - "$(CP)" $< $@ - -$(INPLACE_LIB)/settings : settings +$(INPLACE_LIB)/settings : $(includes_SETTINGS) "$(CP)" $< $@ $(INPLACE_LIB)/llvm-targets : llvm-targets @@ -171,7 +168,7 @@ $(GHC_STAGE2) : $(foreach w,$(GhcLibWays),libraries/base/dist-install/build/GHC/ endif -INSTALL_LIBS += settings +INSTALL_LIBS += $(includes_SETTINGS) INSTALL_LIBS += llvm-targets INSTALL_LIBS += llvm-passes ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -34,6 +34,7 @@ module Hadrian.Utilities ( Dynamic, fromDynamic, toDyn, TypeRep, typeOf ) where +import Control.Applicative import Control.Monad.Extra import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) @@ -296,7 +297,9 @@ createFileLinkUntracked linkTarget link = do let dir = takeDirectory link liftIO $ IO.createDirectoryIfMissing True dir putProgressInfo =<< renderCreateFileLink linkTarget link - quietly . liftIO $ IO.createFileLink linkTarget link + quietly . liftIO $ do + IO.removeFile link <|> return () + IO.createFileLink linkTarget link -- | Link a file tracking the link target. Create the target directory if -- missing. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -176,10 +176,12 @@ wayGhcArgs = do , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS" , (Debug `wayUnit` way) ? arg "-optc-DDEBUG" , (Profiling `wayUnit` way) ? arg "-prof" - , (Logging `wayUnit` way) ? arg "-eventlog" + , supportsEventlog way ? arg "-eventlog" , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] + where supportsEventlog w = any (`wayUnit` w) [Logging, Profiling, Debug] + packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ===================================== includes/rts/EventLogFormat.h ===================================== @@ -178,6 +178,7 @@ #define EVENT_HEAP_PROF_SAMPLE_BEGIN 162 #define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163 #define EVENT_HEAP_PROF_SAMPLE_STRING 164 +#define EVENT_HEAP_PROF_SAMPLE_END 165 #define EVENT_USER_BINARY_MSG 181 ===================================== rts/ProfHeap.c ===================================== @@ -884,6 +884,7 @@ dumpCensus( Census *census ) fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } + traceHeapProfSampleEnd(era); printSample(false, census->time); } ===================================== rts/Trace.c ===================================== @@ -623,6 +623,13 @@ void traceHeapProfSampleBegin(StgInt era) } } +void traceHeapProfSampleEnd(StgInt era) +{ + if (eventlog_enabled) { + postHeapProfSampleEnd(era); + } +} + void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency) { ===================================== rts/Trace.h ===================================== @@ -288,6 +288,7 @@ void traceTaskDelete_ (Task *task); void traceHeapProfBegin(StgWord8 profile_id); void traceHeapProfSampleBegin(StgInt era); +void traceHeapProfSampleEnd(StgInt era); void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency); #if defined(PROFILING) @@ -335,6 +336,7 @@ void flushTrace(void); #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ +#define traceHeapProfSampleEnd(era) /* nothing */ #define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ #define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -103,6 +103,7 @@ char *EventDesc[] = { [EVENT_HEAP_PROF_BEGIN] = "Start of heap profile", [EVENT_HEAP_PROF_COST_CENTRE] = "Cost center definition", [EVENT_HEAP_PROF_SAMPLE_BEGIN] = "Start of heap profile sample", + [EVENT_HEAP_PROF_SAMPLE_END] = "End of heap profile sample", [EVENT_HEAP_PROF_SAMPLE_STRING] = "Heap profile string sample", [EVENT_HEAP_PROF_SAMPLE_COST_CENTRE] = "Heap profile cost-centre sample", [EVENT_USER_BINARY_MSG] = "User binary message" @@ -430,6 +431,10 @@ postHeaderEvents(void) eventTypes[t].size = 8; break; + case EVENT_HEAP_PROF_SAMPLE_END: + eventTypes[t].size = 8; + break; + case EVENT_HEAP_PROF_SAMPLE_STRING: eventTypes[t].size = EVENT_SIZE_DYNAMIC; break; @@ -1210,6 +1215,15 @@ void postHeapProfSampleBegin(StgInt era) RELEASE_LOCK(&eventBufMutex); } +void postHeapProfSampleEnd(StgInt era) +{ + ACQUIRE_LOCK(&eventBufMutex); + ensureRoomForEvent(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postWord64(&eventBuf, era); + RELEASE_LOCK(&eventBufMutex); +} + void postHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord64 residency) ===================================== rts/eventlog/EventLog.h ===================================== @@ -140,6 +140,7 @@ void postTaskDeleteEvent (EventTaskId taskId); void postHeapProfBegin(StgWord8 profile_id); void postHeapProfSampleBegin(StgInt era); +void postHeapProfSampleEnd(StgInt era); void postHeapProfSampleString(StgWord8 profile_id, const char *label, ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -106,7 +106,7 @@ test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']), when(config.have_ext_interp, extra_ways(['ghci-ext']))], ghci_script, ['ghci062.script']) test('ghci063', normal, ghci_script, ['ghci063.script']) - +test('ghci064', normal, ghci_script, ['ghci064.script']) test('T2452', [extra_hc_opts("-fno-implicit-import-qualified")], ghci_script, ['T2452.script']) test('T2766', normal, ghci_script, ['T2766.script']) ===================================== testsuite/tests/ghci/scripts/ghci064.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances, TypeFamilies #-} +import Data.Kind (Type) + +class MyShow a where + myshow :: a -> String + +instance MyShow a => MyShow [a] where + myshow xs = concatMap myshow xs + +data T = MkT + +instance MyShow T where + myshow x = "Used generic instance" + +instance MyShow [T] where + myshow xs = "Used more specific instance" + + +type family F a :: Type +type instance F [a] = a -> F a +type instance F Int = Bool ===================================== testsuite/tests/ghci/scripts/ghci064.script ===================================== @@ -0,0 +1,21 @@ +-- Test :instances +:instances Maybe + +:set -XPartialTypeSignatures -fno-warn-partial-type-signatures +-- Test queries with holes +:instances Maybe _ + +:load ghci064 + +-- Test that overlapping instances are all reported in the results +:instances [_] +:instances [T] + +-- Test that we can find instances for type families + +:instances F Int + +-- Test to make sure that the constraints of returned instances are all properly verified +-- We don't want the command to return an Applicative or Monad instance for tuple because +-- there is no Int Monoid instance. +:instances (,) Int ===================================== testsuite/tests/ghci/scripts/ghci064.stdout ===================================== @@ -0,0 +1,35 @@ +instance GHC.Base.Alternative Maybe -- Defined in ‘GHC.Base’ +instance Applicative Maybe -- Defined in ‘GHC.Base’ +instance Functor Maybe -- Defined in ‘GHC.Base’ +instance Monad Maybe -- Defined in ‘GHC.Base’ +instance GHC.Base.MonadPlus Maybe -- Defined in ‘GHC.Base’ +instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ +instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ +instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ +instance Semigroup _ => Semigroup (Maybe _) + -- Defined in ‘GHC.Base’ +instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ +instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ +instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’ +instance Monoid [_] -- Defined in ‘GHC.Base’ +instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’ +instance Semigroup [_] -- Defined in ‘GHC.Base’ +instance Show _ => Show [_] -- Defined in ‘GHC.Show’ +instance Read _ => Read [_] -- Defined in ‘GHC.Read’ +instance [safe] MyShow _ => MyShow [_] + -- Defined at ghci064.hs:7:10 +instance Monoid [T] -- Defined in ‘GHC.Base’ +instance Semigroup [T] -- Defined in ‘GHC.Base’ +instance [safe] MyShow [T] -- Defined at ghci064.hs:7:10 +instance [safe] MyShow [T] -- Defined at ghci064.hs:15:10 +instance Eq Bool -- Defined in ‘GHC.Classes’ +instance Ord Bool -- Defined in ‘GHC.Classes’ +instance Show Bool -- Defined in ‘GHC.Show’ +instance Read Bool -- Defined in ‘GHC.Read’ +instance Enum Bool -- Defined in ‘GHC.Enum’ +instance Bounded Bool -- Defined in ‘GHC.Enum’ +instance Data.Bits.Bits Bool -- Defined in ‘Data.Bits’ +instance Data.Bits.FiniteBits Bool -- Defined in ‘Data.Bits’ +instance GHC.Arr.Ix Bool -- Defined in ‘GHC.Arr’ +instance Functor ((,) Int) -- Defined in ‘GHC.Base’ +instance Foldable ((,) Int) -- Defined in ‘Data.Foldable’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f7e4e4e0e2c2ac650bf8f4f31eac4d2b7c0fd23e...e0cef1b84ad55ec13e8920a8ae7b93f0b574f40b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f7e4e4e0e2c2ac650bf8f4f31eac4d2b7c0fd23e...e0cef1b84ad55ec13e8920a8ae7b93f0b574f40b You're receiving 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 Jun 4 20:06:41 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Tue, 04 Jun 2019 16:06:41 -0400 Subject: [Git][ghc/ghc][wip/D5373] Update tests Message-ID: <5cf6cf5184898_1c953faa1a3c00b0161301@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: adb25334 by Matthías Páll Gissurarson at 2019-06-04T20:06:26Z Update tests - - - - - 2 changed files: - testsuite/tests/printer/T14343.stderr - testsuite/tests/printer/T14343b.stderr Changes: ===================================== testsuite/tests/printer/T14343.stderr ===================================== @@ -8,7 +8,7 @@ T14343.hs:10:9: error: Valid hole fits include test1 :: Proxy '[ 'True] (defined at T14343.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[Bool] @'[ 'True] + with Proxy @'[ 'True] (defined at T14343.hs:8:16) T14343.hs:11:9: error: @@ -20,7 +20,7 @@ T14343.hs:11:9: error: Valid hole fits include test2 :: Proxy '[ '[1]] (defined at T14343.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[[GHC.Types.Nat]] @'[ '[1]] + with Proxy @'[ '[1]] (defined at T14343.hs:8:16) T14343.hs:12:9: error: @@ -32,5 +32,5 @@ T14343.hs:12:9: error: Valid hole fits include test3 :: Proxy '[ '("Symbol", 1)] (defined at T14343.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @[(GHC.Types.Symbol, GHC.Types.Nat)] @'[ '("Symbol", 1)] + with Proxy @'[ '("Symbol", 1)] (defined at T14343.hs:8:16) ===================================== testsuite/tests/printer/T14343b.stderr ===================================== @@ -8,7 +8,7 @@ T14343b.hs:10:9: error: Valid hole fits include test1 :: Proxy '( 'True, 'False) (defined at T14343b.hs:10:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @(Bool, Bool) @'( 'True, 'False) + with Proxy @'( 'True, 'False) (defined at T14343b.hs:8:16) T14343b.hs:11:9: error: @@ -23,7 +23,7 @@ T14343b.hs:11:9: error: test2 :: Proxy '( '( 'True, 'False), 'False) (defined at T14343b.hs:11:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @((Bool, Bool), Bool) @'( '( 'True, 'False), 'False) + with Proxy @'( '( 'True, 'False), 'False) (defined at T14343b.hs:8:16) T14343b.hs:12:9: error: @@ -35,5 +35,5 @@ T14343b.hs:12:9: error: Valid hole fits include test3 :: Proxy '( '[1], 'False) (defined at T14343b.hs:12:1) Proxy :: forall k1 (k2 :: k1). Proxy k2 - with Proxy @([GHC.Types.Nat], Bool) @'( '[1], 'False) + with Proxy @'( '[1], 'False) (defined at T14343b.hs:8:16) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/adb2533433756ae46462e2f5a8fb20d0951e8f96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/adb2533433756ae46462e2f5a8fb20d0951e8f96 You're receiving 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 Jun 4 22:07:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 18:07:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-8.8-merges Message-ID: <5cf6ebab7da9b_1c953faa1077e77416274d9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ghc-8.8-merges You're receiving 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 Jun 4 22:19:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 18:19:21 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] Add missing import Message-ID: <5cf6ee6949b53_1c959cc57a01628625@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: a598e25b by Ben Gamari at 2019-06-04T22:18:44Z Add missing import Missing from f8d24178f30b7837b35a9ea328bc6f520092ff08. - - - - - 1 changed file: - compiler/main/GhcMake.hs Changes: ===================================== compiler/main/GhcMake.hs ===================================== @@ -68,6 +68,7 @@ import UniqSet import Util import NameEnv import FileCleanup +import qualified GHC.LanguageExtensions as LangExt import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a598e25b337f91a2bc1ce532ef406b275c3bd31e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a598e25b337f91a2bc1ce532ef406b275c3bd31e You're receiving 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 Jun 4 22:22:29 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 04 Jun 2019 18:22:29 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-refuts] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cf6ef25ac81b_1c953faa1a3c00b0162883c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-refuts at Glasgow Haskell Compiler / GHC Commits: b8dd2718 by Sebastian Graf at 2019-06-04T22:19:16Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 15 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - + testsuite/tests/pmcheck/should_compile/T12949.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmVarCt +mkPosEq x l = TVC x (PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,22 +2403,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr --- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +162,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +170,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +236,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +259,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), TmVarCtEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -45,202 +52,261 @@ import NameEnv %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr + +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [3]@, then trying to solve a 'TmVarCt' +-- like @x ~ 3@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !TmVarCtEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprLit', 'PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [4,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | Flatten the triangular subsitution. +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + nalts = fromMaybe [] (lookupDNameEnv neg x) + neg' = alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a 'PmExprCon' or 'PmExprLit' +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _is_whnf e ) + isRefutable x e neg + = Nothing + | otherwise + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) + where + _is_whnf PmExprCon{} = True + _is_whnf PmExprLit{} = True + _is_whnf _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +314,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | elem x set = set + | otherwise = x:set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/T12949.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T12949 where + +class Foo a where + foo :: Maybe a + +data Result a b = Neither | This a | That b | Both a b + +q :: forall a b . (Foo a, Foo b) => Result a b +q = case foo :: Maybe a of + Nothing -> case foo :: Maybe b of + Nothing -> Neither + Just c -> That c + Just i -> case foo :: Maybe b of + Nothing -> This i + Just c -> Both i c ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -94,8 +94,13 @@ test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T12949', [], compile, ['-fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) test('T12957a', [], compile, ['-fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # EmptyCase test('T10746', [], compile, ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b8dd271855dde17a19553412e9e817195c2b5362 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b8dd271855dde17a19553412e9e817195c2b5362 You're receiving 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 Jun 4 22:59:49 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 18:59:49 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] 4 commits: Bump Haddock submodule to 2.23 release Message-ID: <5cf6f7e5abc8c_1c953faa33407d84163781e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 4542f25d by Alec Theriault at 2019-06-04T03:42:39Z Bump Haddock submodule to 2.23 release This commit of Haddock is (hopefully) going to be the one corresponding to a Hackage release of Haddock 2.23. - - - - - 15752087 by Ben Gamari at 2019-06-04T22:54:55Z Merge branch '8.8-haddock-release' of gitlab.haskell.org:harpocrates/ghc into wip/ghc-8.8-merges - - - - - 686bd33a by Ben Gamari at 2019-06-04T22:59:24Z Fix ghc-in-ghci - - - - - fe03067a by Ben Gamari at 2019-06-04T22:59:31Z Haddock for hiefile-header - - - - - 2 changed files: - compiler/main/GhcMake.hs - utils/haddock Changes: ===================================== compiler/main/GhcMake.hs ===================================== @@ -2063,8 +2063,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- and .o file locations to be temporary files. -- See Note [-fno-code mode] enableCodeGenForTH :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForTH = enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession where @@ -2083,8 +2083,8 @@ enableCodeGenForTH = -- This is used used in order to load code that uses unboxed tuples -- into GHCi while still allowing some code to be interpreted. enableCodeGenForUnboxedTuples :: HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForUnboxedTuples = enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule where @@ -2106,8 +2106,8 @@ enableCodeGenWhen -> TempFileLifetime -> TempFileLifetime -> HscTarget - -> NodeMap [Either ErrMsg ModSummary] - -> IO (NodeMap [Either ErrMsg ModSummary]) + -> NodeMap [Either ErrorMessages ModSummary] + -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 1126fe196fd0d5a2ad73e965982d6c75a2df0279 +Subproject commit 91c65619149f4866abcce33a56036e2e2454629f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a598e25b337f91a2bc1ce532ef406b275c3bd31e...fe03067a6201262c262617471e02394dc8b1d2d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a598e25b337f91a2bc1ce532ef406b275c3bd31e...fe03067a6201262c262617471e02394dc8b1d2d9 You're receiving 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 Jun 5 00:38:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 20:38:14 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] 3 commits: Bump terminfo to 0.4.1.4 Message-ID: <5cf70ef6280b5_1c953faa33407d841658392@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 1134488b by Ben Gamari at 2019-06-05T00:31:38Z Bump terminfo to 0.4.1.4 - - - - - fdb07571 by Ben Gamari at 2019-06-05T00:34:27Z Bump time submodule to 1.9.3 - - - - - 7a928200 by Ben Gamari at 2019-06-05T00:37:31Z Bump Cabal submodule - - - - - 3 changed files: - libraries/Cabal - libraries/terminfo - libraries/time Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 27fc0fe9608ba502ef62647629a6d4ebe01fa33d +Subproject commit 15675844bb36929448c189d6b4aabf7e853b3ee1 ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 7049b2625a490feda9bcb201a5a811d790f06cd0 +Subproject commit 6065302a4f75649f14397833766e82c8182935bf ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit 9e96c26132fef01a3113c8b152b1be96c0eccd86 +Subproject commit 5319bed3b14c21de5410ead88ec8aaa838d7339c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fe03067a6201262c262617471e02394dc8b1d2d9...7a92820031adfc4f88b4d9dcbac09375d40ef731 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fe03067a6201262c262617471e02394dc8b1d2d9...7a92820031adfc4f88b4d9dcbac09375d40ef731 You're receiving 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 Jun 5 01:23:04 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 21:23:04 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] Bump Cabal submodule Message-ID: <5cf71978e43d3_1c95cd69f8c166113a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: d30851f2 by Ben Gamari at 2019-06-05T01:20:38Z Bump Cabal submodule - - - - - 2 changed files: - libraries/Cabal - utils/ghc-cabal/Main.hs Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 27fc0fe9608ba502ef62647629a6d4ebe01fa33d +Subproject commit 15675844bb36929448c189d6b4aabf7e853b3ee1 ===================================== utils/ghc-cabal/Main.hs ===================================== @@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register +import qualified Distribution.Compat.Graph as Graph import Distribution.Text import Distribution.Types.MungedPackageId +import Distribution.Types.LocalBuildInfo import Distribution.Verbosity import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex @@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } +externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (componentGraph lbi) + , (ipkgid, pkgid) <- componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) + generate :: FilePath -> FilePath -> [String] -> IO () generate directory distdir config_args = withCurrentDirectory directory @@ -274,8 +288,8 @@ generate directory distdir config_args -- cabal 2.2+ will expect it, but fallback to the old default -- location if we don't find any. This is the case of the -- bindist, which doesn't ship the $dist/build folder. - maybe_infoFile <- findHookedPackageDesc (cwd distdir "build") - <|> defaultHookedPackageDesc + maybe_infoFile <- findHookedPackageDesc verbosity (cwd distdir "build") + <|> fmap Just (defaultPackageDesc verbosity) case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -307,8 +321,9 @@ generate directory distdir config_args let comp = compiler lbi - libBiModules lib = (libBuildInfo lib, libModules lib) + libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName)) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) + biModuless :: [(BuildInfo, [ModuleName.ModuleName])] biModuless = (map libBiModules . maybeToList $ library pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d30851f2e600e6cda19e299ef383b32a62c6a37a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d30851f2e600e6cda19e299ef383b32a62c6a37a You're receiving 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 Jun 5 02:00:12 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 22:00:12 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] Bump Cabal submodule Message-ID: <5cf7222c694dc_1c95e07be181663298@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: c2ce5474 by Ben Gamari at 2019-06-05T01:59:58Z Bump Cabal submodule - - - - - 6 changed files: - libraries/Cabal - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/Main.hs - utils/ghc-cabal/ghc-cabal.cabal - utils/ghctags/ghctags.cabal Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 27fc0fe9608ba502ef62647629a6d4ebe01fa33d +Subproject commit 15675844bb36929448c189d6b4aabf7e853b3ee1 ===================================== utils/check-api-annotations/check-api-annotations.cabal ===================================== @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, ghc ===================================== utils/check-ppr/check-ppr.cabal ===================================== @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, filepath, ghc ===================================== utils/ghc-cabal/Main.hs ===================================== @@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register +import qualified Distribution.Compat.Graph as Graph import Distribution.Text import Distribution.Types.MungedPackageId +import Distribution.Types.LocalBuildInfo import Distribution.Verbosity import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex @@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } +externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (componentGraph lbi) + , (ipkgid, pkgid) <- componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) + generate :: FilePath -> FilePath -> [String] -> IO () generate directory distdir config_args = withCurrentDirectory directory @@ -274,8 +288,8 @@ generate directory distdir config_args -- cabal 2.2+ will expect it, but fallback to the old default -- location if we don't find any. This is the case of the -- bindist, which doesn't ship the $dist/build folder. - maybe_infoFile <- findHookedPackageDesc (cwd distdir "build") - <|> defaultHookedPackageDesc + maybe_infoFile <- findHookedPackageDesc verbosity (cwd distdir "build") + <|> fmap Just (defaultPackageDesc verbosity) case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -307,8 +321,9 @@ generate directory distdir config_args let comp = compiler lbi - libBiModules lib = (libBuildInfo lib, libModules lib) + libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName)) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) + biModuless :: [(BuildInfo, [ModuleName.ModuleName])] biModuless = (map libBiModules . maybeToList $ library pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 ===================================== utils/ghctags/ghctags.cabal ===================================== @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && <2.6, + Cabal >= 3.0 && <3.1, ghc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c2ce5474bbe3475732fbbfc17a1375d1152928da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c2ce5474bbe3475732fbbfc17a1375d1152928da You're receiving 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 Jun 5 03:28:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 04 Jun 2019 23:28:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16750 Message-ID: <5cf736c25e4e1_6f7ec883f0544f3@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16750 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16750 You're receiving 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 Jun 5 08:05:16 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 05 Jun 2019 04:05:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16728 Message-ID: <5cf777bc9c47e_6f7ec81dc0740a2@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T16728 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16728 You're receiving 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 Jun 5 08:28:23 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 05 Jun 2019 04:28:23 -0400 Subject: [Git][ghc/ghc][wip/T16728] 260 commits: testsuite: Add testcase for #16111 Message-ID: <5cf77d274fdd2_6f7ec8823881610@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 5e9354d4 by Simon Peyton Jones at 2019-06-05T08:27:22Z Fix two places that failed the substitution invariant The substition invariant relies on keeping the in-scope set in sync, and we weren't always doing so, which means that a DEBUG compiler crashes sometimes with an assertion failure This patch fixes a couple more cases. Still not validate clean (with -DEEBUG) but closer! - - - - - 1b7e42a0 by Simon Peyton Jones at 2019-06-05T08:28:04Z Fix typechecking of partial type signatures Partial type sigs had grown hair. tcHsParialSigType was doing lots of unnecessary work, and tcInstSig was cloning it unnecessarily -- and the result didn't even work: #16728. This patch cleans it all up, described by TcHsType Note [Checking parital type signatures] I basically just deleted code... but very carefully! Some refactoring along the way * Distinguish more explicintly between "anonymous" wildcards "_" and "named" wildcards "_a". I changed the names of a number of functions to make this distinction much more apparent. - - - - - 30 changed files: - .circleci/prepare-system.sh - .ghcid - .gitignore - .gitlab-ci.yml - + .gitlab/linters/check-version-number.sh - .gitlab/win32-init.sh - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmCallConv.hs - compiler/cmm/CmmExpr.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmMonad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ac94e160c6087f67612aca284423b11503a123e2...1b7e42a05b6afb4486c6453b79ccc5bc7c8f7b53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ac94e160c6087f67612aca284423b11503a123e2...1b7e42a05b6afb4486c6453b79ccc5bc7c8f7b53 You're receiving 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 Jun 5 10:14:36 2019 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 05 Jun 2019 06:14:36 -0400 Subject: [Git][ghc/ghc][wip/top-level-kind-signatures] T16731 test case (broken) Message-ID: <5cf7960c1a870_6f7ec81e9c9693@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/top-level-kind-signatures at Glasgow Haskell Compiler / GHC Commits: 9096c4fb by Vladislav Zavialov at 2019-06-02T21:17:12Z T16731 test case (broken) - - - - - 2 changed files: - + testsuite/tests/tlks/should_compile/T16731.hs - testsuite/tests/tlks/should_compile/all.T Changes: ===================================== testsuite/tests/tlks/should_compile/T16731.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TopLevelKindSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module T16731 where + +import Data.Kind + +class C (a :: Type) (b :: Type) + +type T :: forall a. a -> Type +data T (x :: z) deriving (C z) ===================================== testsuite/tests/tlks/should_compile/all.T ===================================== @@ -33,3 +33,4 @@ test('tlks030', normal, compile, ['']) test('T16723', normal, compile, ['']) test('T16724', extra_files(['T16724.hs']), ghci_script, ['T16724.script']) test('T16726', normal, compile, ['']) +test('T16731', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9096c4fbd640a967d4e579072afa4fdb0c2f3381 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9096c4fbd640a967d4e579072afa4fdb0c2f3381 You're receiving 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 Jun 5 11:05:10 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 05 Jun 2019 07:05:10 -0400 Subject: [Git][ghc/ghc][wip/T16738] 8 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cf7a1e649118_6f7ec9d318126410@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 4e8133fd by Ben Gamari at 2019-06-05T11:05:05Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/ghci/Linker.hs - compiler/main/DynFlags.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - includes/ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0c03112fde37e2354161390a946155b7c2a462d...4e8133fd75077dbd80f53cb7a9c881bee42399cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0c03112fde37e2354161390a946155b7c2a462d...4e8133fd75077dbd80f53cb7a9c881bee42399cf You're receiving 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 Jun 5 12:07:05 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 05 Jun 2019 08:07:05 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cf7b0695e959_6f761046d0141777@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 3b3d5716 by Ben Gamari at 2019-06-05T12:06:56Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. This caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, exprIsHNF, exprType, stripTicksTopE, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,24 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTopE tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , c1 `cheapEqExpr` c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` c1 + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b3d5716870d023e3df46e59e3f080ee1e035906 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b3d5716870d023e3df46e59e3f080ee1e035906 You're receiving 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 Jun 5 12:39:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 05 Jun 2019 08:39:33 -0400 Subject: [Git][ghc/ghc][wip/fix-distrib-configure] 128 commits: Implement ImportQualifiedPost Message-ID: <5cf7b805236a6_6f7ec81e9c1424ed@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-distrib-configure at Glasgow Haskell Compiler / GHC Commits: ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghc.mk - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a85a1f7b347bbd2863f4d2908c67213183a3c887...ba4e3934abc82e0ba2bec51842315819910d1018 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/a85a1f7b347bbd2863f4d2908c67213183a3c887...ba4e3934abc82e0ba2bec51842315819910d1018 You're receiving 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 Jun 5 12:44:05 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 05 Jun 2019 08:44:05 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cf7b915c1042_6f7e95041c1499f0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: d199fd3a by Ben Gamari at 2019-06-05T12:43:22Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. This caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, exprIsHNF, exprType, stripTicksTop, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,24 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , c1 `cheapEqExpr` c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` c1 + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d199fd3a44a75d89c2642eafc98598fc261a30a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d199fd3a44a75d89c2642eafc98598fc261a30a8 You're receiving 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 Jun 5 17:34:44 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 05 Jun 2019 13:34:44 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cf7fd346ee52_6f73fe6128d302821021c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: aa0c7c96 by Sebastian Graf at 2019-06-05T17:33:48Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 20 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,72 +92,33 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + -- | Literal values the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. PmNLit :: { pm_lit_id :: Id , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | Top-level 'ConLike's the wrapped 'Id' cannot take on. + -- See Note [PmNLit and PmNCon]. + PmNCon :: { pm_con_id :: Id + , pm_con_grps :: [[ConLike]] + , pm_con_not :: [ConLike] } -> PmPat 'VA PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -200,8 +161,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +178,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +189,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +226,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +257,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +274,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +283,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +316,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +338,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +395,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +446,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +509,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +558,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +584,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +601,62 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +-- +-- This is quite costly due to the many oracle queries, so we only call this +-- on the final uncovered set. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + pm at PmCon{ pm_con_args = args } -> do + args' <- traverse (valabs_inhabited p delta) args + pure pm { pm_con_args = args' } + PmVar x + | let (ty, ncons) = lookupRefutableAltCons x (delta_tm_cs delta) + , con_likes@(cl:_) <- [ cl | PmAltConLike cl <- ncons ] + -> do + grps <- lift (allCompleteMatches cl ty) + var_inh p delta x con_likes grps + PmNCon x grps ncons -> var_inh p delta x ncons grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . (ncons \\) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- `PmCon` for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmNCon x grps ncons) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +813,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -857,7 +837,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +847,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -933,7 +913,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -968,7 +948,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1049,9 +1029,10 @@ translatePat fam_insts pat = case pat of , pat_tvs = ex_tvs , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con @@ -1185,12 +1166,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1227,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1247,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1276,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1284,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1297,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1409,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1447,6 +1436,7 @@ families is not really efficient. pmPatType :: PmPat p -> Type pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys +pmPatType (PmNCon { pm_con_id = x }) = idType x pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l pmPatType (PmNLit { pm_lit_id = x }) = idType x @@ -1464,7 +1454,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1467,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1593,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1644,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1661,47 +1689,50 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1741,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,9 +1752,10 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) +vaToPmExpr (PmNCon { pm_con_id = x }) = PmExprVar (idName x) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) -- | Convert a pattern vector to a list of value abstractions by dropping the @@ -1749,9 +1781,9 @@ coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1818,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1920,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,7 +2002,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1986,7 +2014,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,7 +2022,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2024,10 +2052,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2069,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2083,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,57 +2106,64 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec _ delta) = do + let con = pm_con_con p + groups <- allCompleteMatches con (conLikeResTy con (pm_con_arg_tys p)) + force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> + pmcheckHd p ps guards (PmNCon x groups []) vva + +-- ConNCon +pmcheckHd p at PmCon{} ps guards va at PmNCon{} (ValVec vva delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + let x = pm_con_id va + let grps = pm_con_grps va + let ncons = pm_con_not va + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + pr_con <- fmap (fromMaybe mempty) $ runMaybeT $ do + guard (con `notElem` ncons) + delta' <- MaybeT $ pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + lift $ tracePm "success" (ppr (delta_tm_cs delta)) + lift $ pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vva delta') + + let ncons' = con : ncons + let us_incomplete + | let nalt = PmAltConLike con + , Just tm_state <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmNCon x grps ncons' : vva) (delta { delta_tm_cs = tm_state })] + | otherwise = [] + tracePm "ConNCon" (vcat [ppr p, ppr x, ppr ncons', ppr pr_con, ppr us_incomplete, ppr us_incomplete]) + + -- Combine both into a single PartialResult + let pr_combined = mkUnion pr_con (usimple us_incomplete) + pure pr_combined -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) +pmcheckHd p at PmLit{} ps guards (PmVar x) vva@(ValVec _ delta) = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] - - non_matched = usimple us + pmcheckHd p ps guards (PmNLit x []) vva -- LitNLit pmcheckHd (p@(PmLit l)) ps guards (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) + | not (elem l lits) + , Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) -- Both guards check the same so it would be sufficient to have only -- the second one. Nevertheless, it is much cheaper to check whether -- the literal is in the list so we check it first, to avoid calling @@ -2138,7 +2174,7 @@ pmcheckHd (p@(PmLit l)) ps guards | otherwise = return non_matched where -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) + us | Just tm_state <- tryAddRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2153,7 +2189,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,11 +2200,11 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') @@ -2176,6 +2212,10 @@ pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva = pmcheckHdI p ps guards (PmVar x) vva +-- LitNCon +pmcheckHd (p@(PmLit {})) ps guards (PmNCon { pm_con_id = x }) vva + = pmcheckHdI p ps guards (PmVar x) vva + -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2359,9 +2399,6 @@ force_if :: Bool -> PartialResult -> PartialResult force_if True pres = forces pres force_if False pres = pres -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } - -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2406,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2440,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2486,15 +2523,15 @@ instance Outputable ValVec where -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2548,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2559,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2637,11 +2671,7 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2651,6 +2681,8 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] +pprPmPatDebug (PmNCon x _ sets) + = hsep [text "PmNCon", ppr x, ppr sets] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -53,34 +54,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args + +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +144,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +188,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +245,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells. +pmExprAsList :: PmExpr -> Maybe [PmExpr] +pmExprAsList (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just [] + | c == consDataCon + = ASSERT( length es == 2 ) (es !! 0 :) <$> pmExprAsList (es !! 1) +pmExprAsList _ + = Nothing {- %************************************************************************ @@ -260,18 +274,18 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l go _ (PmExprVar v) = ppr v go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (pmExprAsList -> Just list) + = brackets $ fsep $ punctuate comma $ map ppr list + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,33 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just list <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = brackets . fsep . punctuate comma <$> mapM pprPmExpr list +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +174,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,19 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons :: Id -> TmState -> (Type, [PmAltCon]) lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) + = fromMaybe (idType x, []) (lookupDNameEnv neg (idName x)) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -205,12 +214,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +229,49 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a 'PmExprCon'. +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( _is_con e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + _is_con PmExprCon{} = True + _is_con _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +290,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +298,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +352,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa0c7c96d9d08d4936fc54b589e99bdcd5ad7460 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa0c7c96d9d08d4936fc54b589e99bdcd5ad7460 You're receiving 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 Jun 5 17:34:46 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Wed, 05 Jun 2019 13:34:46 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add plugin configuration flag to hole-fit-plugin test Message-ID: <5cf7fd3654598_6f7ec9d31821047e@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 0ade0771 by Matthías Páll Gissurarson at 2019-06-05T17:34:33Z Add plugin configuration flag to hole-fit-plugin test - - - - - 1 changed file: - testsuite/tests/plugins/all.T Changes: ===================================== testsuite/tests/plugins/all.T ===================================== @@ -210,6 +210,6 @@ test('T16260', test('test-hole-plugin', [extra_files(['hole-fit-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C hole-fit-plugin package.hole-fit-plugin TOP={top}'), - extra_hc_opts("-package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf ") + extra_hc_opts('-package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf '+ config.plugin_way_flags) ], compile, ['-fdefer-typed-holes']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0ade0771b25fadb933490650bd120c8545acbc34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0ade0771b25fadb933490650bd120c8545acbc34 You're receiving 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 Jun 6 10:50:06 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 06 Jun 2019 06:50:06 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cf8efde7ff05_6f73fe619923648356478@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 92ef9588 by Sebastian Graf at 2019-06-06T10:49:38Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 20 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,72 +92,23 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a - -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk +type PmM = DsM --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -200,8 +151,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +168,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +179,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +216,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +247,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +264,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +273,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +306,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +328,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +385,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +436,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +499,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +548,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +574,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +591,61 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmNCon's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +-- +-- This is quite costly due to the many oracle queries, so we only call this +-- on the final uncovered set. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + pm at PmCon{ pm_con_args = args } -> do + args' <- traverse (valabs_inhabited p delta) args + pure pm { pm_con_args = args' } + PmVar x + | let (ty, ncons) = lookupRefutableAltCons x (delta_tm_cs delta) + , con_likes@(cl:_) <- [ cl | PmAltConLike cl <- ncons ] + -> do + grps <- lift (allCompleteMatches cl ty) + var_inh p delta x con_likes grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . (ncons \\) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- `PmCon` for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmVar x) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +802,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +816,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +826,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +836,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +894,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +902,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +911,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +936,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1015,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1152,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1213,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1233,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1262,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1270,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1283,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1395,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1424,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1464,7 +1438,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1451,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1577,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1628,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,52 +1668,54 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1724,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1735,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1751,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1797,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1899,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,7 +1981,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1986,7 +1993,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,7 +2001,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2024,10 +2031,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2048,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2062,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,72 +2085,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2141,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2152,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2307,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2317,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2336,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2357,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2391,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2486,15 +2474,15 @@ instance Outputable ValVec where -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2499,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2510,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2637,11 +2622,7 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2649,11 +2630,10 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) +pprPmPatDebug (PmCon cc _arg_tys _con_tvs con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) <+> ppr ge pprPmPatDebug PmFake = text "PmFake" ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -53,34 +54,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args + +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +144,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +188,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +245,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells. +pmExprAsList :: PmExpr -> Maybe [PmExpr] +pmExprAsList (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just [] + | c == consDataCon + = ASSERT( length es == 2 ) (es !! 0 :) <$> pmExprAsList (es !! 1) +pmExprAsList _ + = Nothing {- %************************************************************************ @@ -260,18 +274,18 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l go _ (PmExprVar v) = ppr v go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (pmExprAsList -> Just list) + = brackets $ fsep $ punctuate comma $ map ppr list + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,33 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just list <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = brackets . fsep . punctuate comma <$> mapM pprPmExpr list +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +174,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,19 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons :: Id -> TmState -> (Type, [PmAltCon]) lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) + = fromMaybe (idType x, []) (lookupDNameEnv neg (idName x)) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -205,12 +214,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +229,49 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a 'PmExprCon'. +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( _is_con e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + _is_con PmExprCon{} = True + _is_con _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +290,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +298,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +352,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/92ef9588cdf691ca13055e3940cdb1217cdcd81b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/92ef9588cdf691ca13055e3940cdb1217cdcd81b You're receiving 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 Jun 6 13:03:34 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 06 Jun 2019 09:03:34 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cf90f2659aab_6f7e95041c375174@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 236c0cfb by Sebastian Graf at 2019-06-06T13:03:03Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 20 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,72 +92,23 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a - -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk +type PmM = DsM --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t PmGrd :: { pm_grd_pv :: PatVec , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. @@ -200,8 +151,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +168,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +179,26 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa + ppr (PartialResult c vsa d) + = text "PartialResult" <+> ppr c <+> ppr d <+> ppr vsa instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +216,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +247,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +264,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +273,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +306,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +328,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +385,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +436,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +499,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +548,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +574,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +591,61 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | This weeds out patterns with 'PmVar's where at least one COMPLETE set is +-- rendered vacuous by equality constraints. +-- +-- This is quite costly due to the many oracle queries, so we only call this +-- on the final uncovered set. +normaliseUncovered :: Uncovered -> PmM Uncovered +normaliseUncovered us = do + let valvec_inhabited p (ValVec vva delta) = runMaybeT $ do + vva' <- traverse (valabs_inhabited p delta) vva + pure (ValVec vva' delta) + valabs_inhabited p delta v = case v :: ValAbs of + pm at PmCon{ pm_con_args = args } -> do + args' <- traverse (valabs_inhabited p delta) args + pure pm { pm_con_args = args' } + PmVar x + | let (ty, ncons) = lookupRefutableAltCons x (delta_tm_cs delta) + , cls@(cl:_) <- [ cl | PmAltConLike cl <- ncons ] + -> do + grps <- lift (allCompleteMatches cl ty) + var_inh p delta x cls grps + _ -> pure v + var_inh p delta x ncons grps = do + let grp_inh = filterM (p delta x) . (\\ ncons) + incomplete_grps <- traverse grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValVec is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- `PmCon` for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a `PmCon` (which won't normalise any + -- further) when @p@ is just the @cheap_inh_test at . Thus, we have to + -- assert satisfiability here, even if @actual_inh_test@ already did + -- so. + ic <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (ic_val_abs ic) + _ -> pure (PmVar x) + + -- We'll first do a cheap sweep without consulting the oracles + let cheap_inh_test _ _ _ = pure True + us1 <- mapMaybeM (valvec_inhabited cheap_inh_test) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + let actual_inh_test delta x con = do + lift (tracePm "nrm" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta))) + isJust <$> lift (mkOneSatisfiableConFull delta x con) + us2 <- mapMaybeM (valvec_inhabited actual_inh_test) us1 + tracePm "normaliseUncovered" (vcat (map pprValVecDebug us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +802,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +816,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +826,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +836,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +894,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +902,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +911,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +936,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1015,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1152,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1213,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1233,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1262,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1270,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1283,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1395,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1424,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1464,7 +1438,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1451,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1577,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1628,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,52 +1668,54 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe InhabitationCandidate) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + (ic <$) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1724,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1735,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1751,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1797,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1899,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,7 +1981,7 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) $$ pprValVecDebug vva) @@ -1986,7 +1993,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,7 +2001,7 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs + n <- incrCheckPmIterDs tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p $$ pprPatVec ps $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) @@ -2024,10 +2031,12 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pure $ utail pr pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2048,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2062,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,72 +2085,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2141,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2152,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2307,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2317,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2336,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2357,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2391,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2486,15 +2474,15 @@ instance Outputable ValVec where -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2499,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2510,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2637,11 +2622,7 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags @@ -2649,11 +2630,10 @@ tracePmD herald doc = do pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) +pprPmPatDebug (PmCon cc _arg_tys _con_tvs con_args) = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) <+> ppr ge pprPmPatDebug PmFake = text "PmFake" @@ -2671,5 +2651,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) - -- $$ ppr (delta_tm_cs _d) + $$ ppr (delta_tm_cs _d) -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -53,34 +54,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args + +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +144,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +188,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +245,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells. +pmExprAsList :: PmExpr -> Maybe [PmExpr] +pmExprAsList (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just [] + | c == consDataCon + = ASSERT( length es == 2 ) (es !! 0 :) <$> pmExprAsList (es !! 1) +pmExprAsList _ + = Nothing {- %************************************************************************ @@ -260,18 +274,18 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l go _ (PmExprVar v) = ppr v go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (pmExprAsList -> Just list) + = brackets $ fsep $ punctuate comma $ map ppr list + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,33 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just list <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = brackets . fsep . punctuate comma <$> mapM pprPmExpr list +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +174,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -109,7 +117,7 @@ instance Outputable TmState where pos = map pos_eq (nonDetUFMToList (tm_pos state)) neg = map neg_eq (udfmToList (tm_neg state)) pos_eq (l, r) = ppr l <+> char '~' <+> ppr r - neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + neg_eq (l, r) = ppr l <+> text "/~" <+> ppr r -- | Initial state of the oracle. initialTmState :: TmState @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,24 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] -lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) +-- +-- Precondition: The queried Id 'isFlexible'. +lookupRefutableAltCons :: Id -> TmState -> (Type, [PmAltCon]) +lookupRefutableAltCons x _tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( not (isSolution _e) ) + fromMaybe (idType x, []) (lookupDNameEnv neg y) + where + (y, _e) = varDeepLookup pos (idName x) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -193,6 +207,11 @@ isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x isFlexible :: TmState -> Name -> Bool isFlexible tms = isNothing . isRigid tms +-- | Is this a solution for a variable, i.e., something in WHNF? +isSolution :: PmExpr -> Bool +isSolution PmExprCon{} = True +isSolution _ = False + -- | Try to unify two 'PmExpr's and record the gained knowledge in the -- 'TmState'. -- @@ -205,12 +224,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +239,46 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a solution, i.e., 'PmExprCon' (cf. 'isSolution'). +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( isSolution e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) - where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +297,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +305,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +359,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/236c0cfb3ab952dc6af6a71f8fce5bd8f2030d4b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/236c0cfb3ab952dc6af6a71f8fce5bd8f2030d4b You're receiving 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 Jun 6 13:25:03 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 06 Jun 2019 09:25:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ldv-profile Message-ID: <5cf9142fa6982_6f73fe61a67faa837777d@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/ldv-profile at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ldv-profile You're receiving 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 Jun 6 16:23:59 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 06 Jun 2019 12:23:59 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cf93e1f35dd2_6f7e85e950451275@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 1a9998a0 by Sebastian Graf at 2019-06-06T16:23:35Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 22 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - − compiler/utils/ListT.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,79 +92,38 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA - PmGrd :: { pm_grd_pv :: PatVec + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + PmGrd :: { pm_grd_pv :: PatVec -- ^ Always has 'patVecArity' 1. , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. PmFake :: PmPat 'PAT +-- | Should not face a user. instance Outputable (PmPat a) where - ppr = pprPmPatDebug + ppr (PmCon cc _arg_tys _con_tvs con_args) + = hsep [ppr cc, hsep (map ppr con_args)] + -- the @ is to differentiate (flexible) variables from rigid constructors and + -- literals + ppr (PmVar vid) = char '@' <> ppr vid + ppr (PmLit li) = ppr li + ppr (PmGrd pv ge) = hsep (map ppr pv) <+> text "<-" <+> ppr ge + ppr PmFake = text "" -- data T a where -- MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p] @@ -185,6 +144,17 @@ data Delta = MkDelta { delta_ty_cs :: Bag EvVar type ValSetAbs = [ValVec] -- ^ Value Set Abstractions type Uncovered = ValSetAbs +-- | Should not face a user. See 'pprValVecSubstituted' for that. +instance Outputable ValVec where + ppr (ValVec vva delta) = ppr vva <+> text "|>" <+> ppr_delta delta + where + ppr_delta _d = hcat [ + -- intentionally formatted this way enable the dev to comment in only + -- the info she needs + ppr (delta_tm_cs delta), + ppr (delta_ty_cs delta) + ] + -- Instead of keeping the whole sets in memory, we keep a boolean for both the -- covered and the divergent set (we store the uncovered set though, since we -- want to print it). For both the covered and the divergent we have: @@ -200,8 +170,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +187,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +198,27 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa - + ppr (PartialResult c vsa d) + = hang (text "PartialResult" <+> ppr c <+> ppr d) 2 (ppr_vsa vsa) + where + ppr_vsa = braces . fsep . punctuate comma . map ppr instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +236,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +267,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +284,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +293,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] - tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) + tracePm "checkSingle': missing" (vcat (map ppr missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered normaliseValVec us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +326,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +348,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars - tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + tracePm "checkMatches': missing" (vcat (map ppr missing)) + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered normaliseValVec us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +405,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +456,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +519,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +568,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +594,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +611,98 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | Tests whether the 'Id' can inhabit the given 'ConLike' in the context +-- expressed by the 'Delta'. +type InhabitationTest = Delta -> Id -> ConLike -> PmM Bool + +-- | An 'InhabitationTest' consulting 'mkOneSatisfiableConFull'. Precise, but +-- expensive. +isConSatisfiable :: InhabitationTest +isConSatisfiable delta x con = do + tracePm "conInhabitsId" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> mkOneSatisfiableConFull delta x con + +-- | Cheap 'InhabitationTest', always returning @True at . +cheapInhabitationTest :: InhabitationTest +cheapInhabitationTest _ _ _ = pure True + +normaliseValAbs :: InhabitationTest -> Delta -> ValAbs -> PmM (Maybe (Delta, ValAbs)) +normaliseValAbs is_con_inh delta = runMaybeT . go_va delta + where + go_va :: Delta -> ValAbs -> MaybeT PmM (Delta, ValAbs) + go_va delta pm at PmCon{ pm_con_args = args } = do + (delta', args') <- mapAccumLM go_va delta args + pure (delta', pm { pm_con_args = args' }) + go_va delta va@(PmVar x) + | let (ty, pacs) = lookupRefutableAltCons x (delta_tm_cs delta) + -- TODO: Even if ncons is empty, we might have a complete match ('Void', + -- constraints). Figure out how to the complete matches solely from + -- @ty at . + , ncons@(cl:_) <- [ cl | PmAltConLike cl <- pacs ] = do + grps <- lift (allCompleteMatches cl ty) + let is_grp_inh = filterM (lift . is_con_inh delta x) . (\\ ncons) + incomplete_grps <- traverse is_grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValAbs is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- @PmCon@ for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a @PmCon@ (which won't normalise + -- any further) when @p@ is just the 'cheapInhabitationTest'. + -- Thus, we have to assert satisfiability here, even if the + -- expensive 'isConSatisfiable' already did so. Also, we have to + -- store the constraints in @delta at . + (delta', ic) <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (delta', ic_val_abs ic) + _ -> pure (delta, va) + go_va delta va = pure (delta, va) + +-- | Something that normalises a 'ValVec' by consulting the given +-- 'InhabitationTest' to weed out vacuous 'ValAbs'. +-- See also 'normaliseValVecHead' and 'normaliseValVec'. +type ValVecNormaliser = InhabitationTest -> ValVec -> PmM (Maybe ValVec) + +-- | A 'ValVecNormaliser' that normalises all components of a 'ValVec'. This is +-- the 'ValVecNormaliser' to choose once at the end. +normaliseValVec :: ValVecNormaliser +normaliseValVec test (ValVec vva delta) = runMaybeT $ do + (delta', vva') <- mapAccumLM ((MaybeT .) . normaliseValAbs test) delta vva + pure (ValVec vva' delta') + +-- | A 'ValVecNormaliser' that only tries to normalise the head of each +-- 'ValVec'. This is mandatory for pattern guards, where we call 'utail' on the +-- temporarily extended 'ValVec', hence there's no way to delay this check. +-- Of course we could 'normaliseValVec' instead, but that's unnecessarily +-- expensive. +normaliseValVecHead :: ValVecNormaliser +normaliseValVecHead _ vva@(ValVec [] _) = pure (Just vva) +normaliseValVecHead test (ValVec (va:vva) delta) = runMaybeT $ do + (delta', va') <- MaybeT (normaliseValAbs test delta va) + pure (ValVec (va':vva) delta') + +-- | This weeds out 'ValVec's with 'PmVar's where at least one COMPLETE set is +-- rendered vacuous by equality constraints, by calling out the given +-- 'ValVecNormaliser' with different 'InhabitationTest's. +-- +-- This is quite costly due to the many oracle queries, so we only call this at +-- the last possible moment. I.e., with 'normaliseValVecHead' when leaving a +-- pattern guard and with 'normaliseValVec' on the final uncovered set. +normaliseUncovered :: ValVecNormaliser -> Uncovered -> PmM Uncovered +normaliseUncovered normalise_val_vec us = do + -- We'll first do a cheap sweep without consulting the oracles + us1 <- mapMaybeM (normalise_val_vec cheapInhabitationTest) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + us2 <- mapMaybeM (normalise_val_vec isConSatisfiable) us1 + tracePm "normaliseUncovered" (vcat (map ppr us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +859,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +873,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +883,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +893,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +951,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +959,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +968,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +993,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1072,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1209,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1270,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1290,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1319,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1327,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1340,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1452,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1481,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1464,7 +1495,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1508,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1634,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1685,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,52 +1725,54 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe (Delta, InhabitationCandidate)) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + ((,ic) <$>) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1781,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1792,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1808,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1854,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1956,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,10 +2038,11 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheck" (ppr n <> colon + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr vva) res <- pmcheck ps guards vva tracePm "pmCheckResult:" (ppr res) return res @@ -1986,7 +2051,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,12 +2059,12 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p - $$ pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprPmPatDebug va - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheckHdI" (ppr n <> colon <+> ppr p + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr va + $$ ppr vva) res <- pmcheckHd p ps guards va vva tracePm "pmCheckHdI: res" (ppr res) @@ -2024,10 +2089,15 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + -- The heads of the ValVecs in the uncovered set might be vacuous, so + -- normalise them + us <- normaliseUncovered normaliseValVecHead (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2109,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2123,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,72 +2146,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2202,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2213,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2368,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2378,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2397,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2418,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2452,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2478,23 +2527,23 @@ isAnyPmCheckEnabled :: DynFlags -> DsMatchContext -> Bool isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind -instance Outputable ValVec where - ppr (ValVec vva delta) - = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in pprUncovered (vector, refuts) +pprValVecSubstituted :: ValVec -> SDoc +pprValVecSubstituted (ValVec vva delta) = pprUncovered (vector, refuts) + where + (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2560,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2571,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2536,7 +2582,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" - _missing -> let us = map ppr qs + _missing -> let us = map pprValVecSubstituted qs in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -2637,39 +2683,8 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags Opt_D_dump_ec_trace (text herald $$ (nest 2 doc)) - - -pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) - = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] -pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid -pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl -pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) - <+> ppr ge -pprPmPatDebug PmFake = text "PmFake" - -pprPatVec :: PatVec -> SDoc -pprPatVec ps = hang (text "Pattern:") 2 - (brackets $ sep - $ punctuate (comma <> char '\n') (map pprPmPatDebug ps)) - -pprValAbs :: [ValAbs] -> SDoc -pprValAbs ps = hang (text "ValAbs:") 2 - (brackets $ sep - $ punctuate (comma) (map pprPmPatDebug ps)) - -pprValVecDebug :: ValVec -> SDoc -pprValVecDebug (ValVec vas _d) = text "ValVec" <+> - parens (pprValAbs vas) - -- $$ ppr (delta_tm_cs _d) - -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -53,34 +54,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args + +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +144,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +188,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +245,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells. +pmExprAsList :: PmExpr -> Maybe [PmExpr] +pmExprAsList (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just [] + | c == consDataCon + = ASSERT( length es == 2 ) (es !! 0 :) <$> pmExprAsList (es !! 1) +pmExprAsList _ + = Nothing {- %************************************************************************ @@ -260,18 +274,18 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l go _ (PmExprVar v) = ppr v go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (pmExprAsList -> Just list) + = brackets $ fsep $ punctuate comma $ map ppr list + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hsep (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,33 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just list <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = brackets . fsep . punctuate comma <$> mapM pprPmExpr list +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +174,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -109,7 +117,7 @@ instance Outputable TmState where pos = map pos_eq (nonDetUFMToList (tm_pos state)) neg = map neg_eq (udfmToList (tm_neg state)) pos_eq (l, r) = ppr l <+> char '~' <+> ppr r - neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + neg_eq (l, r) = ppr l <+> text "/~" <+> ppr r -- | Initial state of the oracle. initialTmState :: TmState @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,24 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] -lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) +-- +-- Precondition: The queried Id 'isFlexible'. +lookupRefutableAltCons :: Id -> TmState -> (Type, [PmAltCon]) +lookupRefutableAltCons x _tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( not (isSolution _e) ) + fromMaybe (idType x, []) (lookupDNameEnv neg y) + where + (y, _e) = varDeepLookup pos (idName x) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -193,6 +207,11 @@ isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x isFlexible :: TmState -> Name -> Bool isFlexible tms = isNothing . isRigid tms +-- | Is this a solution for a variable, i.e., something in WHNF? +isSolution :: PmExpr -> Bool +isSolution PmExprCon{} = True +isSolution _ = False + -- | Try to unify two 'PmExpr's and record the gained knowledge in the -- 'TmState'. -- @@ -205,12 +224,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +239,46 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a solution, i.e., 'PmExprCon' (cf. 'isSolution'). +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( isSolution e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) - where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +297,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +305,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +359,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -557,7 +557,6 @@ Library IOEnv Json ListSetOps - ListT Maybes MonadUtils OrdList ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== compiler/utils/ListT.hs deleted ===================================== @@ -1,80 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -------------------------------------------------------------------------- --- | --- Module : Control.Monad.Logic --- Copyright : (c) Dan Doel --- License : BSD3 --- --- Maintainer : dan.doel at gmail.com --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- A backtracking, logic programming monad. --- --- Adapted from the paper --- /Backtracking, Interleaving, and Terminating --- Monad Transformers/, by --- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry --- (). -------------------------------------------------------------------------- - -module ListT ( - ListT(..), - runListT, - select, - fold - ) where - -import GhcPrelude - -import Control.Applicative - -import Control.Monad -import Control.Monad.Fail as MonadFail - -------------------------------------------------------------------------- --- | A monad transformer for performing backtracking computations --- layered over another monad 'm' -newtype ListT m a = - ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r } - -select :: Monad m => [a] -> ListT m a -select xs = foldr (<|>) mzero (map pure xs) - -fold :: ListT m a -> (a -> m r -> m r) -> m r -> m r -fold = runListT - -------------------------------------------------------------------------- --- | Runs a ListT computation with the specified initial success and --- failure continuations. -runListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r -runListT = unListT - -instance Functor (ListT f) where - fmap f lt = ListT $ \sk fk -> unListT lt (sk . f) fk - -instance Applicative (ListT f) where - pure a = ListT $ \sk fk -> sk a fk - f <*> a = ListT $ \sk fk -> unListT f (\g fk' -> unListT a (sk . g) fk') fk - -instance Alternative (ListT f) where - empty = ListT $ \_ fk -> fk - f1 <|> f2 = ListT $ \sk fk -> unListT f1 sk (unListT f2 sk fk) - -instance Monad (ListT m) where - m >>= f = ListT $ \sk fk -> unListT m (\a fk' -> unListT (f a) sk fk') fk -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail (ListT m) where - fail _ = ListT $ \_ fk -> fk - -instance MonadPlus (ListT m) where - mzero = ListT $ \_ fk -> fk - m1 `mplus` m2 = ListT $ \sk fk -> unListT m1 sk (unListT m2 sk fk) ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a9998a0142bc89662528967f40c8180ddafe8bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a9998a0142bc89662528967f40c8180ddafe8bb You're receiving 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 Jun 6 16:26:32 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Thu, 06 Jun 2019 12:26:32 -0400 Subject: [Git][ghc/ghc][wip/D5373] Add TcHoleFitTypes and address issues Message-ID: <5cf93eb8763dd_6f73fe6199236484518af@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 3559a11e by Matthías Páll Gissurarson at 2019-06-06T16:26:13Z Add TcHoleFitTypes and address issues - - - - - 9 changed files: - compiler/ghc.cabal.in - compiler/main/Plugins.hs - compiler/typecheck/TcHoleErrors.hs - + compiler/typecheck/TcHoleFitTypes.hs - + compiler/typecheck/TcHoleFitTypes.hs-boot - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - docs/users_guide/extending_ghc.rst - testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -504,6 +504,7 @@ Library TcRules TcSimplify TcHoleErrors + TcHoleFitTypes TcErrors TcTyClsDecls TcTyDecls ===================================== compiler/main/Plugins.hs ===================================== @@ -30,6 +30,10 @@ module Plugins ( -- - access to loaded interface files with 'interfaceLoadAction' -- , keepRenamedSource + -- ** Hole fit plugins + -- | hole fit plugins allow plugins to change the behavior of valid hole + -- fit suggestions + , HoleFitPluginR -- * Internal , PluginWithArgs(..), plugins, pluginRecompile' @@ -42,8 +46,8 @@ import GhcPrelude import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM ) import qualified TcRnTypes -import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports - , HoleFitPluginR ) +import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports ) +import TcHoleFitTypes ( HoleFitPluginR ) import HsSyn import DynFlags import HscTypes @@ -173,7 +177,7 @@ instance Monoid PluginRecompile where type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin -type HoleFitPlugin = [CommandLineOption] -> Maybe TcRnTypes.HoleFitPluginR +type HoleFitPlugin = [CommandLineOption] -> Maybe HoleFitPluginR purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile purePlugin _args = return NoForceRecompile ===================================== compiler/typecheck/TcHoleErrors.hs ===================================== @@ -8,7 +8,7 @@ module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits , hfIsLcl , pprHoleFit, debugHoleFitDispConfig - -- Re-exported from TcRnTypes + -- Re-exported from TcHoleFitTypes , TypedHole (..), HoleFit (..), HoleFitCandidate (..) , CandPlugin, FitPlugin , HoleFitPlugin (..), HoleFitPluginR (..) @@ -56,6 +56,9 @@ import LoadIface ( loadInterfaceForNameMaybe ) import PrelInfo (knownKeyNames) +import TcHoleFitTypes + + {- Note [Valid hole fits include ...] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -430,13 +433,6 @@ getSortingAlg = then BySize else NoSorting } -hfIsLcl :: HoleFit -> Bool -hfIsLcl hf@(HoleFit {}) = case hfCand hf of - IdHFCand _ -> True - NameHFCand _ -> False - GreHFCand gre -> gre_lcl gre -hfIsLcl _ = False - -- If enabled, we go through the fits and add any associated documentation, -- by looking it up in the module or the environment (for local fits) addDocs :: [HoleFit] -> TcM [HoleFit] @@ -893,7 +889,7 @@ tcFilterHoleFits limit (TyH {..}) ht@(hole_ty, _) candidates = else return Nothing } else return Nothing } where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType ty - hole = TyH relevantCts implics Nothing + hole = TyH tyHRelevantCts tyHImplics Nothing subsDiscardMsg :: SDoc @@ -954,7 +950,7 @@ tcCheckHoleFit (TyH {..}) hole_ty ty = discardErrs $ -- the innermost (the one with the highest level) is first, so it -- suffices to get the level of the first one (or the current level, if -- there are no implications involved). - innermost_lvl <- case implics of + innermost_lvl <- case tyHImplics of [] -> getTcLevel -- imp is the innermost implication (imp:_) -> return (ic_tclvl imp) @@ -962,15 +958,15 @@ tcCheckHoleFit (TyH {..}) hole_ty ty = discardErrs $ tcSubType_NC ExprSigCtxt ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted - ; if isEmptyWC wanted && isEmptyBag relevantCts + ; if isEmptyWC wanted && isEmptyBag tyHRelevantCts then traceTc "}" empty >> return (True, wrp) else do { fresh_binds <- newTcEvBinds -- The relevant constraints may contain HoleDests, so we must -- take care to clone them as well (to avoid #15370). - ; cloned_relevants <- mapBagM cloneWanted relevantCts + ; cloned_relevants <- mapBagM cloneWanted tyHRelevantCts -- We wrap the WC in the nested implications, see -- Note [Nested Implications] - ; let outermost_first = reverse implics + ; let outermost_first = reverse tyHImplics setWC = setWCAndBinds fresh_binds -- We add the cloned relevants to the wanteds generated by -- the call to tcSubType_NC, see Note [Relevant Constraints] @@ -998,5 +994,5 @@ tcCheckHoleFit (TyH {..}) hole_ty ty = discardErrs $ fromPureHFPlugin :: HoleFitPlugin -> HoleFitPluginR fromPureHFPlugin plug = HoleFitPluginR { hfPluginInit = newTcRef () - , holeFitPluginR = const plug + , hfPluginRun = const plug , hfPluginStop = const $ return () } ===================================== compiler/typecheck/TcHoleFitTypes.hs ===================================== @@ -0,0 +1,144 @@ +{-# LANGUAGE ExistentialQuantification #-} +module TcHoleFitTypes ( + TypedHole (..), HoleFit (..), HoleFitCandidate (..), + CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..), + hfIsLcl, pprHoleFitCand + ) where + +import GhcPrelude + +import TcRnTypes +import TcType + +import RdrName + +import HsDoc +import Id + +import Outputable +import Name + +import Data.Function ( on ) + +data TypedHole = TyH { tyHRelevantCts :: Cts + -- ^ Any relevant Cts to the hole + , tyHImplics :: [Implication] + -- ^ The nested implications of the hole with the + -- innermost implication first. + , tyHCt :: Maybe Ct + -- ^ The hole constraint itself, if available. + } + +instance Outputable TypedHole where + ppr (TyH rels implics ct) + = hang (text "TypedHole") 2 + (ppr rels $+$ ppr implics $+$ ppr ct) + + +-- | HoleFitCandidates are passed to hole fit plugins and then +-- checked whether they fit a given typed-hole. +data HoleFitCandidate = IdHFCand Id -- An id, like locals. + | NameHFCand Name -- A name, like built-in syntax. + | GreHFCand GlobalRdrElt -- A global, like imported ids. + deriving (Eq) + +instance Outputable HoleFitCandidate where + ppr = pprHoleFitCand + +pprHoleFitCand :: HoleFitCandidate -> SDoc +pprHoleFitCand (IdHFCand cid) = text "Id HFC: " <> ppr cid +pprHoleFitCand (NameHFCand cname) = text "Name HFC: " <> ppr cname +pprHoleFitCand (GreHFCand cgre) = text "Gre HFC: " <> ppr cgre + + + + +instance NamedThing HoleFitCandidate where + getName hfc = case hfc of + IdHFCand cid -> idName cid + NameHFCand cname -> cname + GreHFCand cgre -> gre_name cgre + getOccName hfc = case hfc of + IdHFCand cid -> occName cid + NameHFCand cname -> occName cname + GreHFCand cgre -> occName (gre_name cgre) + +instance HasOccName HoleFitCandidate where + occName = getOccName + +instance Ord HoleFitCandidate where + compare = compare `on` getName + +-- | HoleFit is the type we use for valid hole fits. It contains the +-- element that was checked, the Id of that element as found by `tcLookup`, +-- and the refinement level of the fit, which is the number of extra argument +-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). +data HoleFit = + HoleFit { hfId :: Id -- ^ The elements id in the TcM + , hfCand :: HoleFitCandidate -- ^ The candidate that was checked. + , hfType :: TcType -- ^ The type of the id, possibly zonked. + , hfRefLvl :: Int -- ^ The number of holes in this fit. + , hfWrap :: [TcType] -- ^ The wrapper for the match. + , hfMatches :: [TcType] + -- ^ What the refinement variables got matched with, if anything + , hfDoc :: Maybe HsDocString + -- ^ Documentation of this HoleFit, if available. + } + | RawHoleFit SDoc + -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins + -- can inject any fit they want. + +-- We define an Eq and Ord instance to be able to build a graph. +instance Eq HoleFit where + (==) = (==) `on` hfId + +instance Outputable HoleFit where + ppr (RawHoleFit sd) = sd + ppr (HoleFit _ cand ty _ _ mtchs _) = + hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty)) + where name = ppr $ getName cand + holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs + +-- We compare HoleFits by their name instead of their Id, since we don't +-- want our tests to be affected by the non-determinism of `nonDetCmpVar`, +-- which is used to compare Ids. When comparing, we want HoleFits with a lower +-- refinement level to come first. +instance Ord HoleFit where + compare (RawHoleFit _) (RawHoleFit _) = EQ + compare (RawHoleFit _) _ = LT + compare _ (RawHoleFit _) = GT + compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b + where cmp = if hfRefLvl a == hfRefLvl b + then compare `on` (getName . hfCand) + else compare `on` hfRefLvl + +hfIsLcl :: HoleFit -> Bool +hfIsLcl hf@(HoleFit {}) = case hfCand hf of + IdHFCand _ -> True + NameHFCand _ -> False + GreHFCand gre -> gre_lcl gre +hfIsLcl _ = False + + +-- | A plugin for modifying the candidate hole fits *before* they're checked. +type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] + +-- | A plugin for modifying hole fits *after* they've been found. +type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] + +-- | A HoleFitPlugin is a pair of candidate and fit plugins. +data HoleFitPlugin = HoleFitPlugin + { candPlugin :: CandPlugin + , fitPlugin :: FitPlugin } + +-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can +-- track internal state. Note the existential quantification, ensuring that +-- the state cannot be modified from outside the plugin. +data HoleFitPluginR = forall s. HoleFitPluginR + { hfPluginInit :: TcM (TcRef s) + -- ^ Initializes the TcRef to be passed to the plugin + , hfPluginRun :: TcRef s -> HoleFitPlugin + -- ^ The function defining the plugin itself + , hfPluginStop :: TcRef s -> TcM () + -- ^ Cleanup of state, guaranteed to be called even on error + } ===================================== compiler/typecheck/TcHoleFitTypes.hs-boot ===================================== @@ -0,0 +1,7 @@ +-- This boot file is in place to break the loop where: +-- + TcRnTypes needs 'HoleFitPlugin', +-- + which needs 'TcHoleFitTypes' +-- + which needs 'TcRnTypes' +module TcHoleFitTypes where + +data HoleFitPlugin ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -141,6 +141,8 @@ import qualified Data.Set as S import Control.DeepSeq import Control.Monad +import TcHoleFitTypes ( HoleFitPluginR (..) ) + #include "HsVersions.h" @@ -166,7 +168,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax (text "Renamer/typechecker"<+>brackets (ppr this_mod)) (const ()) $ initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $ - withTcPlugins hsc_env $ withHfPlugins hsc_env $ + withTcPlugins hsc_env $ withHoleFitPlugins hsc_env $ tcRnModuleTcRnM hsc_env mod_sum parsedModule pair @@ -1842,7 +1844,7 @@ runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a) -- Initialise the tcg_inst_env with instances from all home modules. -- This mimics the more selective call to hptInstances in tcRnImports runTcInteractive hsc_env thing_inside - = initTcInteractive hsc_env $ withTcPlugins hsc_env $ withHfPlugins hsc_env $ + = initTcInteractive hsc_env $ withTcPlugins hsc_env $ withHoleFitPlugins hsc_env $ do { traceTc "setInteractiveContext" $ vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt)) , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts) @@ -2877,8 +2879,8 @@ getTcPlugins :: DynFlags -> [TcRnMonad.TcPlugin] getTcPlugins dflags = catMaybes $ mapPlugins dflags (\p args -> tcPlugin p args) -withHfPlugins :: HscEnv -> TcM a -> TcM a -withHfPlugins hsc_env m = +withHoleFitPlugins :: HscEnv -> TcM a -> TcM a +withHoleFitPlugins hsc_env m = case (getHfPlugins (hsc_dflags hsc_env)) of [] -> m -- Common fast case plugins -> do (plugins,stops) <- unzip `fmap` mapM startPlugin plugins ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -130,10 +130,6 @@ module TcRnTypes( eqCanDischargeFR, funEqCanDischarge, funEqCanDischargeF, - -- Hole Fit Plugins - TypedHole (..), HoleFit (..), HoleFitCandidate (..), - CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..), - -- Pretty printing pprEvVarTheta, pprEvVars, pprEvVarWithType, @@ -202,7 +198,6 @@ import CostCentreState import Control.Monad (ap, liftM, msum) import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) -import Data.Function ( on ) import qualified Data.Set as S import Data.List ( sort ) @@ -213,6 +208,8 @@ import Data.Maybe ( mapMaybe ) import GHCi.Message import GHCi.RemoteTypes +import {-# SOURCE #-} TcHoleFitTypes ( HoleFitPlugin ) + import qualified Language.Haskell.TH as TH -- | A 'NameShape' is a substitution on 'Name's that can be used @@ -3919,121 +3916,3 @@ getRoleAnnots :: [Name] -> RoleAnnotEnv getRoleAnnots bndrs role_env = ( mapMaybe (lookupRoleAnnot role_env) bndrs , delListFromNameEnv role_env bndrs ) - -{- -Hole Fit Plugins -------------------------- --} - -data TypedHole = TyH { relevantCts :: Cts - -- ^ Any relevant Cts to the hole - , implics :: [Implication] - -- ^ The nested implications of the hole with the - -- innermost implication first. - , holeCt :: Maybe Ct - -- ^ The hole constraint itself, if available. - } - -instance Outputable TypedHole where - ppr (TyH rels implics ct) - = hang (text "TypedHole") 2 - (ppr rels $+$ ppr implics $+$ ppr ct) - - --- | HoleFitCandidates are passed to hole fit plugins and then --- checked whether they fit a given typed-hole. -data HoleFitCandidate = IdHFCand Id -- An id, like locals. - | NameHFCand Name -- A name, like built-in syntax. - | GreHFCand GlobalRdrElt -- A global, like imported ids. - deriving (Eq) - -instance Outputable HoleFitCandidate where - ppr = pprHoleFitCand - -pprHoleFitCand :: HoleFitCandidate -> SDoc -pprHoleFitCand (IdHFCand id) = text "Id HFC: " <> ppr id -pprHoleFitCand (NameHFCand name) = text "Name HFC: " <> ppr name -pprHoleFitCand (GreHFCand gre) = text "Gre HFC: " <> ppr gre - -instance NamedThing HoleFitCandidate where - getName hfc = case hfc of - IdHFCand id -> idName id - NameHFCand name -> name - GreHFCand gre -> gre_name gre - getOccName hfc = case hfc of - IdHFCand id -> occName id - NameHFCand name -> occName name - GreHFCand gre -> occName (gre_name gre) - -instance HasOccName HoleFitCandidate where - occName = getOccName - -instance Ord HoleFitCandidate where - compare = compare `on` getName - --- | HoleFit is the type we use for valid hole fits. It contains the --- element that was checked, the Id of that element as found by `tcLookup`, --- and the refinement level of the fit, which is the number of extra argument --- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). -data HoleFit = - HoleFit { hfId :: Id -- ^ The elements id in the TcM - , hfCand :: HoleFitCandidate -- ^ The candidate that was checked. - , hfType :: TcType -- ^ The type of the id, possibly zonked. - , hfRefLvl :: Int -- ^ The number of holes in this fit. - , hfWrap :: [TcType] -- ^ The wrapper for the match. - , hfMatches :: [TcType] - -- ^ What the refinement variables got matched with, if anything - , hfDoc :: Maybe HsDocString - -- ^ Documentation of this HoleFit, if available. - } - | RawHoleFit SDoc - -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins - -- can inject any fit they want. - --- We define an Eq and Ord instance to be able to build a graph. -instance Eq HoleFit where - (==) = (==) `on` hfId - -instance Outputable HoleFit where - ppr (RawHoleFit sd) = sd - ppr (HoleFit _ cand ty _ _ mtchs _) = - hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty)) - where name = ppr $ getName cand - holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs - --- We compare HoleFits by their name instead of their Id, since we don't --- want our tests to be affected by the non-determinism of `nonDetCmpVar`, --- which is used to compare Ids. When comparing, we want HoleFits with a lower --- refinement level to come first. -instance Ord HoleFit where - compare (RawHoleFit _) (RawHoleFit _) = EQ - compare (RawHoleFit _) _ = LT - compare _ (RawHoleFit _) = GT - compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b - where cmp = if hfRefLvl a == hfRefLvl b - then compare `on` (getName . hfCand) - else compare `on` hfRefLvl - - --- | A plugin for modifying the candidate hole fits *before* they're checked. -type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] - --- | A plugin for modifying hole fits *after* they've been found. -type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] - --- | A HoleFitPlugin is a pair of candidate and fit plugins. -data HoleFitPlugin = HoleFitPlugin - { candPlugin :: CandPlugin - , fitPlugin :: FitPlugin } - --- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can --- track internal state. Note the existential quantification, ensuring that --- the state cannot be modified from outside the plugin. -data HoleFitPluginR = forall s. HoleFitPluginR - { hfPluginInit :: TcM (TcRef s) - -- ^ Initializes the TcRef to be passed to the plugin - , holeFitPluginR :: TcRef s -> HoleFitPlugin - -- ^ The function defining the plugin itself - , hfPluginStop :: TcRef s -> TcM () - -- ^ Cleanup of state, guaranteed to be called even on error - } ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -869,12 +869,12 @@ at error generation. :: - data TypedHole = TyH { relevantCts :: Cts + data TypedHole = TyH { tyHRelevantCts :: Cts -- ^ Any relevant Cts to the hole - , implics :: [Implication] + , tyHImplics :: [Implication] -- ^ The nested implications of the hole with the -- innermost implication first. - , holeCt :: Maybe Ct + , tyHCt :: Maybe Ct -- ^ The hole constraint itself, if available. } @@ -912,7 +912,7 @@ communication between the candidate and fit plugin. data HoleFitPluginR = forall s. HoleFitPluginR { hfPluginInit :: TcM (TcRef s) -- ^ Initializes the TcRef to be passed to the plugin - , holeFitPluginR :: TcRef s -> HoleFitPlugin + , hfPluginRun :: TcRef s -> HoleFitPlugin -- ^ The function defining the plugin itself , hfPluginStop :: TcRef s -> TcM () -- ^ Cleanup of state, guaranteed to be called even on error @@ -987,7 +987,7 @@ spent on searching for valid hole fits, after which new searches are aborted. fromModule _ = [] toHoleFitCommand :: TypedHole -> String -> Maybe String - toHoleFitCommand TyH{holeCt = Just (CHoleCan _ h)} str + toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str = stripPrefix ("_" <> str) $ occNameString $ holeOcc h toHoleFitCommand _ _ = Nothing ===================================== testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs ===================================== @@ -34,7 +34,7 @@ fromModule (GreHFCand gre) = fromModule _ = [] toHoleFitCommand :: TypedHole -> String -> Maybe String -toHoleFitCommand TyH{holeCt = Just (CHoleCan _ h)} str +toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str = stripPrefix ("_" <> str) $ occNameString $ holeOcc h toHoleFitCommand _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3559a11ee39a76b65755ba8bffd821cba776019b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3559a11ee39a76b65755ba8bffd821cba776019b You're receiving 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 Jun 6 18:10:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 06 Jun 2019 14:10:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/doc-index Message-ID: <5cf957241b540_6f73fe6148a29f8468260@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/doc-index at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/doc-index You're receiving 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 Jun 6 18:11:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 06 Jun 2019 14:11:17 -0400 Subject: [Git][ghc/ghc][wip/doc-index] 8 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cf95745461_6f73fe6148a29f84690b3@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/doc-index at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 7e67a746 by Ben Gamari at 2019-06-06T18:11:10Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - + testsuite/driver/js/Chart-2.8.0.min.js - + testsuite/driver/js/tooltip.js - testsuite/driver/perf_notes.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/ffi/should_compile/ReducingFfiSignature.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.hs - + testsuite/tests/ffi/should_fail/NonreducingFfiSignature.stderr - testsuite/tests/ffi/should_fail/all.T - + testsuite/tests/ffi/should_run/T16650a.hs - + testsuite/tests/ffi/should_run/T16650a.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/952ec379ae594b2af1f09816a9fb0bde6adde0d7...7e67a746b2b27ad688745d5f651fdf7e0bdad89b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/952ec379ae594b2af1f09816a9fb0bde6adde0d7...7e67a746b2b27ad688745d5f651fdf7e0bdad89b You're receiving 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 Jun 6 20:08:57 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 06 Jun 2019 16:08:57 -0400 Subject: [Git][ghc/ghc][wip/T16728] wibbles Message-ID: <5cf972d926b34_6f7ec81e9c4863d8@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 598efac5 by Simon Peyton Jones at 2019-06-06T20:03:38Z wibbles - - - - - 4 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcType.hs Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -1008,6 +1008,8 @@ can_eq_nc_forall ev eq_rel s1 s2 (substTy subst (tyVarKind tv2)) ; let subst' = extendTvSubstAndInScope subst tv2 (mkCastTy (mkTyVarTy skol_tv) kind_co) + -- skol_tv is already in the in-scope set, but the + -- free vars of kind_co are not; hence "...AndInScope" ; (co, wanteds2) <- go skol_tvs subst' bndrs2 ; return ( mkTcForAllCo skol_tv kind_co co , wanteds1 `unionBags` wanteds2 ) } ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -863,7 +863,7 @@ regardless of whether PartialTypeSignatures is enabled or not. But how would the typechecker know which '_' is being used in VKA and which is not when it calls emitNamedWildCardHoleConstraints in tcHsPartialSigType on all HsWildCardBndrs? The solution then is to neither rename nor include unnamed wildcards in HsWildCardBndrs, -but instead give every anonymouswildcard a fresh wild tyvar in tcAnonWildCardOcc. +but instead give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc. And whenever we see a '@', we automatically turn on PartialTypeSignatures and turn off hole constraint warnings, and do not call emitAnonWildCardHoleConstraint under these conditions. @@ -1709,7 +1709,7 @@ To avoid the double-zonk, we do two things: tcNamedWildCardBinders :: [Name] -> ([(Name, TcTyVar)] -> TcM a) -> TcM a --- Bring into scope the /named/ wildcard binders. Remember taht +-- Bring into scope the /named/ wildcard binders. Remember that -- plain wildcards _ are anonymous and dealt with by HsWildCardTy -- Soe Note [The wildcard story for types] in HsTypes tcNamedWildCardBinders wc_names thing_inside @@ -2477,8 +2477,8 @@ tcHsPartialSigType -> LHsSigWcType GhcRn -- The type signature -> TcM ( [(Name, TcTyVar)] -- Wildcards , Maybe TcType -- Extra-constraints wildcard - , [Name] -- Original tyvar names, in correspondence with ... - , [TcTyVar] -- ... Implicitly and explicitly bound type variables + , [(Name,TcTyVar)] -- 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] @@ -2504,26 +2504,23 @@ tcHsPartialSigType ctxt sig_ty ; return (wcs, wcx, theta, tau) } - -- We must return these separately, because all the zonking below - -- might change the name of a TyVarTv. This, in turn, causes trouble - -- in partial type signatures that bind scoped type variables, as - -- we bring the wrong name into scope in the function body. - -- Test case: partial-sigs/should_compile/LocalDefinitionBug - ; let tv_names = implicit_hs_tvs ++ hsLTyVarNames explicit_hs_tvs - -- 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] ; emitNamedWildCardHoleConstraints wcs - ; let all_tvs = implicit_tvs ++ explicit_tvs + -- We return a proper (Name,TyVar) environment, to be sure that + -- we bring the right name into scope in the function body. + -- Test case: partial-sigs/should_compile/LocalDefinitionBug + ; let tv_prs = (implicit_hs_tvs `zip` implicit_tvs) + ++ (hsLTyVarNames explicit_hs_tvs `zip` explicit_tvs) -- 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 tuype to check - ; traceTc "tcHsPartialSigType" (ppr all_tvs) - ; return (wcs, wcx, tv_names, all_tvs, theta, tau) } + ; traceTc "tcHsPartialSigType" (ppr tv_prs) + ; return (wcs, wcx, tv_prs, theta, tau) } tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPartialSigType" tcHsPartialSigType _ (XHsWildCardBndrs _) = panic "tcHsPartialSigType" ===================================== compiler/typecheck/TcSigs.hs ===================================== @@ -498,10 +498,9 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty , sig_loc = loc }) = setSrcSpan loc $ -- Set the binding site of the tyvars do { traceTc "Staring partial sig {" (ppr hs_sig) - ; (wcs, wcx, tv_names, tvs, theta, tau) <- tcHsPartialSigType ctxt hs_ty + ; (wcs, wcx, tv_prs, theta, tau) <- tcHsPartialSigType ctxt hs_ty -- See Note [Checking partial type signatures] in TcHsType - ; let tv_prs = tv_names `zip` tvs - inst_sig = TISI { sig_inst_sig = hs_sig + ; let inst_sig = TISI { sig_inst_sig = hs_sig , sig_inst_skols = tv_prs , sig_inst_wcs = wcs , sig_inst_wcx = wcx ===================================== compiler/typecheck/TcType.hs ===================================== @@ -1794,8 +1794,8 @@ hasTyVarHead ty -- Haskell 98 allows predicates of form evVarPred :: EvVar -> PredType evVarPred var = varType var - -- Historical note: I used to have an ASSERRT here, - -- checking (isEvVarType (varType var). But with something like + -- Historical note: I used to have an ASSERT here, + -- checking (isEvVarType (varType var)). But with something like -- f :: c => _ -> _ -- we end up with (c :: kappa), and (kappa ~ Constraint). Until -- we solve and zonk (which there is no particular reason to do for View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/598efac59cde44706761048aeb47e624da1f5b22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/598efac59cde44706761048aeb47e624da1f5b22 You're receiving 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 Jun 6 22:07:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 06 Jun 2019 18:07:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/memory-barriers Message-ID: <5cf98eb93c19b_6f73fe6148a29f84947bd@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/memory-barriers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/memory-barriers You're receiving 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 Jun 6 22:55:37 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Thu, 06 Jun 2019 18:55:37 -0400 Subject: [Git][ghc/ghc][wip/ldv-profile] Fix warning Message-ID: <5cf999e96d7b2_6f73fe6148a29f850124e@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/ldv-profile at Glasgow Haskell Compiler / GHC Commits: 93c36aac by Matthew Pickering at 2019-06-06T22:55:27Z Fix warning - - - - - 2 changed files: - includes/Rts.h - includes/rts/storage/ClosureMacros.h Changes: ===================================== includes/Rts.h ===================================== @@ -147,6 +147,14 @@ void _assertFail(const char *filename, unsigned int linenum) #define USED_IF_NOT_THREADS #endif +#if defined(PROFILING) +#define USED_IF_PROFILING +#define USED_IF_NOT_PROFILING STG_UNUSED +#else +#define USED_IF_PROFILING STG_UNUSED +#define USED_IF_NOT_PROFILING +#endif + #define FMT_SizeT "zu" #define FMT_HexSizeT "zx" ===================================== includes/rts/storage/ClosureMacros.h ===================================== @@ -545,7 +545,7 @@ EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t size /* closure size, in words */, bool prim /* Whether to call LDV_recordDead */ ); -EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size, bool prim) +EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size, bool prim USED_IF_PROFILING) { #if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK // see Note [zeroing slop], also #8402 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/93c36aac7d05a967b418d71ec1c68cf01d08ef1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/93c36aac7d05a967b418d71ec1c68cf01d08ef1f You're receiving 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 Jun 7 08:18:04 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?TWF0dGjDrWFzIFDDoWxsIEdpc3N1cmFyc29u?=) Date: Fri, 07 Jun 2019 04:18:04 -0400 Subject: [Git][ghc/ghc][wip/D5373] Ensure TcHoleFitTypes.hs-boot is in its proper place in the build order Message-ID: <5cfa1dbc4001c_6f73fe60594a7ac54861b@gitlab.haskell.org.mail> Matthías Páll Gissurarson pushed to branch wip/D5373 at Glasgow Haskell Compiler / GHC Commits: 67563027 by Matthías Páll Gissurarson at 2019-06-07T08:17:36Z Ensure TcHoleFitTypes.hs-boot is in its proper place in the build order - - - - - 1 changed file: - compiler/typecheck/TcHoleFitTypes.hs-boot Changes: ===================================== compiler/typecheck/TcHoleFitTypes.hs-boot ===================================== @@ -4,4 +4,7 @@ -- + which needs 'TcRnTypes' module TcHoleFitTypes where +-- Build ordering +import GHC.Base() + data HoleFitPlugin View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6756302765d8fc0e57f1de85c6304648af343676 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6756302765d8fc0e57f1de85c6304648af343676 You're receiving 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 Jun 7 08:37:53 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 04:37:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/disable-hadrian-mac Message-ID: <5cfa226122f0e_6f73fe6124404fc556264@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/disable-hadrian-mac at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/disable-hadrian-mac You're receiving 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 Jun 7 08:40:05 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 04:40:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: gitlab-ci: Disable darwin hadrian job Message-ID: <5cfa22e5ede56_6f73fe6058a759856226a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - 91ceb3c0 by Andrew Martin at 2019-06-07T08:39:39Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e4586d44 by Sebastian Graf at 2019-06-07T08:39:40Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - cd396413 by Matthew Pickering at 2019-06-07T08:39:40Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - f7c88182 by Roland Senn at 2019-06-07T08:39:42Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 7c14bb6f by John Ericson at 2019-06-07T08:39:47Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - 773994df by Simon Peyton Jones at 2019-06-07T08:39:47Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 4fefa798 by Ben Gamari at 2019-06-07T08:39:48Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - af9aedf8 by Simon Jakobi at 2019-06-07T08:39:51Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - 51c28874 by Moritz Angermann at 2019-06-07T08:39:51Z llvm-targets: Add x86_64 android layout - - - - - b59611ad by code5hot at 2019-06-07T08:39:52Z Update Traversable.hs with a note about an intuitive law - - - - - 398dd8c7 by code5hot at 2019-06-07T08:39:52Z Used terminology from a paper. Added it as a reference. - - - - - 106133a9 by code5hot at 2019-06-07T08:39:52Z remove backticks from markup - it doesn't mean what I think it means - - - - - 6bc404c1 by Zejun Wu at 2019-06-07T08:39:54Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 532c4543 by Ben Gamari at 2019-06-07T08:39:55Z base: Export Finalizers As requested in #16750. - - - - - a1e0296d by Alp Mestanogullari at 2019-06-07T08:39:57Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - ed03ee3f by Ben Gamari at 2019-06-07T08:39:58Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/main/DriverPipeline.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/ListSetOps.hs - docs/users_guide/eventlog-formats.rst - ghc/GHCi/UI.hs - hadrian/src/Hadrian/Utilities.hs - includes/rts/EventLogFormat.h - libraries/base/Data/Traversable.hs - libraries/base/GHC/ForeignPtr.hs - libraries/base/GHC/Natural.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/isValidNatural.hs - + libraries/base/tests/isValidNatural.stdout - + libraries/ghc-boot/GHC/BaseDir.hs - libraries/ghc-boot/ghc-boot.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e0cef1b84ad55ec13e8920a8ae7b93f0b574f40b...ed03ee3f7c9c919ed679e35beddba901fea0fa56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e0cef1b84ad55ec13e8920a8ae7b93f0b574f40b...ed03ee3f7c9c919ed679e35beddba901fea0fa56 You're receiving 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 Jun 7 09:10:21 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 07 Jun 2019 05:10:21 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cfa29fdc70f4_6f7e4125cc59595b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 238c8454 by Sebastian Graf at 2019-06-07T09:09:56Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 22 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - − compiler/utils/ListT.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,79 +92,38 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA - PmGrd :: { pm_grd_pv :: PatVec + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + PmGrd :: { pm_grd_pv :: PatVec -- ^ Always has 'patVecArity' 1. , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. PmFake :: PmPat 'PAT +-- | Should not face a user. instance Outputable (PmPat a) where - ppr = pprPmPatDebug + ppr (PmCon cc _arg_tys _con_tvs con_args) + = hsep [ppr cc, hsep (map ppr con_args)] + -- the @ is to differentiate (flexible) variables from rigid constructors and + -- literals + ppr (PmVar vid) = char '@' <> ppr vid + ppr (PmLit li) = ppr li + ppr (PmGrd pv ge) = hsep (map ppr pv) <+> text "<-" <+> ppr ge + ppr PmFake = text "" -- data T a where -- MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p] @@ -185,6 +144,17 @@ data Delta = MkDelta { delta_ty_cs :: Bag EvVar type ValSetAbs = [ValVec] -- ^ Value Set Abstractions type Uncovered = ValSetAbs +-- | Should not face a user. See 'pprValVecSubstituted' for that. +instance Outputable ValVec where + ppr (ValVec vva delta) = ppr vva <+> text "|>" <+> ppr_delta delta + where + ppr_delta _d = hcat [ + -- intentionally formatted this way enable the dev to comment in only + -- the info she needs + ppr (delta_tm_cs delta), + ppr (delta_ty_cs delta) + ] + -- Instead of keeping the whole sets in memory, we keep a boolean for both the -- covered and the divergent set (we store the uncovered set though, since we -- want to print it). For both the covered and the divergent we have: @@ -200,8 +170,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +187,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +198,27 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa - + ppr (PartialResult c vsa d) + = hang (text "PartialResult" <+> ppr c <+> ppr d) 2 (ppr_vsa vsa) + where + ppr_vsa = braces . fsep . punctuate comma . map ppr instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +236,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +267,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +284,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +293,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] - tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) + tracePm "checkSingle': missing" (vcat (map ppr missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered normaliseValVec us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +326,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +348,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars - tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + tracePm "checkMatches': missing" (vcat (map ppr missing)) + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered normaliseValVec us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +405,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +456,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +519,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +568,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +594,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +611,98 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | Tests whether the 'Id' can inhabit the given 'ConLike' in the context +-- expressed by the 'Delta'. +type InhabitationTest = Delta -> Id -> ConLike -> PmM Bool + +-- | An 'InhabitationTest' consulting 'mkOneSatisfiableConFull'. Precise, but +-- expensive. +isConSatisfiable :: InhabitationTest +isConSatisfiable delta x con = do + tracePm "conInhabitsId" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> mkOneSatisfiableConFull delta x con + +-- | Cheap 'InhabitationTest', always returning @True at . +cheapInhabitationTest :: InhabitationTest +cheapInhabitationTest _ _ _ = pure True + +normaliseValAbs :: InhabitationTest -> Delta -> ValAbs -> PmM (Maybe (Delta, ValAbs)) +normaliseValAbs is_con_inh delta = runMaybeT . go_va delta + where + go_va :: Delta -> ValAbs -> MaybeT PmM (Delta, ValAbs) + go_va delta pm at PmCon{ pm_con_args = args } = do + (delta', args') <- mapAccumLM go_va delta args + pure (delta', pm { pm_con_args = args' }) + go_va delta va@(PmVar x) + | let (ty, pacs) = lookupRefutableAltCons (delta_tm_cs delta) x + -- TODO: Even if ncons is empty, we might have a complete match ('Void', + -- constraints). Figure out how to the complete matches solely from + -- @ty at . + , ncons@(cl:_) <- [ cl | PmAltConLike cl <- pacs ] = do + grps <- lift (allCompleteMatches cl ty) + let is_grp_inh = filterM (lift . is_con_inh delta x) . (\\ ncons) + incomplete_grps <- traverse is_grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValAbs is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- @PmCon@ for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a @PmCon@ (which won't normalise + -- any further) when @p@ is just the 'cheapInhabitationTest'. + -- Thus, we have to assert satisfiability here, even if the + -- expensive 'isConSatisfiable' already did so. Also, we have to + -- store the constraints in @delta at . + (delta', ic) <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (delta', ic_val_abs ic) + _ -> pure (delta, va) + go_va delta va = pure (delta, va) + +-- | Something that normalises a 'ValVec' by consulting the given +-- 'InhabitationTest' to weed out vacuous 'ValAbs'. +-- See also 'normaliseValVecHead' and 'normaliseValVec'. +type ValVecNormaliser = InhabitationTest -> ValVec -> PmM (Maybe ValVec) + +-- | A 'ValVecNormaliser' that normalises all components of a 'ValVec'. This is +-- the 'ValVecNormaliser' to choose once at the end. +normaliseValVec :: ValVecNormaliser +normaliseValVec test (ValVec vva delta) = runMaybeT $ do + (delta', vva') <- mapAccumLM ((MaybeT .) . normaliseValAbs test) delta vva + pure (ValVec vva' delta') + +-- | A 'ValVecNormaliser' that only tries to normalise the head of each +-- 'ValVec'. This is mandatory for pattern guards, where we call 'utail' on the +-- temporarily extended 'ValVec', hence there's no way to delay this check. +-- Of course we could 'normaliseValVec' instead, but that's unnecessarily +-- expensive. +normaliseValVecHead :: ValVecNormaliser +normaliseValVecHead _ vva@(ValVec [] _) = pure (Just vva) +normaliseValVecHead test (ValVec (va:vva) delta) = runMaybeT $ do + (delta', va') <- MaybeT (normaliseValAbs test delta va) + pure (ValVec (va':vva) delta') + +-- | This weeds out 'ValVec's with 'PmVar's where at least one COMPLETE set is +-- rendered vacuous by equality constraints, by calling out the given +-- 'ValVecNormaliser' with different 'InhabitationTest's. +-- +-- This is quite costly due to the many oracle queries, so we only call this at +-- the last possible moment. I.e., with 'normaliseValVecHead' when leaving a +-- pattern guard and with 'normaliseValVec' on the final uncovered set. +normaliseUncovered :: ValVecNormaliser -> Uncovered -> PmM Uncovered +normaliseUncovered normalise_val_vec us = do + -- We'll first do a cheap sweep without consulting the oracles + us1 <- mapMaybeM (normalise_val_vec cheapInhabitationTest) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + us2 <- mapMaybeM (normalise_val_vec isConSatisfiable) us1 + tracePm "normaliseUncovered" (vcat (map ppr us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +859,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +873,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +883,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +893,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +951,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +959,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +968,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +993,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1072,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1209,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1270,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1290,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1319,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1327,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1340,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1452,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1481,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1464,7 +1495,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1508,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1634,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1685,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,52 +1725,54 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe (Delta, InhabitationCandidate)) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + ((,ic) <$>) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1781,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1792,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1808,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1854,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1956,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,10 +2038,11 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheck" (ppr n <> colon + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr vva) res <- pmcheck ps guards vva tracePm "pmCheckResult:" (ppr res) return res @@ -1986,7 +2051,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,12 +2059,12 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p - $$ pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprPmPatDebug va - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheckHdI" (ppr n <> colon <+> ppr p + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr va + $$ ppr vva) res <- pmcheckHd p ps guards va vva tracePm "pmCheckHdI: res" (ppr res) @@ -2024,10 +2089,15 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + -- The heads of the ValVecs in the uncovered set might be vacuous, so + -- normalise them + us <- normaliseUncovered normaliseValVecHead (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2109,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2123,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,72 +2146,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2202,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2213,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2368,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2378,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2397,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2418,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2452,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2478,23 +2527,23 @@ isAnyPmCheckEnabled :: DynFlags -> DsMatchContext -> Bool isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind -instance Outputable ValVec where - ppr (ValVec vva delta) - = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in pprUncovered (vector, refuts) +pprValVecSubstituted :: ValVec -> SDoc +pprValVecSubstituted (ValVec vva delta) = pprUncovered (vector, refuts) + where + (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2560,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2571,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2536,7 +2582,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" - _missing -> let us = map ppr qs + _missing -> let us = map pprValVecSubstituted qs in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -2637,39 +2683,8 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags Opt_D_dump_ec_trace (text herald $$ (nest 2 doc)) - - -pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) - = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] -pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid -pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl -pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) - <+> ppr ge -pprPmPatDebug PmFake = text "PmFake" - -pprPatVec :: PatVec -> SDoc -pprPatVec ps = hang (text "Pattern:") 2 - (brackets $ sep - $ punctuate (comma <> char '\n') (map pprPmPatDebug ps)) - -pprValAbs :: [ValAbs] -> SDoc -pprValAbs ps = hang (text "ValAbs:") 2 - (brackets $ sep - $ punctuate (comma) (map pprPmPatDebug ps)) - -pprValVecDebug :: ValVec -> SDoc -pprValVecDebug (ValVec vas _d) = text "ValVec" <+> - parens (pprValAbs vas) - -- $$ ppr (delta_tm_cs _d) - -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -53,34 +54,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args + +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +144,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +188,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +245,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells. +pmExprAsList :: PmExpr -> Maybe [PmExpr] +pmExprAsList (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just [] + | c == consDataCon + = ASSERT( length es == 2 ) (es !! 0 :) <$> pmExprAsList (es !! 1) +pmExprAsList _ + = Nothing {- %************************************************************************ @@ -260,18 +274,18 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l go _ (PmExprVar v) = ppr v go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (pmExprAsList -> Just list) + = brackets $ fsep $ punctuate comma $ map ppr list + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hsep (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,33 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just list <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = brackets . fsep . punctuate comma <$> mapM pprPmExpr list +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +174,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -109,7 +117,7 @@ instance Outputable TmState where pos = map pos_eq (nonDetUFMToList (tm_pos state)) neg = map neg_eq (udfmToList (tm_neg state)) pos_eq (l, r) = ppr l <+> char '~' <+> ppr r - neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + neg_eq (l, r) = ppr l <+> text "/~" <+> ppr r -- | Initial state of the oracle. initialTmState :: TmState @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,24 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] -lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) +-- +-- Note that because of Note [The Pos/Neg invariant], this will return an empty +-- list of alt cons for 'Id's which already have a solution. +lookupRefutableAltCons :: TmState -> Id -> (Type, [PmAltCon]) +lookupRefutableAltCons _tms at TmS{ tm_pos = pos, tm_neg = neg } x + = fromMaybe (idType x, []) (lookupDNameEnv neg y) + where + (y, _e) = varDeepLookup pos (idName x) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -193,6 +207,11 @@ isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x isFlexible :: TmState -> Name -> Bool isFlexible tms = isNothing . isRigid tms +-- | Is this a solution for a variable, i.e., something in WHNF? +isSolution :: PmExpr -> Bool +isSolution PmExprCon{} = True +isSolution _ = False + -- | Try to unify two 'PmExpr's and record the gained knowledge in the -- 'TmState'. -- @@ -205,12 +224,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +239,46 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a solution, i.e., 'PmExprCon' (cf. 'isSolution'). +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( isSolution e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) - where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +297,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +305,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +359,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -557,7 +557,6 @@ Library IOEnv Json ListSetOps - ListT Maybes MonadUtils OrdList ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== compiler/utils/ListT.hs deleted ===================================== @@ -1,80 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -------------------------------------------------------------------------- --- | --- Module : Control.Monad.Logic --- Copyright : (c) Dan Doel --- License : BSD3 --- --- Maintainer : dan.doel at gmail.com --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- A backtracking, logic programming monad. --- --- Adapted from the paper --- /Backtracking, Interleaving, and Terminating --- Monad Transformers/, by --- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry --- (). -------------------------------------------------------------------------- - -module ListT ( - ListT(..), - runListT, - select, - fold - ) where - -import GhcPrelude - -import Control.Applicative - -import Control.Monad -import Control.Monad.Fail as MonadFail - -------------------------------------------------------------------------- --- | A monad transformer for performing backtracking computations --- layered over another monad 'm' -newtype ListT m a = - ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r } - -select :: Monad m => [a] -> ListT m a -select xs = foldr (<|>) mzero (map pure xs) - -fold :: ListT m a -> (a -> m r -> m r) -> m r -> m r -fold = runListT - -------------------------------------------------------------------------- --- | Runs a ListT computation with the specified initial success and --- failure continuations. -runListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r -runListT = unListT - -instance Functor (ListT f) where - fmap f lt = ListT $ \sk fk -> unListT lt (sk . f) fk - -instance Applicative (ListT f) where - pure a = ListT $ \sk fk -> sk a fk - f <*> a = ListT $ \sk fk -> unListT f (\g fk' -> unListT a (sk . g) fk') fk - -instance Alternative (ListT f) where - empty = ListT $ \_ fk -> fk - f1 <|> f2 = ListT $ \sk fk -> unListT f1 sk (unListT f2 sk fk) - -instance Monad (ListT m) where - m >>= f = ListT $ \sk fk -> unListT m (\a fk' -> unListT (f a) sk fk') fk -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail (ListT m) where - fail _ = ListT $ \_ fk -> fk - -instance MonadPlus (ListT m) where - mzero = ListT $ \_ fk -> fk - m1 `mplus` m2 = ListT $ \sk fk -> unListT m1 sk (unListT m2 sk fk) ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/238c845462e81cd2bff3828d63e1326f0562b871 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/238c845462e81cd2bff3828d63e1326f0562b871 You're receiving 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 Jun 7 10:11:58 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 07 Jun 2019 06:11:58 -0400 Subject: [Git][ghc/ghc][wip/T16728] Fix a lurking bug in typechecking ($) Message-ID: <5cfa386e54b_6f7e4125cc605152@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 35bea782 by Simon Peyton Jones at 2019-06-07T10:08:36Z Fix a lurking bug in typechecking ($) My partial-sigs patch revealed that the code in `TcExpr` that implements the special typing rule for `($)` was wrong. It called `getRuntimeRep` in a situation where where was no particular reason to suppose that the thing had kind `TYPE r`. This caused a crash in typecheck/should_run/T10846. The fix was easy, and actually simplifies the code in `TcExpr` quite a bit. Hooray. - - - - - 1 changed file: - compiler/typecheck/TcExpr.hs Changes: ===================================== compiler/typecheck/TcExpr.hs ===================================== @@ -378,42 +378,35 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty -- So: arg1_ty = arg2_ty -> op_res_ty -- where arg2_sigma maybe polymorphic; that's the point - ; arg2' <- tcArg op arg2 arg2_sigma 2 + ; arg2' <- tcArg op arg2 arg2_sigma 2 -- Make sure that the argument type has kind '*' -- ($) :: forall (r:RuntimeRep) (a:*) (b:TYPE r). (a->b) -> a -> b -- Eg we do not want to allow (D# $ 4.0#) #5570 -- (which gives a seg fault) - -- - -- The *result* type can have any kind (#8739), - -- so we don't need to check anything for that ; _ <- unifyKind (Just (XHsType $ NHsCoreTy arg2_sigma)) (tcTypeKind arg2_sigma) liftedTypeKind - -- ignore the evidence. arg2_sigma must have type * or #, - -- because we know arg2_sigma -> or_res_ty is well-kinded + -- Ignore the evidence. arg2_sigma must have type * or #, + -- because we know (arg2_sigma -> op_res_ty) is well-kinded -- (because otherwise matchActualFunTys would fail) - -- There's no possibility here of, say, a kind family reducing to *. + -- So this 'unifyKind' will either succeed with Refl, or will + -- produce an insoluble constraint * ~ #, which we'll report later. - ; wrap_res <- tcSubTypeHR orig1 (Just expr) op_res_ty res_ty - -- op_res -> res + -- NB: unlike the argument type, the *result* type, op_res_ty can + -- have any kind (#8739), so we don't need to check anything for that ; op_id <- tcLookupId op_name - ; res_ty <- readExpType res_ty - ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep res_ty + ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep op_res_ty , arg2_sigma - , res_ty]) + , op_res_ty]) (HsVar noExt (L lv op_id))) -- arg1' :: arg1_ty -- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty) - -- wrap_res :: op_res_ty "->" res_ty - -- op' :: (a2_ty -> res_ty) -> a2_ty -> res_ty + -- op' :: (a2_ty -> op_res_ty) -> a2_ty -> op_res_ty - -- wrap1 :: arg1_ty "->" (arg2_sigma -> res_ty) - wrap1 = mkWpFun idHsWrapper wrap_res arg2_sigma res_ty doc - <.> wrap_arg1 - doc = text "When looking at the argument to ($)" + expr' = OpApp fix (mkLHsWrap wrap_arg1 arg1') op' arg2' - ; return (OpApp fix (mkLHsWrap wrap1 arg1') op' arg2') } + ; tcWrapResult expr expr' op_res_ty res_ty } | (L loc (HsRecFld _ (Ambiguous _ lbl))) <- op , Just sig_ty <- obviousSig (unLoc arg1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/35bea7827a5fa750c4d09887913a9da6a8572bf9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/35bea7827a5fa750c4d09887913a9da6a8572bf9 You're receiving 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 Jun 7 10:15:21 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 07 Jun 2019 06:15:21 -0400 Subject: [Git][ghc/ghc][wip/T16728] Fix typechecking of partial type signatures Message-ID: <5cfa3939c65a6_6f73fe6058a75986059a2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: bb5f015c by Simon Peyton Jones at 2019-06-07T10:14:25Z Fix typechecking of partial type signatures Partial type sigs had grown hair. tcHsParialSigType was doing lots of unnecessary work, and tcInstSig was cloning it unnecessarily -- and the result didn't even work: #16728. This patch cleans it all up, described by TcHsType Note [Checking parital type signatures] I basically just deleted code... but very carefully! Some refactoring along the way * Distinguish more explicintly between "anonymous" wildcards "_" and "named" wildcards "_a". I changed the names of a number of functions to make this distinction much more apparent. The patch also revealed that the code in `TcExpr` that implements the special typing rule for `($)` was wrong. It called `getRuntimeRep` in a situation where where was no particular reason to suppose that the thing had kind `TYPE r`. This caused a crash in typecheck/should_run/T10846. The fix was easy, and actually simplifies the code in `TcExpr` quite a bit. Hooray. - - - - - 18 changed files: - compiler/rename/RnTypes.hs - compiler/typecheck/TcBinds.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnMonad.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcType.hs - + testsuite/tests/partial-sigs/should_compile/T16728.hs - + testsuite/tests/partial-sigs/should_compile/T16728.stderr - + testsuite/tests/partial-sigs/should_compile/T16728a.hs - + testsuite/tests/partial-sigs/should_compile/T16728a.stderr - + testsuite/tests/partial-sigs/should_compile/T16728b.hs - + testsuite/tests/partial-sigs/should_compile/T16728b.stderr - testsuite/tests/partial-sigs/should_compile/all.T - testsuite/tests/partial-sigs/should_fail/T14040a.stderr Changes: ===================================== compiler/rename/RnTypes.hs ===================================== @@ -693,8 +693,8 @@ checkAnonWildCard env | otherwise = case rtke_what env of RnTypeBody -> Nothing - RnConstraint -> Just constraint_msg RnTopConstraint -> Just constraint_msg + RnConstraint -> Just constraint_msg constraint_msg = hang (notAllowed pprAnonWildCard <+> text "in a constraint") @@ -714,7 +714,10 @@ checkNamedWildCard env name | otherwise = case rtke_what env of RnTypeBody -> Nothing -- Allowed - RnTopConstraint -> Nothing -- Allowed + RnTopConstraint -> Nothing -- Allowed; e.g. + -- f :: (Eq _a) => _a -> Int + -- g :: (_a, _b) => T _a _b -> Int + -- The named tyvars get filled in from elsewhere RnConstraint -> Just constraint_msg constraint_msg = notAllowed (ppr name) <+> text "in a constraint" ===================================== compiler/typecheck/TcBinds.hs ===================================== @@ -1020,7 +1020,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs ; case tcGetCastedTyVar_maybe wc_var_ty of -- We know that wc_co must have type kind(wc_var) ~ Constraint, as it - -- comes from the checkExpectedKind in TcHsType.tcWildCardOcc. So, to + -- comes from the checkExpectedKind in TcHsType.tcAnonWildCardOcc. So, to -- make the kinds work out, we reverse the cast here. Just (wc_var, wc_co) -> writeMetaTyVar wc_var (ctuple `mkCastTy` mkTcSymCo wc_co) Nothing -> pprPanic "chooseInferredQuantifiers 1" (ppr wc_var_ty) ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -1008,6 +1008,8 @@ can_eq_nc_forall ev eq_rel s1 s2 (substTy subst (tyVarKind tv2)) ; let subst' = extendTvSubstAndInScope subst tv2 (mkCastTy (mkTyVarTy skol_tv) kind_co) + -- skol_tv is already in the in-scope set, but the + -- free vars of kind_co are not; hence "...AndInScope" ; (co, wanteds2) <- go skol_tvs subst' bndrs2 ; return ( mkTcForAllCo skol_tv kind_co co , wanteds1 `unionBags` wanteds2 ) } ===================================== compiler/typecheck/TcExpr.hs ===================================== @@ -378,42 +378,35 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty -- So: arg1_ty = arg2_ty -> op_res_ty -- where arg2_sigma maybe polymorphic; that's the point - ; arg2' <- tcArg op arg2 arg2_sigma 2 + ; arg2' <- tcArg op arg2 arg2_sigma 2 -- Make sure that the argument type has kind '*' -- ($) :: forall (r:RuntimeRep) (a:*) (b:TYPE r). (a->b) -> a -> b -- Eg we do not want to allow (D# $ 4.0#) #5570 -- (which gives a seg fault) - -- - -- The *result* type can have any kind (#8739), - -- so we don't need to check anything for that ; _ <- unifyKind (Just (XHsType $ NHsCoreTy arg2_sigma)) (tcTypeKind arg2_sigma) liftedTypeKind - -- ignore the evidence. arg2_sigma must have type * or #, - -- because we know arg2_sigma -> or_res_ty is well-kinded + -- Ignore the evidence. arg2_sigma must have type * or #, + -- because we know (arg2_sigma -> op_res_ty) is well-kinded -- (because otherwise matchActualFunTys would fail) - -- There's no possibility here of, say, a kind family reducing to *. + -- So this 'unifyKind' will either succeed with Refl, or will + -- produce an insoluble constraint * ~ #, which we'll report later. - ; wrap_res <- tcSubTypeHR orig1 (Just expr) op_res_ty res_ty - -- op_res -> res + -- NB: unlike the argument type, the *result* type, op_res_ty can + -- have any kind (#8739), so we don't need to check anything for that ; op_id <- tcLookupId op_name - ; res_ty <- readExpType res_ty - ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep res_ty + ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep op_res_ty , arg2_sigma - , res_ty]) + , op_res_ty]) (HsVar noExt (L lv op_id))) -- arg1' :: arg1_ty -- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty) - -- wrap_res :: op_res_ty "->" res_ty - -- op' :: (a2_ty -> res_ty) -> a2_ty -> res_ty + -- op' :: (a2_ty -> op_res_ty) -> a2_ty -> op_res_ty - -- wrap1 :: arg1_ty "->" (arg2_sigma -> res_ty) - wrap1 = mkWpFun idHsWrapper wrap_res arg2_sigma res_ty doc - <.> wrap_arg1 - doc = text "When looking at the argument to ($)" + expr' = OpApp fix (mkLHsWrap wrap_arg1 arg1') op' arg2' - ; return (OpApp fix (mkLHsWrap wrap1 arg1') op' arg2') } + ; tcWrapResult expr expr' op_res_ty res_ty } | (L loc (HsRecFld _ (Ambiguous _ lbl))) <- op , Just sig_ty <- obviousSig (unLoc arg1) ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -36,7 +36,7 @@ module TcHsType ( -- Kind-checking types -- No kind generalisation, no checkValidType kcLHsQTyVars, - tcWildCardBinders, + tcNamedWildCardBinders, tcHsLiftedType, tcHsOpenType, tcHsLiftedTypeNC, tcHsOpenTypeNC, tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType, @@ -370,7 +370,7 @@ tcHsTypeApp wc_ty kind unsetWOptM Opt_WarnPartialTypeSignatures $ setXOptM LangExt.PartialTypeSignatures $ -- See Note [Wildcards in visible type application] - tcWildCardBinders sig_wcs $ \ _ -> + tcNamedWildCardBinders sig_wcs $ \ _ -> tcCheckLHsType hs_ty kind -- We must promote here. Ex: -- f :: forall a. a @@ -385,18 +385,19 @@ tcHsTypeApp (XHsWildCardBndrs _) _ = panic "tcHsTypeApp" {- Note [Wildcards in visible type application] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -A HsWildCardBndrs's hswc_ext now only includes named wildcards, so any unnamed -wildcards stay unchanged in hswc_body and when called in tcHsTypeApp, tcCheckLHsType -will call emitWildCardHoleConstraints on them. However, this would trigger -error/warning when an unnamed wildcard is passed in as a visible type argument, -which we do not want because users should be able to write @_ to skip a instantiating -a type variable variable without fuss. The solution is to switch the -PartialTypeSignatures flags here to let the typechecker know that it's checking -a '@_' and do not emit hole constraints on it. -See related Note [Wildcards in visible kind application] -and Note [The wildcard story for types] in HsTypes.hs - +A HsWildCardBndrs's hswc_ext now only includes /named/ wildcards, so +any unnamed wildcards stay unchanged in hswc_body. When called in +tcHsTypeApp, tcCheckLHsType will call emitAnonWildCardHoleConstraint +on these anonymous wildcards. However, this would trigger +error/warning when an anonymous wildcard is passed in as a visible type +argument, which we do not want because users should be able to write + at _ to skip a instantiating a type variable variable without fuss. The +solution is to switch the PartialTypeSignatures flags here to let the +typechecker know that it's checking a '@_' and do not emit hole +constraints on it. See related Note [Wildcards in visible kind +application] and Note [The wildcard story for types] in HsTypes.hs + +Ugh! -} {- @@ -812,7 +813,7 @@ tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek -tc_hs_type _ wc@(HsWildCardTy _) ek = tcWildCardOcc wc ek +tc_hs_type _ wc@(HsWildCardTy _) ek = tcAnonWildCardOcc wc ek ------------------------------------------ tc_fun_type :: TcTyMode -> LHsType GhcRn -> LHsType GhcRn -> TcKind @@ -832,18 +833,18 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of liftedTypeKind exp_kind } --------------------------- -tcWildCardOcc :: HsType GhcRn -> Kind -> TcM TcType -tcWildCardOcc wc exp_kind - = do { wc_tv <- newWildTyVar - -- The wildcard's kind should be an un-filled-in meta tyvar - ; loc <- getSrcSpanM - ; uniq <- newUnique - ; let name = mkInternalName uniq (mkTyVarOcc "_") loc +tcAnonWildCardOcc :: HsType GhcRn -> Kind -> TcM TcType +tcAnonWildCardOcc wc exp_kind + = do { wc_tv <- newWildTyVar -- The wildcard's kind will be an un-filled-in meta tyvar + ; part_tysig <- xoptM LangExt.PartialTypeSignatures ; warning <- woptM Opt_WarnPartialTypeSignatures - -- See Note [Wildcards in visible kind application] - ; unless (part_tysig && not warning) - (emitWildCardHoleConstraints [(name,wc_tv)]) + + ; unless (part_tysig && not warning) $ + emitAnonWildCardHoleConstraint wc_tv + -- Why the 'unless' guard? + -- See Note [Wildcards in visible kind application] + ; checkExpectedKind wc (mkTyVarTy wc_tv) (tyVarKind wc_tv) exp_kind } @@ -860,11 +861,11 @@ x = MkT So we should allow '@_' without emitting any hole constraints, and regardless of whether PartialTypeSignatures is enabled or not. But how would the typechecker know which '_' is being used in VKA and which is not when it -calls emitWildCardHoleConstraints in tcHsPartialSigType on all HsWildCardBndrs? +calls emitNamedWildCardHoleConstraints in tcHsPartialSigType on all HsWildCardBndrs? The solution then is to neither rename nor include unnamed wildcards in HsWildCardBndrs, -but instead give every unnamed wildcard a fresh wild tyvar in tcWildCardOcc. +but instead give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc. And whenever we see a '@', we automatically turn on PartialTypeSignatures and -turn off hole constraint warnings, and never call emitWildCardHoleConstraints +turn off hole constraint warnings, and do not call emitAnonWildCardHoleConstraint under these conditions. See related Note [Wildcards in visible type application] here and Note [The wildcard story for types] in HsTypes.hs @@ -1705,23 +1706,26 @@ To avoid the double-zonk, we do two things: gathers free variables. So this way effectively sidesteps step 3. -} -tcWildCardBinders :: [Name] - -> ([(Name, TcTyVar)] -> TcM a) - -> TcM a -tcWildCardBinders wc_names thing_inside +tcNamedWildCardBinders :: [Name] + -> ([(Name, TcTyVar)] -> TcM a) + -> TcM a +-- Bring into scope the /named/ wildcard binders. Remember that +-- plain wildcards _ are anonymous and dealt with by HsWildCardTy +-- Soe Note [The wildcard story for types] in HsTypes +tcNamedWildCardBinders wc_names thing_inside = do { wcs <- mapM (const newWildTyVar) wc_names ; let wc_prs = wc_names `zip` wcs ; tcExtendNameTyVarEnv wc_prs $ thing_inside wc_prs } newWildTyVar :: TcM TcTyVar --- ^ New unification variable for a wildcard +-- ^ New unification variable '_' for a wildcard newWildTyVar = do { kind <- newMetaKindVar ; uniq <- newUnique ; details <- newMetaDetails TauTv - ; let name = mkSysTvName uniq (fsLit "_") - tyvar = (mkTcTyVar name kind details) + ; let name = mkSysTvName uniq (fsLit "_") + tyvar = mkTcTyVar name kind details ; traceTc "newWildTyVar" (ppr tyvar) ; return tyvar } @@ -2473,11 +2477,11 @@ tcHsPartialSigType -> LHsSigWcType GhcRn -- The type signature -> TcM ( [(Name, TcTyVar)] -- Wildcards , Maybe TcType -- Extra-constraints wildcard - , [Name] -- Original tyvar names, in correspondence with ... - , [TcTyVar] -- ... Implicitly and explicitly bound type variables + , [(Name,TcTyVar)] -- Original tyvar names, in correspondence with + -- the implicitly and explicitly bound type variables , TcThetaType -- Theta part , TcType ) -- Tau part --- See Note [Recipe for checking a signature] +-- See Note [Checking partial type signatures] tcHsPartialSigType ctxt sig_ty | HsWC { hswc_ext = sig_wcs, hswc_body = ib_ty } <- sig_ty , HsIB { hsib_ext = implicit_hs_tvs @@ -2485,8 +2489,11 @@ tcHsPartialSigType ctxt sig_ty , (explicit_hs_tvs, L _ hs_ctxt, hs_tau) <- splitLHsSigmaTy hs_ty = addSigCtxt ctxt hs_ty $ do { (implicit_tvs, (explicit_tvs, (wcs, wcx, theta, tau))) - <- solveLocalEqualities "tcHsPatSigTypes" $ - tcWildCardBinders sig_wcs $ \ wcs -> + <- solveLocalEqualities "tcHsPartialSigType" $ + -- This solveLocalEqualiltes fails fast if there are + -- insoluble equalities. See TcSimplify + -- Note [Fail fast if there are insoluble kind equalities] + tcNamedWildCardBinders sig_wcs $ \ wcs -> bindImplicitTKBndrs_Tv implicit_hs_tvs $ bindExplicitTKBndrs_Tv explicit_hs_tvs $ do { -- Instantiate the type-class context; but if there @@ -2497,38 +2504,23 @@ tcHsPartialSigType ctxt sig_ty ; return (wcs, wcx, theta, tau) } - -- We must return these separately, because all the zonking below - -- might change the name of a TyVarTv. This, in turn, causes trouble - -- in partial type signatures that bind scoped type variables, as - -- we bring the wrong name into scope in the function body. - -- Test case: partial-sigs/should_compile/LocalDefinitionBug - ; let tv_names = implicit_hs_tvs ++ hsLTyVarNames explicit_hs_tvs - -- 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] - ; emitWildCardHoleConstraints wcs + ; emitNamedWildCardHoleConstraints wcs - -- The TyVarTvs created above will sometimes have too high a TcLevel - -- (note that they are generated *after* bumping the level in - -- the tc{Im,Ex}plicitTKBndrsSig functions. Bumping the level - -- is still important here, because the kinds of these variables - -- do indeed need to have the higher level, so they can unify - -- with other local type variables. But, now that we've type-checked - -- everything (and solved equalities in the tcImplicit call) - -- we need to promote the TyVarTvs so we don't violate the TcLevel - -- invariant - ; implicit_tvs <- zonkAndScopedSort implicit_tvs - ; explicit_tvs <- mapM zonkAndSkolemise explicit_tvs - ; theta <- mapM zonkTcType theta - ; tau <- zonkTcType tau - - ; let all_tvs = implicit_tvs ++ explicit_tvs + -- We return a proper (Name,TyVar) environment, to be sure that + -- we bring the right name into scope in the function body. + -- Test case: partial-sigs/should_compile/LocalDefinitionBug + ; let tv_prs = (implicit_hs_tvs `zip` implicit_tvs) + ++ (hsLTyVarNames explicit_hs_tvs `zip` explicit_tvs) - ; checkValidType ctxt (mkSpecForAllTys all_tvs $ mkPhiTy theta tau) + -- 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 tuype to check - ; traceTc "tcHsPartialSigType" (ppr all_tvs) - ; return (wcs, wcx, tv_names, all_tvs, theta, tau) } + ; traceTc "tcHsPartialSigType" (ppr tv_prs) + ; return (wcs, wcx, tv_prs, theta, tau) } tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPartialSigType" tcHsPartialSigType _ (XHsWildCardBndrs _) = panic "tcHsPartialSigType" @@ -2538,14 +2530,43 @@ tcPartialContext hs_theta | Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta , L wc_loc wc@(HsWildCardTy _) <- ignoreParens hs_ctxt_last = do { wc_tv_ty <- setSrcSpan wc_loc $ - tcWildCardOcc wc constraintKind + tcAnonWildCardOcc wc constraintKind ; theta <- mapM tcLHsPredType hs_theta1 ; return (theta, Just wc_tv_ty) } | otherwise = do { theta <- mapM tcLHsPredType hs_theta ; return (theta, Nothing) } -{- Note [Extra-constraint holes in partial type signatures] +{- Note [Checking partial type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Recipe for checking a signature] + +When we have a parital signature like + f,g :: forall a. a -> _ +we do the following + +* In TcSigs.tcUserSigType we return a PartialSig, which (unlike + the companion CompleteSig) contains the original, as-yet-unchecked + source-code LHsSigWcType + +* Then, for f and g /separately/, we call tcInstSig, which in turn + call tchsPartialSig (defined near this Note). It kind-checks the + LHsSigWcType, creating fresh unification variables for each "_" + wildcard. It's important that the wildcards for f and g are distinct + becase they migh get instantiated completely differently. E.g. + f,g :: forall a. a -> _ + f x = a + g x = True + It's really as if we'd written two distinct signatures. + +* Note that we don't make quantified type (forall a. blah) and then + instantiate it -- it makes no sense to instantiate a type with + wildcards in it. Rather, tcHsPartialSigType just returns the + 'a' and the 'blah' separately. + + Nor, for the same reason, do we push a level in tcHsPartialSigType. + +Note [Extra-constraint holes in partial type signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: (_) => a -> a @@ -2614,12 +2635,12 @@ tcHsPatSigType ctxt sig_ty -- Always solve local equalities if possible, -- else casts get in the way of deep skolemisation -- (#16033) - tcWildCardBinders sig_wcs $ \ wcs -> + tcNamedWildCardBinders sig_wcs $ \ wcs -> tcExtendNameTyVarEnv sig_tkv_prs $ do { sig_ty <- tcHsOpenType hs_ty ; return (wcs, sig_ty) } - ; emitWildCardHoleConstraints wcs + ; emitNamedWildCardHoleConstraints wcs -- sig_ty might have tyvars that are at a higher TcLevel (if hs_ty -- contains a forall). Promote these. ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2437,8 +2437,8 @@ tcRnType hsc_env flexi normalise rdr_type ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) ; ((ty, kind), lie) <- captureTopConstraints $ - tcWildCardBinders wcs $ \ wcs' -> - do { emitWildCardHoleConstraints wcs' + tcNamedWildCardBinders wcs $ \ wcs' -> + do { emitNamedWildCardHoleConstraints wcs' ; tcLHsTypeUnsaturated rn_type } ; _ <- checkNoErrs (simplifyInteractive lie) ===================================== compiler/typecheck/TcRnMonad.hs ===================================== @@ -104,7 +104,8 @@ module TcRnMonad( pushTcLevelM_, pushTcLevelM, pushTcLevelsM, getTcLevel, setTcLevel, isTouchableTcM, getLclTypeEnv, setLclTypeEnv, - traceTcConstraints, emitWildCardHoleConstraints, + traceTcConstraints, + emitNamedWildCardHoleConstraints, emitAnonWildCardHoleConstraint, -- * Template Haskell context recordThUse, recordThSpliceUse, recordTopLevelSpliceLoc, @@ -1688,8 +1689,16 @@ traceTcConstraints msg hang (text (msg ++ ": LIE:")) 2 (ppr lie) } -emitWildCardHoleConstraints :: [(Name, TcTyVar)] -> TcM () -emitWildCardHoleConstraints wcs +emitAnonWildCardHoleConstraint :: TcTyVar -> TcM () +emitAnonWildCardHoleConstraint tv + = do { ct_loc <- getCtLocM HoleOrigin Nothing + ; emitInsolubles $ unitBag $ + CHoleCan { cc_ev = CtDerived { ctev_pred = mkTyVarTy tv + , ctev_loc = ct_loc } + , cc_hole = TypeHole (mkTyVarOcc "_") } } + +emitNamedWildCardHoleConstraints :: [(Name, TcTyVar)] -> TcM () +emitNamedWildCardHoleConstraints wcs = do { ct_loc <- getCtLocM HoleOrigin Nothing ; emitInsolubles $ listToBag $ map (do_one ct_loc) wcs } @@ -1702,7 +1711,7 @@ emitWildCardHoleConstraints wcs where real_span = case nameSrcSpan name of RealSrcSpan span -> span - UnhelpfulSpan str -> pprPanic "emitWildCardHoleConstraints" + UnhelpfulSpan str -> pprPanic "emitNamedWildCardHoleConstraints" (ppr name <+> quotes (ftext str)) -- Wildcards are defined locally, and so have RealSrcSpans ct_loc' = setCtLocSpan ct_loc real_span ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -1561,7 +1561,7 @@ data TcIdSigInst -- Extra-constraints wildcard to fill in, if any -- If this exists, it is surely of the form (meta_tv |> co) -- (where the co might be reflexive). This is filled in - -- only from the return value of TcHsType.tcWildCardOcc + -- only from the return value of TcHsType.tcAnonWildCardOcc } {- Note [sig_inst_tau may be polymorphic] ===================================== compiler/typecheck/TcSigs.hs ===================================== @@ -498,25 +498,14 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty , sig_loc = loc }) = setSrcSpan loc $ -- Set the binding site of the tyvars do { traceTc "Staring partial sig {" (ppr hs_sig) - ; (wcs, wcx, tv_names, tvs, theta, tau) <- tcHsPartialSigType ctxt hs_ty - - -- Clone the quantified tyvars - -- Reason: we might have f, g :: forall a. a -> _ -> a - -- and we want it to behave exactly as if there were - -- two separate signatures. Cloning here seems like - -- the easiest way to do so, and is very similar to - -- the tcInstType in the CompleteSig case - -- See #14643 - ; (subst, tvs') <- newMetaTyVarTyVars tvs - -- Why newMetaTyVarTyVars? See TcBinds - -- Note [Quantified variables in partial type signatures] - ; let tv_prs = tv_names `zip` tvs' - inst_sig = TISI { sig_inst_sig = hs_sig + ; (wcs, wcx, tv_prs, theta, tau) <- tcHsPartialSigType ctxt hs_ty + -- See Note [Checking partial type signatures] in TcHsType + ; let inst_sig = TISI { sig_inst_sig = hs_sig , sig_inst_skols = tv_prs , sig_inst_wcs = wcs , sig_inst_wcx = wcx - , sig_inst_theta = substTysUnchecked subst theta - , sig_inst_tau = substTyUnchecked subst tau } + , sig_inst_theta = theta + , sig_inst_tau = tau } ; traceTc "End partial sig }" (ppr inst_sig) ; return inst_sig } ===================================== compiler/typecheck/TcType.hs ===================================== @@ -1793,11 +1793,14 @@ hasTyVarHead ty -- Haskell 98 allows predicates of form Nothing -> False evVarPred :: EvVar -> PredType -evVarPred var - = ASSERT2( isEvVarType var_ty, ppr var <+> dcolon <+> ppr var_ty ) - var_ty - where - var_ty = varType var +evVarPred var = varType var + -- Historical note: I used to have an ASSERT here, + -- checking (isEvVarType (varType var)). But with something like + -- f :: c => _ -> _ + -- we end up with (c :: kappa), and (kappa ~ Constraint). Until + -- we solve and zonk (which there is no particular reason to do for + -- partial signatures, (isEvVarType kappa) will return False. But + -- nothing is wrong. So I just removed the ASSERT. ------------------ -- | When inferring types, should we quantify over a given predicate? ===================================== testsuite/tests/partial-sigs/should_compile/T16728.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Bug where + +import Data.Proxy + +f :: forall k (x :: k). Proxy (x :: _) +f = Proxy ===================================== testsuite/tests/partial-sigs/should_compile/T16728.stderr ===================================== @@ -0,0 +1,9 @@ + +T16728.hs:8:37: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘k’ + Where: ‘k’ is a rigid type variable bound by + the inferred type of f :: Proxy x + at T16728.hs:9:1-9 + • In the kind ‘_’ + In the first argument of ‘Proxy’, namely ‘(x :: _)’ + In the type ‘Proxy (x :: _)’ ===================================== testsuite/tests/partial-sigs/should_compile/T16728a.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExplicitForAll, PartialTypeSignatures #-} +module Bug where + +g,h:: forall a. a -> _ +g x = h x + +h x = g x \ No newline at end of file ===================================== testsuite/tests/partial-sigs/should_compile/T16728a.stderr ===================================== @@ -0,0 +1,20 @@ + +T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘_’ + Where: ‘_’ is a rigid type variable bound by + the inferred types of + g :: a -> _ + h :: a -> _ + at T16728a.hs:(5,1)-(7,9) + • In the type ‘a -> _’ + In the type signature: g :: forall a. a -> _ + +T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘_’ + Where: ‘_’ is a rigid type variable bound by + the inferred types of + g :: a -> _ + h :: a -> _ + at T16728a.hs:(5,1)-(7,9) + • In the type ‘a -> _’ + In the type signature: h :: forall a. a -> _ ===================================== testsuite/tests/partial-sigs/should_compile/T16728b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitForAll, PartialTypeSignatures #-} +module Bug where + +g,h:: forall a. a -> _ + +g x = x -- Instantiates the wildcard to 'a' + +h x = True -- Instantiates the wildcard to Bool \ No newline at end of file ===================================== testsuite/tests/partial-sigs/should_compile/T16728b.stderr ===================================== @@ -0,0 +1,13 @@ + +T16728b.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Bool’ + • In the type ‘a -> _’ + In the type signature: h :: forall a. a -> _ + +T16728b.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘a’ + Where: ‘a’ is a rigid type variable bound by + the inferred type of g :: a -> a + at T16728b.hs:6:1-7 + • In the type ‘a -> _’ + In the type signature: g :: forall a. a -> _ ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -92,3 +92,6 @@ test('T15039c', normal, compile, ['-fprint-equality-relations']) test('T15039d', normal, compile, ['-fprint-explicit-kinds -fprint-equality-relations']) test('T16334', normal, compile, ['']) +test('T16728', normal, compile, ['']) +test('T16728a', normal, compile, ['']) +test('T16728b', normal, compile, ['']) ===================================== testsuite/tests/partial-sigs/should_fail/T14040a.stderr ===================================== @@ -1,10 +1,10 @@ T14040a.hs:34:8: error: - • Cannot apply expression of type ‘Sing wl0 - -> (forall y. p0 _0 'WeirdNil) + • Cannot apply expression of type ‘Sing wl + -> (forall y. p _2 'WeirdNil) -> (forall z1 (x :: z1) (xs :: WeirdList (WeirdList z1)). - Sing x -> Sing xs -> p0 _1 xs -> p0 _2 ('WeirdCons x xs)) - -> p0 _3 wl0’ + Sing x -> Sing xs -> p _0 xs -> p _1 ('WeirdCons x xs)) + -> p _2 wl’ to a visible type argument ‘(WeirdList z)’ • In the sixth argument of ‘pWeirdCons’, namely ‘(elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons)’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb5f015c8b8ac508c5fae54db0537c2a03fbcbb7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bb5f015c8b8ac508c5fae54db0537c2a03fbcbb7 You're receiving 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 Jun 7 12:02:59 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Fri, 07 Jun 2019 08:02:59 -0400 Subject: [Git][ghc/ghc][wip/T16608] 17 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cfa52737dacf_6f73fe60466063c620332@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/T16608 at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 84c74da2 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Add tests for #16608 - - - - - 4747ee87 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Update expected outputs - - - - - fd234ff2 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Rename tidy->update - - - - - 90ab44c8 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Update - - - - - e9299465 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Remove redundant call to tidyTypeEnv - - - - - 16428426 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Refactoring - - - - - 9451f647 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Refactor globaliseAndTidyId - - - - - d1557649 by Ömer Sinan Ağacan at 2019-06-05T06:25:10Z Refactor mkBootModDetailsTc - - - - - cccdf3b0 by Simon Peyton Jones at 2019-06-05T06:25:10Z Finish off work on #16608 ...done by Simon PJ - - - - - 5cd53c78 by Ömer Sinan Ağacan at 2019-06-07T11:16:27Z Fix build - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/PatSyn.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreTidy.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/main/TidyPgm.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - + testsuite/driver/js/Chart-2.8.0.min.js - + testsuite/driver/js/tooltip.js - testsuite/driver/perf_notes.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - + testsuite/tests/driver/T16608/Makefile - + testsuite/tests/driver/T16608/MyInteger.hs - + testsuite/tests/driver/T16608/T16608_1.hs - + testsuite/tests/driver/T16608/T16608_1.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f8a2f86b8b605aa091383384400a04c3d27d51fc...5cd53c78616a5603ed11837b8d97a700600f32dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f8a2f86b8b605aa091383384400a04c3d27d51fc...5cd53c78616a5603ed11837b8d97a700600f32dc You're receiving 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 Jun 7 12:44:06 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 07 Jun 2019 08:44:06 -0400 Subject: [Git][ghc/ghc][wip/T16728] Comments and tiny refactor Message-ID: <5cfa5c164b91d_6f7d12ce806297e5@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 097558e6 by Simon Peyton Jones at 2019-06-07T12:41:18Z Comments and tiny refactor * Added Note [Quantified varaibles in partial type signatures] in TcRnTypes * Kill dVarSetElemsWellScoped; it was only called in one function, quantifyTyVars. I inlined it because it was only scopedSort . dVarSetElems * Kill Type.tyCoVarsOfBindersWellScoped, never called. - - - - - 3 changed files: - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnTypes.hs - compiler/types/Type.hs Changes: ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -1407,9 +1407,9 @@ quantifyTyVars gbl_tvs -- NB: All variables in the kind of a covar must not be -- quantified over, as we don't quantify over the covar. - dep_kvs = dVarSetElemsWellScoped $ + dep_kvs = scopedSort $ dVarSetElems $ dep_tkvs `dVarSetMinusVarSet` mono_tvs - -- dVarSetElemsWellScoped: put the kind variables into + -- scopedSort: put the kind variables into -- well-scoped order. -- E.g. [k, (a::k)] not the other way roud @@ -1427,7 +1427,7 @@ quantifyTyVars gbl_tvs -- This block uses level numbers to decide what to quantify -- and emits a warning if the two methods do not give the same answer - ; let dep_kvs2 = dVarSetElemsWellScoped $ + ; let dep_kvs2 = scopedSort $ dVarSetElems $ filterDVarSet (quantifiableTv outer_tclvl) dep_tkvs nondep_tvs2 = filter (quantifiableTv outer_tclvl) $ dVarSetElems (nondep_tkvs `minusDVarSet` dep_tkvs) ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -1542,6 +1542,10 @@ data TcIdSigInst -- No need to keep track of whether they are truly lexically -- scoped because the renamer has named them uniquely -- See Note [Binding scoped type variables] in TcSigs + -- + -- NB: The order of sig_inst_skols is irrelevant + -- for a CompleteSig, but for a PartialSig see + -- Note [Quantified varaibles in partial type signatures] , sig_inst_theta :: TcThetaType -- Instantiated theta. In the case of a @@ -1553,9 +1557,9 @@ data TcIdSigInst -- Relevant for partial signature only , sig_inst_wcs :: [(Name, TcTyVar)] - -- Like sig_inst_skols, but for wildcards. The named - -- wildcards scope over the binding, and hence their - -- Names may appear in type signatures in the binding + -- Like sig_inst_skols, but for /named/ wildcards (_a etc). + -- The named wildcards scope over the binding, and hence + -- their Names may appear in type signatures in the binding , sig_inst_wcx :: Maybe TcType -- Extra-constraints wildcard to fill in, if any @@ -1572,6 +1576,26 @@ if the original function had a signature like But that's ok: tcMatchesFun (called by tcRhs) can deal with that It happens, too! See Note [Polymorphic methods] in TcClassDcl. +Note [Quantified varaibles in partial type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f :: forall a b. _ -> a -> _ -> b + f (x,y) p q = q + +Then we expect f's final type to be + f :: forall {x,y}. forall a b. (x,y) -> a -> b -> b + +Note that x,y are Inferred, and can't be use for visible type +application (VTA). But a,b are Specified, and remain Specified +in the final type, so we can use VTA for them. (Exception: if +it turns out that a's kind mentions b we need to reorder them +with scopedSort.) + +The sig_inst_skols of the TISI from a partial signature records +that original order, and is used to get the variables of f's +final type in the correct order. + + Note [Wildcards in partial signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The wildcards in psig_wcs may stand for a type mentioning ===================================== compiler/types/Type.hs ===================================== @@ -156,8 +156,8 @@ module Type ( typeSize, occCheckExpand, -- * Well-scoped lists of variables - dVarSetElemsWellScoped, scopedSort, tyCoVarsOfTypeWellScoped, - tyCoVarsOfTypesWellScoped, tyCoVarsOfBindersWellScoped, + scopedSort, tyCoVarsOfTypeWellScoped, + tyCoVarsOfTypesWellScoped, -- * Type comparison eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX, @@ -2171,15 +2171,6 @@ scopedSort = go [] [] -- lists not in correspondence insert _ _ _ = panic "scopedSort" --- | Extract a well-scoped list of variables from a deterministic set of --- variables. The result is deterministic. --- NB: There used to exist varSetElemsWellScoped :: VarSet -> [Var] which --- took a non-deterministic set and produced a non-deterministic --- well-scoped list. If you care about the list being well-scoped you also --- most likely care about it being in deterministic order. -dVarSetElemsWellScoped :: DVarSet -> [Var] -dVarSetElemsWellScoped = scopedSort . dVarSetElems - -- | Get the free vars of a type in scoped order tyCoVarsOfTypeWellScoped :: Type -> [TyVar] tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList @@ -2188,12 +2179,6 @@ tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList --- | Given the suffix of a telescope, returns the prefix. --- Ex: given [(k :: j), (a :: Proxy k)], returns [(j :: *)]. -tyCoVarsOfBindersWellScoped :: [TyVar] -> [TyVar] -tyCoVarsOfBindersWellScoped tvs - = tyCoVarsOfTypeWellScoped (mkInvForAllTys tvs unitTy) - ------------- Closing over kinds ----------------- -- | Add the kind variables free in the kinds of the tyvars in the given set. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/097558e690aa3936226c5ca96d0c7a1a50b755b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/097558e690aa3936226c5ca96d0c7a1a50b755b5 You're receiving 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 Jun 7 13:25:21 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 09:25:21 -0400 Subject: [Git][ghc/ghc][wip/t16716] 18 commits: Fix and enforce validation of header for .hie files Message-ID: <5cfa65c1bf99c_6f7e95041c643155@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/t16716 at Glasgow Haskell Compiler / GHC Commits: 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - ae159d42 by Matthew Pickering at 2019-06-07T13:25:05Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/InteractiveEval.hs - compiler/prelude/PrelRules.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcForeign.hs - compiler/typecheck/TcRnDriver.hs - compiler/types/InstEnv.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ffi-chap.rst - docs/users_guide/ghci.rst - ghc.mk - ghc/GHCi/UI.hs - ghc/ghc.mk - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - libraries/base/GHC/Conc/Sync.hs - rts/sm/CNF.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6642f9716490eb6918c1768e1eb76be208775b7c...ae159d42eab21429d23f6f208b46a13f2fb59cb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6642f9716490eb6918c1768e1eb76be208775b7c...ae159d42eab21429d23f6f208b46a13f2fb59cb3 You're receiving 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 Jun 7 13:34:42 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 09:34:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-whitespace Message-ID: <5cfa67f2ef32c_6f73fe61a669adc6503f3@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/remove-whitespace at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/remove-whitespace You're receiving 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 Jun 7 13:34:57 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 09:34:57 -0400 Subject: [Git][ghc/ghc][wip/fix-linters] 49 commits: Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cfa680159cbe_6f73fe5f537a5e4650525@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/fix-linters at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 62a2f372 by Matthew Pickering at 2019-06-07T13:34:52Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - cf0088b3 by Matthew Pickering at 2019-06-07T13:34:52Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 4c3bb004 by Matthew Pickering at 2019-06-07T13:34:52Z Fix two lint failures in rts/linker/MachO.c - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/PPC/Instr.hs - compiler/prelude/PrelRules.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c8ccb0ea8e61bc92277017814fa7be99943d37b6...4c3bb004ca8e2222732f1883425de2ac90b43e92 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c8ccb0ea8e61bc92277017814fa7be99943d37b6...4c3bb004ca8e2222732f1883425de2ac90b43e92 You're receiving 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 Jun 7 14:12:46 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:12:46 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Add linting trace Message-ID: <5cfa70de98e45_6f73fe612464b90675682@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 395a62b9 by Matthew Pickering at 2019-06-07T14:12:29Z Add linting trace - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -53,6 +53,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + - echo "Linting changes between $CI_MERGE_REQUEST_TARGET_BRANCH_NAME..$CI_COMMIT_SHA" - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Merge base $base" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/395a62b930e7027068a976e627aa5019e2964646 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/395a62b930e7027068a976e627aa5019e2964646 You're receiving 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 Jun 7 14:17:14 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:17:14 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] another trace Message-ID: <5cfa71ea3d46f_6f79f76a446805a1@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 43f83dcc by Matthew Pickering at 2019-06-07T14:17:04Z another trace - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,12 +17,12 @@ before_script: stages: - lint # Source linting - - 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. - - hackage # head.hackage testing - - deploy # push documentation + # - 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. + #- hackage # head.hackage testing + #- deploy # push documentation .only-default: &only-default only: @@ -55,6 +55,7 @@ ghc-linters: script: - echo "Linting changes between $CI_MERGE_REQUEST_TARGET_BRANCH_NAME..$CI_COMMIT_SHA" - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git merge-base FETCH_HEAD $CI_COMMIT_SHA - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Merge base $base" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/43f83dccc1674dee8db386cd0c82697f4d39ea18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/43f83dccc1674dee8db386cd0c82697f4d39ea18 You're receiving 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 Jun 7 14:18:38 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:18:38 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] unbreak Message-ID: <5cfa723e2d82e_6f73fe5f6a2e6a0681430@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: d5a48832 by Matthew Pickering at 2019-06-07T14:18:32Z unbreak - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,12 +17,12 @@ before_script: stages: - lint # Source linting - # - 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. - #- hackage # head.hackage testing - #- deploy # push documentation + - 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. + - hackage # head.hackage testing + - deploy # push documentation .only-default: &only-default only: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d5a488320ca84ba725266e55b98eb899b7950a45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d5a488320ca84ba725266e55b98eb899b7950a45 You're receiving 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 Jun 7 14:20:06 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:20:06 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Disable darwin hadrian job Message-ID: <5cfa7296eb972_6f73fe5e1449344682112@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -280,7 +280,8 @@ validate-x86_64-darwin: - cabal-cache - toolchain -validate-x86_64-darwin-hadrian: +# Disabled because of OS X CI capacity +.validate-x86_64-darwin-hadrian: <<: *only-default stage: full-build tags: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/567894b49b9e8f5ced2d0e5f051f2a1d5c9f13e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/567894b49b9e8f5ced2d0e5f051f2a1d5c9f13e2 You're receiving 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 Jun 7 14:20:45 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:20:45 -0400 Subject: [Git][ghc/ghc][master] [skip ci] Improve the documentation of the CNF primops. In this context, the... Message-ID: <5cfa72bd3fae2_6f73fe5e14493446870fb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - 1 changed file: - compiler/prelude/primops.txt.pp Changes: ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2977,15 +2977,29 @@ primop StableNameToIntOp "stableNameToInt#" GenPrimOp ------------------------------------------------------------------------ section "Compact normal form" + + {Primitives for working with compact regions. The {\tt ghc\-compact} + library and the {\tt compact} library demonstrate how to use these + primitives. The documentation below draws a distinction between + a CNF and a compact block. A CNF contains one or more compact + blocks. The source file {\tt rts\/sm\/CNF.c} + diagrams this relationship. When discussing a compact + block, an additional distinction is drawn between capacity and + utilized bytes. The capacity is the maximum number of bytes that + the compact block can hold. The utilized bytes is the number of + bytes that are actually used by the compact block. + } + ------------------------------------------------------------------------ primtype Compact# primop CompactNewOp "compactNew#" GenPrimOp Word# -> State# RealWorld -> (# State# RealWorld, Compact# #) - { Create a new Compact with the given size (in bytes, not words). - The size is rounded up to a multiple of the allocator block size, - and capped to one mega block. } + { Create a new CNF with a single compact block. The argument is + the capacity of the compact block (in bytes, not words). + The capacity is rounded up to a multiple of the allocator block size + and is capped to one mega block. } with has_side_effects = True out_of_line = True @@ -2993,44 +3007,46 @@ primop CompactNewOp "compactNew#" GenPrimOp primop CompactResizeOp "compactResize#" GenPrimOp Compact# -> Word# -> State# RealWorld -> State# RealWorld - { Set the new allocation size of the compact. This value (in bytes) - determines the size of each block in the compact chain. } + { Set the new allocation size of the CNF. This value (in bytes) + determines the capacity of each compact block in the CNF. It + does not retroactively affect existing compact blocks in the CNF. } with has_side_effects = True out_of_line = True primop CompactContainsOp "compactContains#" GenPrimOp Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #) - { Returns 1\# if the object is contained in the compact, 0\# otherwise. } + { Returns 1\# if the object is contained in the CNF, 0\# otherwise. } with out_of_line = True primop CompactContainsAnyOp "compactContainsAny#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, Int# #) - { Returns 1\# if the object is in any compact at all, 0\# otherwise. } + { Returns 1\# if the object is in any CNF at all, 0\# otherwise. } with out_of_line = True primop CompactGetFirstBlockOp "compactGetFirstBlock#" GenPrimOp Compact# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) - { Returns the address and the size (in bytes) of the first block of - a compact. } + { Returns the address and the utilized size (in bytes) of the + first compact block of a CNF.} with out_of_line = True primop CompactGetNextBlockOp "compactGetNextBlock#" GenPrimOp Compact# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) - { Given a compact and the address of one its blocks, returns the - next block and its size, or #nullAddr if the argument was the - last block in the compact. } + { Given a CNF and the address of one its compact blocks, returns the + next compact block and its utilized size, or {\tt nullAddr\#} if the + argument was the last compact block in the CNF. } with out_of_line = True primop CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp Word# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #) - { Attempt to allocate a compact block with the given size (in - bytes, given by the first argument). The {\texttt Addr\#} is a pointer to - previous block of the compact or {\texttt nullAddr\#} to create a new compact. + { Attempt to allocate a compact block with the capacity (in + bytes) given by the first argument. The {\texttt Addr\#} is a pointer + to previous compact block of the CNF or {\texttt nullAddr\#} to create a + new CNF with a single compact block. The resulting block is not known to the GC until {\texttt compactFixupPointers\#} is called on it, and care must be taken @@ -3042,13 +3058,13 @@ primop CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Compact#, Addr# #) - { Given the pointer to the first block of a compact, and the + { Given the pointer to the first block of a CNF and the address of the root object in the old address space, fix up - the internal pointers inside the compact to account for + the internal pointers inside the CNF to account for a different position in memory than when it was serialized. This method must be called exactly once after importing - a serialized compact, and returns the new compact and - the new adjusted root address. } + a serialized CNF. It returns the new CNF and the new adjusted + root address. } with has_side_effects = True out_of_line = True @@ -3056,10 +3072,10 @@ primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp primop CompactAdd "compactAdd#" GenPrimOp Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #) { Recursively add a closure and its transitive closure to a - {\texttt Compact\#}, evaluating any unevaluated components at the - same time. Note: {\texttt compactAdd\#} is not thread-safe, so + {\texttt Compact\#} (a CNF), evaluating any unevaluated components + at the same time. Note: {\texttt compactAdd\#} is not thread-safe, so only one thread may call {\texttt compactAdd\#} with a particular - {\texttt Compact#} at any given time. The primop does not + {\texttt Compact\#} at any given time. The primop does not enforce any mutual exclusion; the caller is expected to arrange this. } with @@ -3076,7 +3092,8 @@ primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp primop CompactSize "compactSize#" GenPrimOp Compact# -> State# RealWorld -> (# State# RealWorld, Word# #) - { Return the size (in bytes) of the total amount of data in the Compact# } + { Return the total capacity (in bytes) of all the compact blocks + in the CNF. } with has_side_effects = True out_of_line = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d3915b304f297b8a2534f6abf9c2984837792921 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d3915b304f297b8a2534f6abf9c2984837792921 You're receiving 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 Jun 7 14:21:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:21:32 -0400 Subject: [Git][ghc/ghc][master] TmOracle: Replace negative term equalities by refutable PmAltCons Message-ID: <5cfa72ec77f0f_6f7e51c2b069078e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 15 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/utils/ListSetOps.hs - + testsuite/tests/pmcheck/should_compile/CyclicSubst.hs - + testsuite/tests/pmcheck/should_compile/PmExprVars.hs - + testsuite/tests/pmcheck/should_compile/T12949.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T5490.stderr Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -25,6 +25,7 @@ module NameEnv ( emptyDNameEnv, lookupDNameEnv, + delFromDNameEnv, mapDNameEnv, alterDNameEnv, -- ** Dependency analysis @@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM lookupDNameEnv :: DNameEnv a -> Name -> Maybe a lookupDNameEnv = lookupUDFM +delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a +delFromDNameEnv = delFromUDFM + mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b mapDNameEnv = mapUDFM ===================================== compiler/deSugar/Check.hs ===================================== @@ -25,6 +25,7 @@ module Check ( import GhcPrelude import TmOracle +import PmPpr import Unify( tcMatchTy ) import DynFlags import HsSyn @@ -579,7 +580,7 @@ pmTopNormaliseType_maybe env ty_cs typ pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do ty_cs <- liftD getDictsDs - tm_cs <- map toComplex . bagToList <$> liftD getTmCsDs + tm_cs <- bagToList <$> liftD getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -627,7 +628,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -653,7 +654,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> ComplexEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -1463,7 +1464,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: ComplexEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1660,7 +1661,7 @@ mkOneConFull x con = do strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (PmExprVar (idName x), vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } @@ -1678,21 +1679,15 @@ mkGuard pv e = do | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(False ~ (x ~ lit))` -mkNegEq :: Id -> PmLit -> ComplexEq -mkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l) -{-# INLINE mkNegEq #-} - -- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> ComplexEq -mkPosEq x l = (PmExprVar (idName x), PmExprLit l) +mkPosEq :: Id -> PmLit -> TmVarCt +mkPosEq x l = TVC x (PmExprLit l) {-# INLINE mkPosEq #-} -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> ComplexEq -mkIdEq x = (PmExprVar name, PmExprVar name) - where name = idName x +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type @@ -2059,8 +2054,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) - (PmExprVar (idName x), vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2122,7 +2116,8 @@ pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) ValVec vva (delta {delta_tm_cs = tm_state}) Nothing -> return mempty where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2142,7 +2137,8 @@ pmcheckHd (p@(PmLit l)) ps guards (ValVec vva (delta { delta_tm_cs = tm_state })) | otherwise = return non_matched where - us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l) + -- See Note [Refutable shapes] in TmOracle + us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] | otherwise = [] @@ -2407,22 +2403,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag SimpleEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2484,21 +2480,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) instance Outputable ValVec where ppr (ValVec vva delta) - = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in ppr_uncovered (vector, residual_eqs) + = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva + in pprUncovered (vector, refuts) -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) --- | Wrap up the term oracle's state once solving is complete. Drop any --- information about unhandled constraints (involving HsExprs) and flatten --- (height 1) the substitution. -wrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv) -wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) - -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result @@ -2538,10 +2528,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) - pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q + pprEqn q txt = pprContext True ctx (text txt) $ \f -> + f (pprPats kind (map unLoc q)) -- Print several clauses (for uncovered clauses) - pprEqns qs = pp_context False ctx (text "are non-exhaustive") $ \_ -> + pprEqns qs = pprContext False ctx (text "are non-exhaustive") $ \_ -> case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" @@ -2552,7 +2543,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for -- which we only know the type and have no inhabitants at hand) - warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> + warnEmptyCase ty = pprContext False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) {- Note [Inaccessible warnings for record updates] @@ -2624,8 +2615,8 @@ exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete pat -- incomplete -- True <==> singular -pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun +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)]] @@ -2639,87 +2630,10 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) _ -> (pprMatchContext kind, \ pp -> pp) -ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc -ppr_pats kind pats +pprPats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc +pprPats kind pats = sep [sep (map ppr pats), matchSeparator kind, text "..."] -ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc -ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn)) - -ppr_constraint :: (SDoc,[PmLit]) -> SDoc -ppr_constraint (var, lits) = var <+> text "is not one of" - <+> braces (pprWithCommas ppr lits) - -ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc -ppr_uncovered (expr_vec, complex) - | null cs = fsep vec -- there are no literal constraints - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map ppr_constraint cs) - where - sdoc_vec = mapM pprPmExprWithParens expr_vec - (vec,cs) = runPmPprM sdoc_vec (filterComplex complex) - -{- Note [Representation of Term Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the paper, term constraints always take the form (x ~ e). Of course, a more -general constraint of the form (e1 ~ e1) can always be transformed to an -equivalent set of the former constraints, by introducing a fresh, intermediate -variable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise -to #11160 (incredibly bad performance for literal pattern matching). Two are -the main sources of this problem (the actual problem is how these two interact -with each other): - -1. Pattern matching on literals generates twice as many constraints as needed. - Consider the following (tests/ghci/should_run/ghcirun004): - - foo :: Int -> Int - foo 1 = 0 - ... - foo 5000 = 4999 - - The covered and uncovered set *should* look like: - U0 = { x |> {} } - - C1 = { 1 |> { x ~ 1 } } - U1 = { x |> { False ~ (x ~ 1) } } - ... - C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } } - U10 = { x |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } } - ... - - If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) } - we get twice as many constraints. Also note that half of them are just the - substitution [x |-> False]. - -2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form - (x ~ e) as substitutions [x |-> e]. More specifically, function - `extendSubstAndSolve` applies such substitutions in the residual constraints - and partitions them in the affected and non-affected ones, which are the new - worklist. Essentially, this gives quadradic behaviour on the number of the - residual constraints. (This would not be the case if the term oracle used - mutable variables but, since we use it to handle disjunctions on value set - abstractions (`Union` case), we chose a pure, incremental interface). - -Now the problem becomes apparent (e.g. for clause 300): - * Set U300 contains 300 substituting constraints [y_i |-> False] and 300 - constraints that we know that will not reduce (stay in the worklist). - * To check for consistency, we apply the substituting constraints ONE BY ONE - (since `tmOracle` is called incrementally, it does not have all of them - available at once). Hence, we go through the (non-progressing) constraints - over and over, achieving over-quadradic behaviour. - -If instead we allow constraints of the form (e ~ e), - * All uncovered sets Ui contain no substituting constraints and i - non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle - behaves linearly. - * All covered sets Ci contain exactly (i-1) non-progressing constraints and - a single substituting constraint. So the term oracle goes through the - constraints only once. - -The performance improvement becomes even more important when more arguments are -involved. --} - -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () @@ -2757,3 +2671,5 @@ pprValAbs ps = hang (text "ValAbs:") 2 pprValVecDebug :: ValVec -> SDoc pprValVecDebug (ValVec vas _d) = text "ValVec" <+> parens (pprValAbs vas) + -- $$ ppr (delta_tm_cs _d) + -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag SimpleEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag SimpleEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -6,12 +6,11 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit, - truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther, - lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex, - pprPmExprWithParens, runPmPprM + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), + eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr ) where #include "HsVersions.h" @@ -23,19 +22,14 @@ import FastString (FastString, unpackFS) import HsSyn import Id import Name -import NameSet import DataCon import ConLike +import TcEvidence (isErasableHsWrapper) import TcType (isStringTy) import TysWiredIn import Outputable -import Util import SrcLoc -import Data.Maybe (mapMaybe) -import Data.List (groupBy, sortBy, nubBy) -import Control.Monad.Trans.State.Lazy - {- %************************************************************************ %* * @@ -61,7 +55,6 @@ refer to variables that are otherwise substituted away. data PmExpr = PmExprVar Name | PmExprCon ConLike [PmExpr] | PmExprLit PmLit - | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] @@ -79,6 +72,16 @@ eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 -- See Note [Undecidable Equality for Overloaded Literals] eqPmLit _ _ = False +-- | Represents a match against a literal. We mostly use it to to encode shapes +-- for a variable that immediately lead to a refutation. +-- +-- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. +newtype PmAltCon = PmAltLit PmLit + deriving Outputable + +instance Eq PmAltCon where + PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 + {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -145,24 +148,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} -nubPmLit :: [PmLit] -> [PmLit] -nubPmLit = nubBy eqPmLit +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr --- | Term equalities -type SimpleEq = (Id, PmExpr) -- We always use this orientation -type ComplexEq = (PmExpr, PmExpr) - --- | Lift a `SimpleEq` to a `ComplexEq` -toComplex :: SimpleEq -> ComplexEq -toComplex (x,e) = (PmExprVar (idName x), e) - --- | Expression `True' -truePmExpr :: PmExpr -truePmExpr = mkPmExprData trueDataCon [] - --- | Expression `False' -falsePmExpr :: PmExpr -falsePmExpr = mkPmExprData falseDataCon [] +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -172,66 +162,6 @@ isNotPmExprOther :: PmExpr -> Bool isNotPmExprOther (PmExprOther _) = False isNotPmExprOther _expr = True --- | Check whether a literal is negated -isNegatedPmLit :: PmLit -> Bool -isNegatedPmLit (PmOLit b _) = b -isNegatedPmLit _other_lit = False - --- | Check whether a PmExpr is syntactically equal to term `True'. -isTruePmExpr :: PmExpr -> Bool -isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon -isTruePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to term `False'. -isFalsePmExpr :: PmExpr -> Bool -isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon -isFalsePmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - --- | Check whether a PmExpr is syntactically equal to (x == y). --- Since (==) is overloaded and can have an arbitrary implementation, we use --- the PmExprEq constructor to represent only equalities with non-overloaded --- literals where it coincides with a syntactic equality check. -isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr) -isPmExprEq (PmExprEq e1 e2) = Just (e1,e2) -isPmExprEq _other_expr = Nothing - --- | Check if a DataCon is (:). -isConsDataCon :: DataCon -> Bool -isConsDataCon con = consDataCon == con - --- ---------------------------------------------------------------------------- --- ** Substitution in PmExpr - --- | We return a boolean along with the expression. Hence, if substitution was --- a no-op, we know that the expression still cannot progress. -substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool) -substPmExpr x e1 e = - case e of - PmExprVar z | x == z -> (e1, True) - | otherwise -> (e, False) - PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps - in (PmExprCon c ps', or bs) - PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex - (ey', by) = substPmExpr x e1 ey - in (PmExprEq ex' ey', bx || by) - _other_expr -> (e, False) -- The rest are terminals (We silently ignore - -- Other). See Note [PmExprOther in PmExpr] - --- | Substitute in a complex equality. We return (Left eq) if the substitution --- affected the equality or (Right eq) if nothing happened. -substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq -substComplexEq x e (ex, ey) - | bx || by = Left (ex', ey') - | otherwise = Right (ex', ey') - where - (ex', bx) = substPmExpr x e ex - (ey', by) = substPmExpr x e ey - -- ----------------------------------------------------------------------- -- ** Lift source expressions (HsExpr Id) to PmExpr @@ -240,8 +170,20 @@ lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e hsExprToPmExpr :: HsExpr GhcTc -> PmExpr +-- Translating HsVar to flexible meta variables in the unification problem is +-- morally wrong, but it does the right thing for now. +-- In contrast to the situation in pattern matches, HsVars in expression syntax +-- are object language variables, most similar to rigid variables with an +-- unknown solution. The correct way would be to handle them through PmExprOther +-- and identify syntactically equal occurrences by the same rigid meta variable, +-- but we can't compare the wrapped HsExpr for equality. Hence we are stuck with +-- this hack. hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) -hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) + +-- Translating HsConLikeOut to a flexible meta variable is misleading. +-- For an example why, consider `consAreRigid` in +-- `testsuite/tests/pmcheck/should_compile/PmExprVars.hs`. +-- hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c) -- Desugar literal strings as a list of characters. For other literal values, -- keep it as it is. @@ -294,7 +236,12 @@ hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsSCC _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (HsCoreAnn _ _ _ e) = lhsExprToPmExpr e hsExprToPmExpr (ExprWithTySig _ e _) = lhsExprToPmExpr e -hsExprToPmExpr (HsWrap _ _ e) = hsExprToPmExpr e +hsExprToPmExpr (HsWrap _ w e) + -- A dictionary application spoils e and we have no choice but to return an + -- PmExprOther. Same thing for other stuff that can't erased in the + -- compilation process. Otherwise this bites in + -- teststuite/tests/pmcheck/should_compile/PmExprVars.hs. + | isErasableHsWrapper w = hsExprToPmExpr e hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle stringExprToList :: SourceText -> FastString -> PmExpr @@ -312,155 +259,22 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) %************************************************************************ -} -{- 1. Literals -~~~~~~~~~~~~~~ -Starting with a function definition like: - - f :: Int -> Bool - f 5 = True - f 6 = True - -The uncovered set looks like: - { var |> False == (var == 5), False == (var == 6) } - -Yet, we would like to print this nicely as follows: - x , where x not one of {5,6} - -Function `filterComplex' takes the set of residual constraints and packs -together the negative constraints that refer to the same variable so we can do -just this. Since these variables will be shown to the programmer, we also give -them better names (t1, t2, ..), hence the SDoc in PmNegLitCt. - -2. Residual Constraints -~~~~~~~~~~~~~~~~~~~~~~~ -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 -Check.hs) to be more precice. --} - --- ----------------------------------------------------------------------------- --- ** Transform residual constraints in appropriate form for pretty printing - -type PmNegLitCt = (Name, (SDoc, [PmLit])) - -filterComplex :: [ComplexEq] -> [PmNegLitCt] -filterComplex = zipWith rename nameList . map mkGroup - . groupBy name . sortBy order . mapMaybe isNegLitCs - where - order x y = compare (fst x) (fst y) - name x y = fst x == fst y - mkGroup l = (fst (head l), nubPmLit $ map snd l) - rename new (old, lits) = (old, (new, lits)) - - isNegLitCs (e1,e2) - | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y - | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y - | otherwise = Nothing - - isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l) - isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l) - isNegLitCs' _ _ = Nothing - - -- 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)..] ] - --- ---------------------------------------------------------------------------- - -runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])]) -runPmPprM m lit_env = (result, mapMaybe is_used lit_env) - where - (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) - - is_used (x,(name, lits)) - | elemNameSet x used = Just (name, lits) - | otherwise = Nothing - -type PmPprM a = State ([PmNegLitCt], NameSet) a --- (the first part of the state is read only. make it a reader?) - -addUsed :: Name -> PmPprM () -addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) - -checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated -checkNegation x = do - negated <- gets fst - return $ case lookup x negated of - Just (new, _) -> Just new - Nothing -> Nothing - --- | Pretty print a pmexpr, but remember to prettify the names of the variables --- that refer to neg-literals. The ones that cannot be shown are printed as --- underscores. -pprPmExpr :: PmExpr -> PmPprM SDoc -pprPmExpr (PmExprVar x) = do - mb_name <- checkNegation x - case mb_name of - Just name -> addUsed x >> return name - Nothing -> return underscore - -pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) -pprPmExpr (PmExprEq _ _) = return underscore -- don't show -pprPmExpr (PmExprOther _) = return underscore -- don't show - -needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprEq {}) = False -- will become a wildcard -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) - -pprPmExprWithParens :: PmExpr -> PmPprM SDoc -pprPmExprWithParens expr - | needsParens expr = parens <$> pprPmExpr expr - | otherwise = pprPmExpr expr - -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args - | conLikeIsInfix cl = case args of - [x, y] -> do x' <- pprPmExprWithParens x - y' <- pprPmExprWithParens y - return (x' <+> ppr cl <+> y') - -- can it be infix but have more than two arguments? - list -> pprPanic "pprPmExprCon:" (ppr list) - | null args = return (ppr cl) - | otherwise = do args' <- mapM pprPmExprWithParens args - return (fsep (ppr cl : args')) - instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l --- not really useful for pmexprs per se instance Outputable PmExpr where - ppr e = fst $ runPmPprM (pprPmExpr e) [] + ppr = go (0 :: Int) + where + go _ (PmExprLit l) = ppr l + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (PmExprCon (RealDataCon dc) args) + | isTupleDataCon dc = parens $ comma_sep $ map ppr args + | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) + where + comma_sep = fsep . punctuate comma + list_cells (hd:tl) = hd : list_cells tl + list_cells _ = [] + go prec (PmExprCon cl args) + = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} + +-- | Provides factilities for pretty-printing 'PmExpr's in a way approriate for +-- user facing pattern match warnings. +module PmPpr ( + pprUncovered + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import Name +import NameEnv +import NameSet +import UniqDFM +import UniqSet +import ConLike +import DataCon +import TysWiredIn +import Outputable +import Control.Monad.Trans.State.Strict +import Maybes +import Util + +import TmOracle + +-- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its +-- components and refutable shapes associated to any mentioned variables. +-- +-- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]]): +-- +-- @ +-- (Just p) q +-- where p is not one of {3, 4} +-- q is not one of {0, 5} +-- @ +pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc +pprUncovered (expr_vec, refuts) + | null cs = fsep vec -- there are no literal constraints + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map pprRefutableShapes cs) + where + sdoc_vec = mapM pprPmExprWithParens expr_vec + (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) + +-- | Output refutable shapes of a variable in the form of @var is not one of {2, +-- Nothing, 3}@. +pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc +pprRefutableShapes (var, alts) + = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + where + ppr_alt (PmAltLit lit) = ppr lit + +{- 1. Literals +~~~~~~~~~~~~~~ +Starting with a function definition like: + + f :: Int -> Bool + f 5 = True + f 6 = True + +The uncovered set looks like: + { var |> var /= 5, var /= 6 } + +Yet, we would like to print this nicely as follows: + x , where x not one of {5,6} + +Since these variables will be shown to the programmer, we give them better names +(t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'. + +2. Residual Constraints +~~~~~~~~~~~~~~~~~~~~~~~ +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 +Check.hs) to be more precise. +-} + +-- | A 'PmRefutEnv' with pretty names for the occuring variables. +type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) + +-- | Assigns pretty names to constraint variables in the domain of the given +-- 'PmRefutEnv'. +prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv +prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList + where + rename new (old, lits) = (old, (new, lits)) + -- 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)..] ] + +type PmPprM a = State (PrettyPmRefutEnv, NameSet) a +-- (the first part of the state is read only. make it a reader?) + +runPmPpr :: PmPprM a -> PrettyPmRefutEnv -> (a, [(SDoc,[PmAltCon])]) +runPmPpr m lit_env = (result, mapMaybe is_used (udfmToList lit_env)) + where + (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet) + + is_used (k,v) + | elemUniqSet_Directly k used = Just v + | otherwise = Nothing + +addUsed :: Name -> PmPprM () +addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x)) + +checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated +checkNegation x = do + negated <- gets fst + return $ case lookupDNameEnv negated x of + Just (new, _) -> Just new + Nothing -> Nothing + +-- | Pretty print a pmexpr, but remember to prettify the names of the variables +-- that refer to neg-literals. The ones that cannot be shown are printed as +-- underscores. +pprPmExpr :: PmExpr -> PmPprM SDoc +pprPmExpr (PmExprVar x) = do + mb_name <- checkNegation x + case mb_name of + Just name -> addUsed x >> return name + Nothing -> return underscore +pprPmExpr (PmExprCon con args) = pprPmExprCon con args +pprPmExpr (PmExprLit l) = return (ppr l) +pprPmExpr (PmExprOther _) = return underscore -- don't show + +needsParens :: PmExpr -> Bool +needsParens (PmExprVar {}) = False +needsParens (PmExprLit l) = isNegatedPmLit l +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (RealDataCon c) es) + | isTupleDataCon c + || isConsDataCon c || null es = False + | otherwise = True +needsParens (PmExprCon (PatSynCon _) es) = not (null es) + +pprPmExprWithParens :: PmExpr -> PmPprM SDoc +pprPmExprWithParens expr + | needsParens expr = parens <$> pprPmExpr expr + | otherwise = pprPmExpr expr + +pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (RealDataCon con) args + | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args + | isConsDataCon con = pretty_list + where + mkTuple :: [SDoc] -> SDoc + mkTuple = parens . fsep . punctuate comma + + -- lazily, to be used in the list case only + pretty_list :: PmPprM SDoc + pretty_list = case isNilPmExpr (last list) of + True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) + False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list + + list = list_elements args + + list_elements [x,y] + | PmExprCon c es <- y, RealDataCon nilDataCon == c + = ASSERT(null es) [x,y] + | PmExprCon c es <- y, RealDataCon consDataCon == c + = x : list_elements es + | otherwise = [x,y] + list_elements list = pprPanic "list_elements:" (ppr list) +pprPmExprCon cl args + | conLikeIsInfix cl = case args of + [x, y] -> do x' <- pprPmExprWithParens x + y' <- pprPmExprWithParens y + return (x' <+> ppr cl <+> y') + -- can it be infix but have more than two arguments? + list -> pprPanic "pprPmExprCon:" (ppr list) + | null args = return (ppr cl) + | otherwise = do args' <- mapM pprPmExprWithParens args + return (fsep (ppr cl : args')) + +-- | Check whether a literal is negated +isNegatedPmLit :: PmLit -> Bool +isNegatedPmLit (PmOLit b _) = b +isNegatedPmLit _other_lit = False + +-- | Check whether a PmExpr is syntactically e +isNilPmExpr :: PmExpr -> Bool +isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon +isNilPmExpr _other_expr = False + +-- | Check if a DataCon is (:). +isConsDataCon :: DataCon -> Bool +isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -1,23 +1,27 @@ {- Author: George Karachalias - -The term equality oracle. The main export of the module is function `tmOracle'. -} {-# LANGUAGE CPP, MultiWayIf #-} +-- | The term equality oracle. The main export of the module are the functions +-- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- +-- If you are looking for an oracle that can solve type-level constraints, look +-- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( -- re-exported from PmExpr - PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr, - eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr, - hsExprToPmExpr, pprPmExprWithParens, + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), TmVarCtEnv, + PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, -- the term oracle - tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge, + tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, + extendSubst, canDiverge, isRigid, + addSolveRefutableAltCon, lookupRefutableAltCons, -- misc. - toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv + exprDeepLookup, pmLitType ) where #include "HsVersions.h" @@ -26,16 +30,19 @@ import GhcPrelude import PmExpr +import Util import Id import Name import Type import HsLit import TcHsSyn import MonadUtils -import Util +import ListSetOps (insertNoDup, unionLists) +import Maybes import Outputable - import NameEnv +import UniqFM +import UniqDFM {- %************************************************************************ @@ -45,202 +52,261 @@ import NameEnv %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr + +-- | An environment assigning shapes to variables that immediately lead to a +-- refutation. So, if this maps @x :-> [3]@, then trying to solve a 'TmVarCt' +-- like @x ~ 3@ immediately leads to a contradiction. +-- Determinism is important since we use this for warning messages in +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain +-- 'NameEnv'. +-- +-- See also Note [Refutable shapes] in TmOracle. +type PmRefutEnv = DNameEnv [PmAltCon] + +-- | The state of the term oracle. Tracks all term-level facts of the form "x is +-- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). +-- +-- Subject to Note [The Pos/Neg invariant]. +data TmState = TmS + { tm_pos :: !TmVarCtEnv + -- ^ A substitution with solutions we extend with every step and return as a + -- result. The substitution is in /triangular form/: It might map @x@ to @y@ + -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup + -- non-idempotent. This means that 'varDeepLookup' potentially has to walk + -- along a chain of var-to-var mappings until we find the solution but has the + -- advantage that when we update the solution for @y@ above, we automatically + -- update the solution for @x@ in a union-find-like fashion. + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprLit', 'PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv + -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely + -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal + -- 3 or 4. Should we later solve @x@ to a variable @y@ + -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of + -- @y at . See also Note [The Pos/Neg invariant]. + } + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. + +For example, it would make no sense to say both + tm_pos = [...x :-> 3 ...] + tm_neg = [...x :-> [4,42]... ] +The positive information is strictly more informative than the negative. + +Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must +delete any binding for @x@ from 'tm_neg', to uphold the invariant. + +But there is more! Suppose we are adding @x :-> y@ to 'tm_pos', and 'tm_neg' +contains @x :-> cs, y :-> ds at . Then we want to update 'tm_neg' to + at y :-> (cs ++ ds)@, to make use of the negative information we have about @x at . +-} + +instance Outputable TmState where + ppr state = braces (fsep (punctuate comma (pos ++ neg))) + where + pos = map pos_eq (nonDetUFMToList (tm_pos state)) + neg = map neg_eq (udfmToList (tm_neg state)) + pos_eq (l, r) = ppr l <+> char '~' <+> ppr r + neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + +-- | Initial state of the oracle. +initialTmState :: TmState +initialTmState = TmS emptyNameEnv emptyDNameEnv + +-- | Wrap up the term oracle's state once solving is complete. Return the +-- flattened 'tm_pos' and 'tm_neg'. +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) +wrapUpTmState solver_state + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) --- | The environment of the oracle contains --- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). --- 2. A substitution we extend with every step and return as a result. -type TmOracleEnv = (Bool, PmVarEnv) +-- | Flatten the triangular subsitution. +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. canDiverge :: Name -> TmState -> Bool -canDiverge x (standby, (_unhandled, env)) +canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- If the variable seems not evaluated, there is a possibility for - -- constraint x ~ BOT to be satisfiable. - | PmExprVar y <- varDeepLookup env x -- seems not forced - -- If it is involved (directly or indirectly) in any equality in the - -- worklist, we can assume that it is already indirectly evaluated, - -- as a side-effect of equality checking. If not, then we can assume - -- that the constraint is satisfiable. - = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby - -- Variable x is already in WHNF so the constraint is non-satisfiable + -- constraint x ~ BOT to be satisfiable. That's the case when we haven't found + -- a solution (i.e. some equivalent literal or constructor) for it yet. + | (_, PmExprVar y) <- varDeepLookup pos x -- seems not forced + -- Even if we don't have a solution yet, it might be involved in a negative + -- constraint, in which case we must already have evaluated it earlier. + , Nothing <- lookupDNameEnv neg y + = True + -- Variable x is already in WHNF or we know some refutable shape, so the + -- constraint is non-satisfiable | otherwise = False - where - isForcedByEq :: Name -> ComplexEq -> Bool - isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2 - --- | Check whether a variable is in the free variables of an expression -varIn :: Name -> PmExpr -> Bool -varIn x e = case e of - PmExprVar y -> x == y - PmExprCon _ es -> any (x `varIn`) es - PmExprLit _ -> False - PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2) - PmExprOther _ -> False - --- | Flatten the DAG (Could be improved in terms of performance.). -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env - --- | The state of the term oracle (includes complex constraints that cannot --- progress unless we get more information). -type TmState = ([ComplexEq], TmOracleEnv) - --- | Initial state of the oracle. -initialTmState :: TmState -initialTmState = ([], (False, emptyNameEnv)) - --- | Solve a complex equality (top-level). -solveOneEq :: TmState -> ComplexEq -> Maybe TmState -solveOneEq solver_env@(_,(_,env)) complex - = solveComplexEq solver_env -- do the actual *merging* with existing state - $ simplifyComplexEq -- simplify as much as you can - $ applySubstComplexEq env complex -- replace everything we already know - --- | Solve a complex equality. --- Nothing => definitely unsatisfiable --- Just tms => I have added the complex equality and added --- it to the tmstate; the result may or may not be --- satisfiable -solveComplexEq :: TmState -> ComplexEq -> Maybe TmState -solveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of +-- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that +-- @x@ and @e@ are completely substituted before! +isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool +isRefutable x e env + = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x + +-- | Solve an equality (top-level). +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) + +exprToAlt :: PmExpr -> Maybe PmAltCon +exprToAlt (PmExprLit l) = Just (PmAltLit l) +exprToAlt _ = Nothing + +-- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the +-- 'TmState' and return @Nothing@ if that leads to a contradiction. +addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt + = case exprToAlt e of + -- We have to take care to preserve Note [The Pos/Neg invariant] + Nothing -> Just extended -- Not solved yet + Just alt -- We have a solution + | alt == nalt -> Nothing -- ... which is contradictory + | otherwise -> Just original -- ... which is compatible, rendering the + where -- refutation redundant + (y, e) = varDeepLookup pos (idName x) + extended = original { tm_neg = neg' } + neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + +-- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter +-- intends to provide a suitable interface for 'alterDNameEnv'. +delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] +delNulls f mb_entry + | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret + | otherwise = Nothing + +-- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. +-- would immediately lead to a refutation by the term oracle. +lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] +lookupRefutableAltCons x TmS { tm_neg = neg } + = fromMaybe [] (lookupDNameEnv neg (idName x)) + +-- | Is the given variable /rigid/ (i.e., we have a solution for it) or +-- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A +-- semantically helpful alias for 'lookupNameEnv'. +isRigid :: TmState -> Name -> Maybe PmExpr +isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x + +-- | @isFlexible tms = isNothing . 'isRigid' tms@ +isFlexible :: TmState -> Name -> Bool +isFlexible tms = isNothing . isRigid tms + +-- | Try to unify two 'PmExpr's and record the gained knowledge in the +-- 'TmState'. +-- +-- Returns @Nothing@ when there's a contradiction. Returns @Just tms@ +-- when the constraint was compatible with prior facts, in which case @tms@ has +-- integrated the knowledge from the equality constraint. +unify :: TmState -> (PmExpr, PmExpr) -> Maybe TmState +unify tms eq@(e1, e2) = case eq of -- We cannot do a thing about these cases - (PmExprOther _,_) -> Just (standby, (True, env)) - (_,PmExprOther _) -> Just (standby, (True, env)) + (PmExprOther _,_) -> boring + (_,PmExprOther _) -> boring (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of -- See Note [Undecidable Equality for Overloaded Literals] - True -> Just solver_state - False -> Nothing + True -> boring + False -> unsat (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> foldlM solveComplexEq solver_state (zip ts1 ts2) - | otherwise -> Nothing - (PmExprCon _ [], PmExprEq t1 t2) - | isTruePmExpr e1 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env)) - (PmExprEq t1 t2, PmExprCon _ []) - | isTruePmExpr e2 -> solveComplexEq solver_state (t1, t2) - | isFalsePmExpr e2 -> Just (eq:standby, (unhandled, env)) + | c1 == c2 -> foldlM unify tms (zip ts1 ts2) + | otherwise -> unsat (PmExprVar x, PmExprVar y) - | x == y -> Just solver_state - | otherwise -> extendSubstAndSolve x e2 solver_state - - (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state - (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state - - (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env)) - - _ -> WARN( True, text "solveComplexEq: Catch all" <+> ppr eq ) - Just (standby, (True, env)) -- I HATE CATCH-ALLS - --- | Extend the substitution and solve the (possibly updated) constraints. -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e (standby, (unhandled, env)) - = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed) + | x == y -> boring + + -- It's important to handle both rigid cases first, otherwise we get cyclic + -- substitutions. Cf. 'extendSubstAndSolve' and + -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . + (PmExprVar x, _) + | Just e1' <- isRigid tms x -> unify tms (e1', e2) + (_, PmExprVar y) + | Just e2' <- isRigid tms y -> unify tms (e1, e2') + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms + + _ -> WARN( True, text "unify: Catch all" <+> ppr eq) + boring -- I HATE CATCH-ALLS + where + boring = Just tms + unsat = Nothing + +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' where - -- Apply the substitution to the worklist and partition them to the ones - -- that had some progress and the rest. Then, recurse over the ones that - -- had some progress. Careful about performance: - -- See Note [Representation of Term Equalities] in deSugar/Check.hs - (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + nalts = fromMaybe [] (lookupDNameEnv neg x) + neg' = alterDNameEnv (delNulls (unionLists nalts)) neg y + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + +-- | Extend the substitution with a mapping @x: -> e@ if compatible with +-- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. +-- +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a 'PmExprCon' or 'PmExprLit' +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } + | ASSERT( isFlexible _tms x ) + ASSERT( _is_whnf e ) + isRefutable x e neg + = Nothing + | otherwise + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) + where + _is_whnf PmExprCon{} = True + _is_whnf PmExprLit{} = True + _is_whnf _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, --- `extendSubst` simply extends the substitution, unlike what --- `extendSubstAndSolve` does. +-- @extendSubst@ simply extends the substitution, unlike what +-- 'extendSubstAndSolve' does. extendSubst :: Id -> PmExpr -> TmState -> TmState -extendSubst y e (standby, (unhandled, env)) +extendSubst y e solver_state at TmS{ tm_pos = pos } | isNotPmExprOther simpl_e - = (standby, (unhandled, extendNameEnv env x simpl_e)) - | otherwise = (standby, (True, env)) + = solver_state { tm_pos = extendNameEnv pos x simpl_e } + | otherwise = solver_state where x = idName y - simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e - --- | Simplify a complex equality. -simplifyComplexEq :: ComplexEq -> ComplexEq -simplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2) - --- | Simplify an expression. The boolean indicates if there has been any --- simplification or if the operation was a no-op. -simplifyPmExpr :: PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyPmExpr e = case e of - PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of - (ts', bs) -> (PmExprCon c ts', or bs) - PmExprEq t1 t2 -> simplifyEqExpr t1 t2 - _other_expr -> (e, False) -- the others are terminals - --- | Simplify an equality expression. The equality is given in parts. -simplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool) --- See Note [Deep equalities] -simplifyEqExpr e1 e2 = case (e1, e2) of - -- Varables - (PmExprVar x, PmExprVar y) - | x == y -> (truePmExpr, True) - - -- Literals - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> (truePmExpr, True) - False -> (falsePmExpr, True) - - -- Can potentially be simplified - (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of - ((e1', True ), (e2', _ )) -> simplifyEqExpr e1' e2' - ((e1', _ ), (e2', True )) -> simplifyEqExpr e1' e2' - ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress - - -- Constructors - (PmExprCon c1 ts1, PmExprCon c2 ts2) - | c1 == c2 -> - let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1 - (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2 - (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2' - worst_case = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2') - in if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress - | all isTruePmExpr tss -> (truePmExpr, True) - | any isFalsePmExpr tss -> (falsePmExpr, True) - | otherwise -> (worst_case, False) - | otherwise -> (falsePmExpr, True) - - -- We cannot do anything about the rest.. - _other_equality -> (original, False) - - where - original = PmExprEq e1 e2 -- reconstruct equality - --- | Apply an (un-flattened) substitution to a simple equality. -applySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq -applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) - --- | Apply an (un-flattened) substitution to a variable. -varDeepLookup :: PmVarEnv -> Name -> PmExpr -varDeepLookup env x - | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper - | otherwise = PmExprVar x -- terminal + simpl_e = exprDeepLookup pos e + +-- | Apply an (un-flattened) substitution to a variable and return its +-- representative in the triangular substitution @env@ and the completely +-- substituted expression. The latter may just be the representative wrapped +-- with 'PmExprVar' if we haven't found a solution for it yet. +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) +varDeepLookup env x = case lookupNameEnv env x of + Just (PmExprVar y) -> varDeepLookup env y + Just e -> (x, exprDeepLookup env e) -- go deeper + Nothing -> (x, PmExprVar x) -- terminal {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr -exprDeepLookup env (PmExprVar x) = varDeepLookup env x +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr +exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1) - (exprDeepLookup env e2) exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther -- | External interface to the term oracle. -tmOracle :: TmState -> [ComplexEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -248,18 +314,49 @@ pmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :( pmLitType (PmSLit lit) = hsLitType lit pmLitType (PmOLit _ lit) = overLitType lit -{- Note [Deep equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving nested equalities is the most difficult part. The general strategy -is the following: +{- Note [Refutable shapes] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Consider a pattern match like + + foo x + | 0 <- x = 42 + | 0 <- x = 43 + | 1 <- x = 44 + | otherwise = 45 + +This will result in the following initial matching problem: + + PatVec: x (0 <- x) + ValVec: $tm_y + +Where the first line is the pattern vector and the second line is the value +vector abstraction. When we handle the first pattern guard in Check, it will be +desugared to a match of the form + + PatVec: x 0 + ValVec: $tm_y x + +In LitVar, this will split the value vector abstraction for `x` into a positive +`PmLit 0` and a negative `PmLit x [0]` value abstraction. While the former is +immediately matched against the pattern vector, the latter (vector value +abstraction `~[0] $tm_y`) is completely uncovered by the clause. + +`pmcheck` proceeds by *discarding* the the value vector abstraction involving +the guard to accomodate for the desugaring. But this also discards the valuable +information that `x` certainly is not the literal 0! Consequently, we wouldn't +be able to report the second clause as redundant. - * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just - (e1 ~ e2) and then treated recursively. +That's a typical example of why we need the term oracle, and in this specific +case, the ability to encode that `x` certainly is not the literal 0. Now the +term oracle can immediately refute the constraint `x ~ 0` generated by the +second clause and report the clause as redundant. After the third clause, the +set of such *refutable* literals is again extended to `[0, 1]`. - * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless - we know more about the inner equality (e1 ~ e2). That's exactly what - `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns - truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note - that it is not e but rather e', since it may perform some - simplifications deeper. +In general, we want to store a set of refutable shapes (`PmAltCon`) for each +variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will +add such a refutable mapping to the `PmRefutEnv` in the term oracles state and +check if causes any immediate contradiction. Whenever we record a solution in +the substitution via `extendSubstAndSolve`, the refutable environment is checked +for any matching refutable `PmAltCon`. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -327,6 +327,7 @@ Library MkCore PprCore PmExpr + PmPpr TmOracle Check Coverage ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -8,7 +8,8 @@ module TcEvidence ( HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders, - mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper, + mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, isErasableHsWrapper, + pprHsWrapper, -- Evidence bindings TcEvBinds(..), EvBindsVar(..), @@ -355,6 +356,21 @@ isIdHsWrapper :: HsWrapper -> Bool isIdHsWrapper WpHole = True isIdHsWrapper _ = False +-- | Is the wrapper erasable, i.e., will not affect runtime semantics? +isErasableHsWrapper :: HsWrapper -> Bool +isErasableHsWrapper = go + where + go WpHole = True + go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2 + -- not so sure about WpFun. But it eta-expands, so... + go WpFun{} = False + go WpCast{} = True + go WpEvLam{} = False -- case in point + go WpEvApp{} = False + go WpTyLam{} = True + go WpTyApp{} = True + go WpLet{} = False + collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, -- stopping as soon as you get to a non-lambda binder ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag SimpleEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big @@ -1020,7 +1020,7 @@ splice. In particular it is not set when the splice is renamed or typechecked. 'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert the finalizer (see Note [Delaying modFinalizers in untyped splices]), and 'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to -set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +set 'RunSplice' when renaming or typechecking the splice, where 'Splice', 'Brack' or 'Comp' are used instead. -} ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, insertNoDup, equivClasses, -- Indexing @@ -169,3 +169,10 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs + +-- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only +-- when an equal element couldn't be found in @xs at . +insertNoDup :: (Eq a) => a -> [a] -> [a] +insertNoDup x set + | elem x set = set + | otherwise = x:set ===================================== testsuite/tests/pmcheck/should_compile/CyclicSubst.hs ===================================== @@ -0,0 +1,15 @@ +-- | The following match demonstrates why we need to detect cyclic solutions +-- when extending 'TmOracle.tm_pos'. +-- +-- TLDR; solving @x :-> y@ where @x@ is the representative of @y@'s equivalence +-- class can easily lead to a cycle in the substitution. +module CyclicSubst where + +-- | The match is translated to @b | a <- b@, the initial unification variable +-- is @a@ (for some reason). VarVar will assign @b :-> a@ in the match of @a@ +-- against @b@ (vars occuring in a pattern are flexible). The @PmGrd a b@ is +-- desugared as a match of @$pm_x@ against @a@, where @$pm_x :-> b@, which is +-- stored as @$pm_x :-> a@ due to the previous solution. Now, VarVar will +-- assign @a :-> $pm_x@, causing a cycle. +foo :: Int -> Int +foo a at b = a + b ===================================== testsuite/tests/pmcheck/should_compile/PmExprVars.hs ===================================== @@ -0,0 +1,44 @@ +module PmExprVars where + +-- | Demonstrates why we can't lower constructors as flexible meta variables. +-- If we did, we'd get a warning that cases 1 and 2 were redundant, implying +-- cases 0 and 3 are not. Arguably this might be better than not warning at +-- all, but it's very surprising having to supply the third case but not the +-- first two cases. And it's probably buggy somwhere else. Delete this when we +-- detect that all but the last case is redundant. +consAreRigid :: Int +consAreRigid = case False of + False -> case False of + False -> 0 + True -> 1 + True -> case False of + False -> 2 + True -> 3 + +data D a = A | B + +class C a where + d :: D a + +instance C Int where + d = A + +instance C Bool where + d = B + +-- | Demonstrates why we can't translate arbitrary 'HsVar' +-- occurrences as 'PmExprVar's (i.e., meta variables). If we did, the following +-- would warn that the cases 1 and 2 were redundant, which is clearly wrong +-- (case 1 is the only match). This is an artifact of translating from the +-- non-desugared 'HsExpr'. If we were to implement 'hsExprToPmExpr' in terms of +-- 'CoreExpr', we'd see the dictionary application and all would be well. The +-- solution is to look into the outer 'HsWrap' and determine whether we apply +-- or abstract over any evidence variables. +dictVarsAreTypeIndexed:: Int +dictVarsAreTypeIndexed = case d :: D Int of + A -> case d :: D Bool of + A -> 0 + B -> 1 + B -> case d :: D Bool of + A -> 2 + B -> 3 ===================================== testsuite/tests/pmcheck/should_compile/T12949.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T12949 where + +class Foo a where + foo :: Maybe a + +data Result a b = Neither | This a | That b | Both a b + +q :: forall a b . (Foo a, Foo b) => Result a b +q = case foo :: Maybe a of + Nothing -> case foo :: Maybe b of + Nothing -> Neither + Just c -> That c + Just i -> case foo :: Maybe b of + Nothing -> This i + Just c -> Both i c ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -94,8 +94,13 @@ test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T12949', [], compile, ['-fwarn-overlapping-patterns']) test('T12957', [], compile, ['-fwarn-overlapping-patterns']) test('T12957a', [], compile, ['-fwarn-overlapping-patterns']) +test('PmExprVars', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('CyclicSubst', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # EmptyCase test('T10746', [], compile, ===================================== testsuite/tests/typecheck/should_compile/T5490.stderr ===================================== @@ -1,8 +1,4 @@ -T5490.hs:246:5: warning: [-Woverlapping-patterns (in -Wdefault)] - Pattern match is redundant - In a case alternative: HDropZero -> ... - T5490.hs:295:5: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In a case alternative: _ -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e963beb54a243f011396942d2add644e3f3dd8ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e963beb54a243f011396942d2add644e3f3dd8ae You're receiving 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 Jun 7 14:22:18 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:22:18 -0400 Subject: [Git][ghc/ghc][master] Add HEAP_PROF_SAMPLE_END event to mark end of samples Message-ID: <5cfa731a7a0c2_6f79d0e464699188@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - 7 changed files: - docs/users_guide/eventlog-formats.rst - includes/rts/EventLogFormat.h - rts/ProfHeap.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -84,6 +84,14 @@ in length a single sample may need to be split among multiple ``EVENT_HEAP_PROF_SAMPLE`` events. The precise format of the census entries is determined by the break-down type. +At the end of the sample period the ``EVENT_HEAP_PROF_SAMPLE_END`` event if +emitted. This is useful to properly delimit the sampling period and to record +the total time spent profiling. + + + * ``EVENT_HEAP_PROF_SAMPLE_END`` + * ``Word64``: sample number + Cost-centre break-down ^^^^^^^^^^^^^^^^^^^^^^ ===================================== includes/rts/EventLogFormat.h ===================================== @@ -178,6 +178,7 @@ #define EVENT_HEAP_PROF_SAMPLE_BEGIN 162 #define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163 #define EVENT_HEAP_PROF_SAMPLE_STRING 164 +#define EVENT_HEAP_PROF_SAMPLE_END 165 #define EVENT_USER_BINARY_MSG 181 ===================================== rts/ProfHeap.c ===================================== @@ -884,6 +884,7 @@ dumpCensus( Census *census ) fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } + traceHeapProfSampleEnd(era); printSample(false, census->time); } ===================================== rts/Trace.c ===================================== @@ -623,6 +623,13 @@ void traceHeapProfSampleBegin(StgInt era) } } +void traceHeapProfSampleEnd(StgInt era) +{ + if (eventlog_enabled) { + postHeapProfSampleEnd(era); + } +} + void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency) { ===================================== rts/Trace.h ===================================== @@ -288,6 +288,7 @@ void traceTaskDelete_ (Task *task); void traceHeapProfBegin(StgWord8 profile_id); void traceHeapProfSampleBegin(StgInt era); +void traceHeapProfSampleEnd(StgInt era); void traceHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord residency); #if defined(PROFILING) @@ -335,6 +336,7 @@ void flushTrace(void); #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ +#define traceHeapProfSampleEnd(era) /* nothing */ #define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ #define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -103,6 +103,7 @@ char *EventDesc[] = { [EVENT_HEAP_PROF_BEGIN] = "Start of heap profile", [EVENT_HEAP_PROF_COST_CENTRE] = "Cost center definition", [EVENT_HEAP_PROF_SAMPLE_BEGIN] = "Start of heap profile sample", + [EVENT_HEAP_PROF_SAMPLE_END] = "End of heap profile sample", [EVENT_HEAP_PROF_SAMPLE_STRING] = "Heap profile string sample", [EVENT_HEAP_PROF_SAMPLE_COST_CENTRE] = "Heap profile cost-centre sample", [EVENT_USER_BINARY_MSG] = "User binary message" @@ -430,6 +431,10 @@ postHeaderEvents(void) eventTypes[t].size = 8; break; + case EVENT_HEAP_PROF_SAMPLE_END: + eventTypes[t].size = 8; + break; + case EVENT_HEAP_PROF_SAMPLE_STRING: eventTypes[t].size = EVENT_SIZE_DYNAMIC; break; @@ -1210,6 +1215,15 @@ void postHeapProfSampleBegin(StgInt era) RELEASE_LOCK(&eventBufMutex); } +void postHeapProfSampleEnd(StgInt era) +{ + ACQUIRE_LOCK(&eventBufMutex); + ensureRoomForEvent(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_END); + postWord64(&eventBuf, era); + RELEASE_LOCK(&eventBufMutex); +} + void postHeapProfSampleString(StgWord8 profile_id, const char *label, StgWord64 residency) ===================================== rts/eventlog/EventLog.h ===================================== @@ -140,6 +140,7 @@ void postTaskDeleteEvent (EventTaskId taskId); void postHeapProfBegin(StgWord8 profile_id); void postHeapProfSampleBegin(StgInt era); +void postHeapProfSampleEnd(StgInt era); void postHeapProfSampleString(StgWord8 profile_id, const char *label, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b7372f68c0bc9cafc30e227b574abf1d5b16df5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0b7372f68c0bc9cafc30e227b574abf1d5b16df5 You're receiving 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 Jun 7 14:22:51 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:22:51 -0400 Subject: [Git][ghc/ghc][master] Fix #16700: Tiny errors in output of GHCi commands :forward and :info Message-ID: <5cfa733bbfd14_6f79f76a447008eb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 7 changed files: - compiler/prelude/PrelInfo.hs - ghc/GHCi/UI.hs - + testsuite/tests/ghci.debugger/scripts/T16700.hs - + testsuite/tests/ghci.debugger/scripts/T16700.script - + testsuite/tests/ghci.debugger/scripts/T16700.stdout - testsuite/tests/ghci.debugger/scripts/all.T - testsuite/tests/ghci/scripts/ghci059.stdout Changes: ===================================== compiler/prelude/PrelInfo.hs ===================================== @@ -214,7 +214,8 @@ knownNamesInfo :: NameEnv SDoc knownNamesInfo = unitNameEnv coercibleTyConName $ vcat [ text "Coercible is a special constraint with custom solving rules." , text "It is not a class." - , text "Please see section 9.14.4 of the user's guide for details." ] + , text "Please see section `The Coercible constraint`" + , text "of the user's guide for details." ] {- We let a lot of "non-standard" values be visible, so that we can make ===================================== ghc/GHCi/UI.hs ===================================== @@ -3570,7 +3570,7 @@ forwardCmd :: GhciMonad m => String -> m () forwardCmd arg | null arg = forward 1 | all isDigit arg = forward (read arg) - | otherwise = liftIO $ putStrLn "Syntax: :back [num]" + | otherwise = liftIO $ putStrLn "Syntax: :forward [num]" where forward num = withSandboxOnly ":forward" $ do (names, ix, pan, _) <- GHC.forward num ===================================== testsuite/tests/ghci.debugger/scripts/T16700.hs ===================================== @@ -0,0 +1,6 @@ +qsort :: [Int] -> [Int] +qsort [] = [] +qsort (a:as) = qsort left ++ [a] ++ qsort right + where (left,right) = (filter (<=a) as, filter (>a) as) + +main = print $ qsort [4, 1, 7, 10, 3] ===================================== testsuite/tests/ghci.debugger/scripts/T16700.script ===================================== @@ -0,0 +1,4 @@ +:l T16700.hs +:break 3 +:main +:forward x ===================================== testsuite/tests/ghci.debugger/scripts/T16700.stdout ===================================== @@ -0,0 +1,7 @@ +Breakpoint 0 activated at T16700.hs:3:16-47 +Stopped in Main.qsort, T16700.hs:3:16-47 +_result :: [Int] = _ +a :: Int = 4 +left :: [Int] = _ +right :: [Int] = _ +Syntax: :forward [num] ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -108,5 +108,6 @@ test('T8557', normal, ghci_script, ['T8557.script']) test('T12458', normal, ghci_script, ['T12458.script']) test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), ghci_script, ['T13825-debugger.script']) +test('T16700', normal, ghci_script, ['T16700.script']) test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script']) ===================================== testsuite/tests/ghci/scripts/ghci059.stdout ===================================== @@ -1,7 +1,8 @@ {- Coercible is a special constraint with custom solving rules. It is not a class. -Please see section 9.14.4 of the user's guide for details. +Please see section `The Coercible constraint` +of the user's guide for details. -} type role Coercible representational representational class Coercible a b => Coercible (a :: k) (b :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d1dc0ed75be0dafb0be3b4ff5e839612702eab47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d1dc0ed75be0dafb0be3b4ff5e839612702eab47 You're receiving 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 Jun 7 14:23:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:23:28 -0400 Subject: [Git][ghc/ghc][master] Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module Message-ID: <5cfa7360a16e7_6f73fe61a90d63070525f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - 4 changed files: - compiler/main/SysTools/BaseDir.hs - + libraries/ghc-boot/GHC/BaseDir.hs - libraries/ghc-boot/ghc-boot.cabal.in - utils/ghc-pkg/Main.hs Changes: ===================================== compiler/main/SysTools/BaseDir.hs ===================================== @@ -20,20 +20,17 @@ module SysTools.BaseDir import GhcPrelude +-- See note [Base Dir] for why some of this logic is shared with ghc-pkg. +import GHC.BaseDir + import Panic import System.Environment (lookupEnv) import System.FilePath import Data.List --- POSIX -#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) -import System.Environment (getExecutablePath) -#endif - -- Windows #if defined(mingw32_HOST_OS) -import System.Environment (getExecutablePath) import System.Directory (doesDirectoryExist) #endif @@ -125,40 +122,6 @@ findTopDir Nothing InstallationError "missing -B option" Just dir -> return dir -getBaseDir :: IO (Maybe String) - -#if defined(mingw32_HOST_OS) - --- locate the "base dir" when given the path --- to the real ghc executable (as opposed to symlink) --- that is running this function. -rootDir :: FilePath -> FilePath -rootDir = takeDirectory . takeDirectory . normalise - -getBaseDir = Just . (\p -> p "lib") . rootDir <$> getExecutablePath -#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) --- on unix, this is a bit more confusing. --- The layout right now is something like --- --- /bin/ghc-X.Y.Z <- wrapper script (1) --- /bin/ghc <- symlink to wrapper script (2) --- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3) --- /lib/ghc-X.Y.Z <- $topdir (4) --- --- As such, we first need to find the absolute location to the --- binary. --- --- getExecutablePath will return (3). One takeDirectory will --- give use /lib/ghc-X.Y.Z/bin, and another will give us (4). --- --- This of course only works due to the current layout. If --- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib} --- this would need to be changed accordingly. --- -getBaseDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath -#else -getBaseDir = return Nothing -#endif -- See Note [tooldir: How GHC finds mingw and perl on Windows] -- Returns @Nothing@ when not on Windows. ===================================== libraries/ghc-boot/GHC/BaseDir.hs ===================================== @@ -0,0 +1,61 @@ +{-# LANGUAGE CPP #-} + +-- | Note [Base Dir] +-- ~~~~~~~~~~~~~~~~~ +-- +-- GHC's base directory or top directory containers miscellaneous settings and +-- the package database. The main compiler of course needs this directory to +-- read those settings and read and write packages. ghc-pkg uses it to find the +-- global package database too. +-- +-- In the interest of making GHC builds more relocatable, many settings also +-- will expand `${top_dir}` inside strings so GHC doesn't need to know it's on +-- installation location at build time. ghc-pkg also can expand those variables +-- and so needs the top dir location to do that too. +module GHC.BaseDir where + +import Prelude -- See note [Why do we import Prelude here?] + +import System.FilePath + +-- Windows +#if defined(mingw32_HOST_OS) +import System.Environment (getExecutablePath) +-- POSIX +#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) +import System.Environment (getExecutablePath) +#endif + +-- | Calculate the location of the base dir +getBaseDir :: IO (Maybe String) +#if defined(mingw32_HOST_OS) +getBaseDir = Just . (\p -> p "lib") . rootDir <$> getExecutablePath + where + -- locate the "base dir" when given the path + -- to the real ghc executable (as opposed to symlink) + -- that is running this function. + rootDir :: FilePath -> FilePath + rootDir = takeDirectory . takeDirectory . normalise +#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) +-- on unix, this is a bit more confusing. +-- The layout right now is something like +-- +-- /bin/ghc-X.Y.Z <- wrapper script (1) +-- /bin/ghc <- symlink to wrapper script (2) +-- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3) +-- /lib/ghc-X.Y.Z <- $topdir (4) +-- +-- As such, we first need to find the absolute location to the +-- binary. +-- +-- getExecutablePath will return (3). One takeDirectory will +-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4). +-- +-- This of course only works due to the current layout. If +-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib} +-- this would need to be changed accordingly. +-- +getBaseDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath +#else +getBaseDir = return Nothing +#endif ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -37,6 +37,7 @@ Library default-extensions: NoImplicitPrelude exposed-modules: + GHC.BaseDir GHC.LanguageExtensions GHC.PackageDb GHC.Serialized ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -31,6 +31,7 @@ import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import GHC.PackageDb (BinaryStringRep(..)) import GHC.HandleEncoding +import GHC.BaseDir (getBaseDir) import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName @@ -66,9 +67,6 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents, getCurrentDirectory ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) -#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(mingw32_HOST_OS) -import System.Environment ( getExecutablePath ) -#endif import System.IO import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType)) @@ -601,7 +599,8 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do let err_msg = "missing --global-package-db option, location of global package database unknown\n" global_conf <- case [ f | FlagGlobalConfig f <- my_flags ] of - [] -> do mb_dir <- getLibDir + -- See note [Base Dir] for more information on the base dir / top dir. + [] -> do mb_dir <- getBaseDir case mb_dir of Nothing -> die err_msg Just dir -> do @@ -2177,17 +2176,6 @@ reportError s = do hFlush stdout; hPutStrLn stderr s dieForcible :: String -> IO () dieForcible s = die (s ++ " (use --force to override)") ------------------------------------------ --- Cut and pasted from ghc/compiler/main/SysTools - -getLibDir :: IO (Maybe String) - -#if defined(mingw32_HOST_OS) || defined(darwin_HOST_OS) || defined(linux_HOST_OS) -getLibDir = Just . (\p -> p "lib") . takeDirectory . takeDirectory <$> getExecutablePath -#else -getLibDir = return Nothing -#endif - ----------------------------------------- -- Adapted from ghc/compiler/utils/Panic View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/387050d0e26a9e6466b31c9d8e4e4f6273c64c9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/387050d0e26a9e6466b31c9d8e4e4f6273c64c9e You're receiving 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 Jun 7 14:24:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:24:07 -0400 Subject: [Git][ghc/ghc][master] Preserve ShadowInfo when rewriting evidence Message-ID: <5cfa73872d764_6f75d456d470860@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 3 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcSMonad.hs - testsuite/tests/polykinds/T14172.stderr Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -2285,8 +2285,12 @@ rewriteEvidence ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) new_pred c (mkTcSymCo co)) rewriteEvidence ev@(CtWanted { ctev_dest = dest + , ctev_nosh = si , ctev_loc = loc }) new_pred co - = do { mb_new_ev <- newWanted loc new_pred + = do { mb_new_ev <- newWanted_SI si loc new_pred + -- The "_SI" varant ensures that we make a new Wanted + -- with the same shadow-info as the existing one + -- with the same shadow-info as the existing one (#16735) ; MASSERT( tcCoercionRole co == ctEvRole ev ) ; setWantedEvTerm dest (mkEvCast (getEvExpr mb_new_ev) @@ -2334,8 +2338,10 @@ rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co `mkTcTransCo` mkTcSymCo rhs_co) ; newGivenEvVar loc' (new_pred, new_tm) } - | CtWanted { ctev_dest = dest } <- old_ev - = do { (new_ev, hole_co) <- newWantedEq loc' (ctEvRole old_ev) nlhs nrhs + | CtWanted { ctev_dest = dest, ctev_nosh = si } <- old_ev + = do { (new_ev, hole_co) <- newWantedEq_SI si loc' (ctEvRole old_ev) nlhs nrhs + -- The "_SI" varant ensures that we make a new Wanted + -- with the same shadow-info as the existing one (#16735) ; let co = maybeSym swapped $ mkSymCo lhs_co `mkTransCo` hole_co ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -33,8 +33,10 @@ module TcSMonad ( MaybeNew(..), freshGoals, isFresh, getEvExpr, newTcEvBinds, newNoTcEvBinds, - newWantedEq, emitNewWantedEq, - newWanted, newWantedEvVar, newWantedNC, newWantedEvVarNC, newDerivedNC, + newWantedEq, newWantedEq_SI, emitNewWantedEq, + newWanted, newWanted_SI, newWantedEvVar, + newWantedNC, newWantedEvVarNC, + newDerivedNC, newBoundEvVarId, unifyTyVar, unflattenFmv, reportUnifications, setEvBind, setWantedEq, @@ -3404,12 +3406,18 @@ emitNewWantedEq loc role ty1 ty2 ; return co } -- | Make a new equality CtEvidence -newWantedEq :: CtLoc -> Role -> TcType -> TcType -> TcS (CtEvidence, Coercion) -newWantedEq loc role ty1 ty2 +newWantedEq :: CtLoc -> Role -> TcType -> TcType + -> TcS (CtEvidence, Coercion) +newWantedEq = newWantedEq_SI WDeriv + +newWantedEq_SI :: ShadowInfo -> CtLoc -> Role + -> TcType -> TcType + -> TcS (CtEvidence, Coercion) +newWantedEq_SI si loc role ty1 ty2 = do { hole <- wrapTcS $ TcM.newCoercionHole pty ; traceTcS "Emitting new coercion hole" (ppr hole <+> dcolon <+> ppr pty) ; return ( CtWanted { ctev_pred = pty, ctev_dest = HoleDest hole - , ctev_nosh = WDeriv + , ctev_nosh = si , ctev_loc = loc} , mkHoleCo hole ) } where @@ -3417,35 +3425,44 @@ newWantedEq loc role ty1 ty2 -- no equalities here. Use newWantedEq instead newWantedEvVarNC :: CtLoc -> TcPredType -> TcS CtEvidence +newWantedEvVarNC = newWantedEvVarNC_SI WDeriv + +newWantedEvVarNC_SI :: ShadowInfo -> CtLoc -> TcPredType -> TcS CtEvidence -- Don't look up in the solved/inerts; we know it's not there -newWantedEvVarNC loc pty +newWantedEvVarNC_SI si loc pty = do { new_ev <- newEvVar pty ; traceTcS "Emitting new wanted" (ppr new_ev <+> dcolon <+> ppr pty $$ pprCtLoc loc) ; return (CtWanted { ctev_pred = pty, ctev_dest = EvVarDest new_ev - , ctev_nosh = WDeriv + , ctev_nosh = si , ctev_loc = loc })} newWantedEvVar :: CtLoc -> TcPredType -> TcS MaybeNew +newWantedEvVar = newWantedEvVar_SI WDeriv + +newWantedEvVar_SI :: ShadowInfo -> CtLoc -> TcPredType -> TcS MaybeNew -- For anything except ClassPred, this is the same as newWantedEvVarNC -newWantedEvVar loc pty +newWantedEvVar_SI si loc pty = do { mb_ct <- lookupInInerts loc pty ; case mb_ct of Just ctev | not (isDerived ctev) -> do { traceTcS "newWantedEvVar/cache hit" $ ppr ctev ; return $ Cached (ctEvExpr ctev) } - _ -> do { ctev <- newWantedEvVarNC loc pty + _ -> do { ctev <- newWantedEvVarNC_SI si loc pty ; return (Fresh ctev) } } --- deals with both equalities and non equalities. Tries to look --- up non-equalities in the cache newWanted :: CtLoc -> PredType -> TcS MaybeNew -newWanted loc pty +-- Deals with both equalities and non equalities. Tries to look +-- up non-equalities in the cache +newWanted = newWanted_SI WDeriv + +newWanted_SI :: ShadowInfo -> CtLoc -> PredType -> TcS MaybeNew +newWanted_SI si loc pty | Just (role, ty1, ty2) <- getEqPredTys_maybe pty - = Fresh . fst <$> newWantedEq loc role ty1 ty2 + = Fresh . fst <$> newWantedEq_SI si loc role ty1 ty2 | otherwise - = newWantedEvVar loc pty + = newWantedEvVar_SI si loc pty -- deals with both equalities and non equalities. Doesn't do any cache lookups. newWantedNC :: CtLoc -> PredType -> TcS CtEvidence ===================================== testsuite/tests/polykinds/T14172.stderr ===================================== @@ -11,12 +11,12 @@ T14172.hs:6:46: error: In the type ‘(a -> f b) -> g a -> f (h _)’ T14172.hs:7:19: error: - • Occurs check: cannot construct the infinite type: a ~ g'1 a + • Occurs check: cannot construct the infinite type: a ~ g'0 a Expected type: (f'0 a -> f (f'0 b)) - -> Compose f'0 g'1 a -> f (h a') - Actual type: (Unwrapped (Compose f'0 g'1 a) + -> Compose f'0 g'0 a -> f (h a') + Actual type: (Unwrapped (Compose f'0 g'0 a) -> f (Unwrapped (h a'))) - -> Compose f'0 g'1 a -> f (h a') + -> Compose f'0 g'0 a -> f (h a') • In the first argument of ‘(.)’, namely ‘_Wrapping Compose’ In the expression: _Wrapping Compose . traverse In an equation for ‘traverseCompose’: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da26ffe795f1861783c1b031ed93f9fa59550f85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da26ffe795f1861783c1b031ed93f9fa59550f85 You're receiving 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 Jun 7 14:24:19 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:24:19 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Attempt Message-ID: <5cfa739321dee_6f7e588744712010@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 10a34c98 by Matthew Pickering at 2019-06-07T14:24:04Z Attempt - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -53,9 +53,9 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - echo "Linting changes between $CI_MERGE_REQUEST_TARGET_BRANCH_NAME..$CI_COMMIT_SHA" + - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_PATH" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - - git merge-base FETCH_HEAD $CI_COMMIT_SHA + - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Merge base $base" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10a34c9847eae3e0761a96b8f801deaf1b755456 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10a34c9847eae3e0761a96b8f801deaf1b755456 You're receiving 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 Jun 7 14:24:42 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:24:42 -0400 Subject: [Git][ghc/ghc][master] Hadrian: Delete target symlink in createFileLinkUntracked Message-ID: <5cfa73aa339d3_6f79d0e4647127c2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - 1 changed file: - hadrian/src/Hadrian/Utilities.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -34,6 +34,7 @@ module Hadrian.Utilities ( Dynamic, fromDynamic, toDyn, TypeRep, typeOf ) where +import Control.Applicative import Control.Monad.Extra import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) @@ -296,7 +297,9 @@ createFileLinkUntracked linkTarget link = do let dir = takeDirectory link liftIO $ IO.createDirectoryIfMissing True dir putProgressInfo =<< renderCreateFileLink linkTarget link - quietly . liftIO $ IO.createFileLink linkTarget link + quietly . liftIO $ do + IO.removeFile link <|> return () + IO.createFileLink linkTarget link -- | Link a file tracking the link target. Create the target directory if -- missing. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9bb58799d2ce58f6aef772df79ad26210403aded -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9bb58799d2ce58f6aef772df79ad26210403aded You're receiving 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 Jun 7 14:25:21 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:25:21 -0400 Subject: [Git][ghc/ghc][master] Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Message-ID: <5cfa73d1f6f3_6f73fe61882b9947157b5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - 6 changed files: - libraries/base/GHC/Natural.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/isValidNatural.hs - + libraries/base/tests/isValidNatural.stdout - libraries/integer-gmp/src/GHC/Integer/Type.hs Changes: ===================================== libraries/base/GHC/Natural.hs ===================================== @@ -157,7 +157,9 @@ data Natural = NatS# GmpLimb# -- ^ in @[0, maxBound::Word]@ isValidNatural :: Natural -> Bool isValidNatural (NatS# _) = True isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn) - && isTrue# (sizeofBigNat# bn ># 0#) + -- A 1-limb BigNat could fit into a NatS#, so we + -- require at least 2 limbs. + && isTrue# (sizeofBigNat# bn ># 1#) signumNatural :: Natural -> Natural signumNatural (NatS# 0##) = NatS# 0## ===================================== libraries/base/changelog.md ===================================== @@ -5,6 +5,10 @@ * Add a `TestEquality` instance for the `Compose` newtype. + * Fix the `integer-gmp` variant of `isValidNatural`: Previously it would fail + to detect values `<= maxBound::Word` that were incorrectly encoded using + the `NatJ#` constructor. + ## 4.13.0.0 *TBA* * Bundled with GHC *TBA* ===================================== libraries/base/tests/all.T ===================================== @@ -40,6 +40,7 @@ test('take001', extra_run_opts('1'), compile_and_run, ['']) test('inits', normal, compile_and_run, ['']) test('genericNegative001', extra_run_opts('-1'), compile_and_run, ['']) test('ix001', normal, compile_and_run, ['']) +test('isValidNatural', reqlib('integer-gmp'), compile_and_run, ['']) # need to add -K64m to the compiler opts, so that GHCi gets it too test('ioref001', ===================================== libraries/base/tests/isValidNatural.hs ===================================== @@ -0,0 +1,9 @@ +{-# language MagicHash #-} + +import GHC.Integer.GMP.Internals +import GHC.Natural + +main = print $ map isValidNatural [0, 1, maxWord, maxWord + 1, invalid] + where + maxWord = fromIntegral (maxBound :: Word) + invalid = NatJ# oneBigNat -- 1 would fit into the NatS# constructor. ===================================== libraries/base/tests/isValidNatural.stdout ===================================== @@ -0,0 +1 @@ +[True,True,True,True,False] ===================================== libraries/integer-gmp/src/GHC/Integer/Type.hs ===================================== @@ -1778,6 +1778,8 @@ foreign import ccall unsafe "gmp.h __gmpn_popcount" -- BigNat-wrapped ByteArray#-primops -- | Return number of limbs contained in 'BigNat'. +-- +-- The result is always @>= 1@ since even zero is encoded with 1 limb. sizeofBigNat# :: BigNat -> GmpSize# sizeofBigNat# (BN# x#) = sizeofByteArray# x# `uncheckedIShiftRL#` GMP_LIMB_SHIFT# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be63d2996308c77f8a0a44592074c98f66a80e93 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be63d2996308c77f8a0a44592074c98f66a80e93 You're receiving 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 Jun 7 14:25:42 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:25:42 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] fix Message-ID: <5cfa73e6b5d5f_6f73fe60cb0a6307188ac@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: f75982af by Matthew Pickering at 2019-06-07T14:25:25Z fix - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -53,7 +53,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_PATH" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f75982af0cd0d7132b32c302b51850c6394afd65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f75982af0cd0d7132b32c302b51850c6394afd65 You're receiving 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 Jun 7 14:26:09 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:26:09 -0400 Subject: [Git][ghc/ghc][master] llvm-targets: Add x86_64 android layout Message-ID: <5cfa740156a21_6f73fe611095da8719557@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 2 changed files: - llvm-targets - utils/llvm-targets/gen-data-layout.sh Changes: ===================================== llvm-targets ===================================== @@ -13,6 +13,7 @@ ,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux-android", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "+sse4.2 +popcnt")) ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", "")) ===================================== utils/llvm-targets/gen-data-layout.sh ===================================== @@ -28,7 +28,7 @@ TARGETS=( # Linux x86 "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" # Linux Android - "armv7-unknown-linux-androideabi" "aarch64-unknown-linux-android" + "x86_64-unknown-linux-android" "armv7-unknown-linux-androideabi" "aarch64-unknown-linux-android" # Linux ppc64le "powerpc64le-unknown-linux" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e87b9f8731460a7d8c0b45507be2d83935683d56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e87b9f8731460a7d8c0b45507be2d83935683d56 You're receiving 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 Jun 7 14:26:53 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:26:53 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Update Traversable.hs with a note about an intuitive law Message-ID: <5cfa742dd9ae9_6f7e0cadec7223fb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - 1 changed file: - libraries/base/Data/Traversable.hs Changes: ===================================== libraries/base/Data/Traversable.hs ===================================== @@ -115,7 +115,12 @@ import qualified GHC.List as List ( foldr ) -- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and -- "Data.Functor.Compose". -- --- (The naturality law is implied by parametricity.) +-- A result of the naturality law is a purity law for 'traverse' +-- +-- @'traverse' 'pure' = 'pure'@ +-- +-- (The naturality law is implied by parametricity and thus so is the +-- purity law [1, p15].) -- -- Instances are similar to 'Functor', e.g. given a data type -- @@ -140,6 +145,8 @@ import qualified GHC.List as List ( foldr ) -- equivalent to traversal with a constant applicative functor -- ('foldMapDefault'). -- +-- References: +-- [1] The Essence of the Iterator Pattern, Jeremy Gibbons and Bruno C. d. S. Oliveira class (Functor t, Foldable t) => Traversable t where {-# MINIMAL traverse | sequenceA #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e87b9f8731460a7d8c0b45507be2d83935683d56...13b3d45d308108da2d92b3c06b5489f41703e623 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e87b9f8731460a7d8c0b45507be2d83935683d56...13b3d45d308108da2d92b3c06b5489f41703e623 You're receiving 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 Jun 7 14:27:38 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:27:38 -0400 Subject: [Git][ghc/ghc][master] Pass preprocessor options to C compiler when building foreign C files (#16737) Message-ID: <5cfa745a999ef_6f73fe6085032687273f0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5 changed files: - compiler/main/DriverPipeline.hs - + testsuite/tests/driver/T16737.hs - + testsuite/tests/driver/T16737.stdout - + testsuite/tests/driver/T16737include/T16737.h - testsuite/tests/driver/all.T Changes: ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -1190,9 +1190,6 @@ runPhase (RealPhase Cmm) input_fn dflags ----------------------------------------------------------------------------- -- Cc phase --- we don't support preprocessing .c files (with -E) now. Doing so introduces --- way too many hacks, and I can't say I've ever used it anyway. - runPhase (RealPhase cc_phase) input_fn dflags | any (cc_phase `eqPhase`) [Cc, Ccxx, HCc, Cobjc, Cobjcxx] = do @@ -1214,6 +1211,16 @@ runPhase (RealPhase cc_phase) input_fn dflags (includePathsQuote cmdline_include_paths) let include_paths = include_paths_quote ++ include_paths_global + -- pass -D or -optP to preprocessor when compiling foreign C files + -- (#16737). Doing it in this way is simpler and also enable the C + -- compiler to performs preprocessing and parsing in a single pass, + -- but it may introduce inconsistency if a different pgm_P is specified. + let more_preprocessor_opts = concat + [ ["-Xpreprocessor", i] + | not hcc + , i <- getOpts dflags opt_P + ] + let gcc_extra_viac_flags = extraGccViaCFlags dflags let pic_c_flags = picCCOpts dflags @@ -1223,7 +1230,7 @@ runPhase (RealPhase cc_phase) input_fn dflags -- hc code doesn't not #include any header files anyway, so these -- options aren't necessary. pkg_extra_cc_opts <- liftIO $ - if cc_phase `eqPhase` HCc + if hcc then return [] else getPackageExtraCcOpts dflags pkgs @@ -1305,6 +1312,7 @@ runPhase (RealPhase cc_phase) input_fn dflags ++ [ "-include", ghcVersionH ] ++ framework_paths ++ include_paths + ++ more_preprocessor_opts ++ pkg_extra_cc_opts )) ===================================== testsuite/tests/driver/T16737.hs ===================================== @@ -0,0 +1,32 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -DFOO=2 -optP=-DBAR=3 -optc=-DBAZ=5 -optcxx=-DBAZ=7 #-} + +import Language.Haskell.TH.Syntax + +do + let code = unlines + [ "#if defined(__cplusplus)" + , "extern \"C\" {" + , "#endif" + , "#include " + , "int FUN(void) {" + , " return FOO * BAR * BAZ;" + , "}" + , "#if defined(__cplusplus)" + , "}" + , "#endif" + ] + addForeignSource LangC code + addForeignSource LangCxx code + pure [] + +foreign import ccall unsafe "c_value" + c_value :: IO Int + +foreign import ccall unsafe "cxx_value" + cxx_value :: IO Int + +main :: IO () +main = do + print =<< c_value + print =<< cxx_value ===================================== testsuite/tests/driver/T16737.stdout ===================================== @@ -0,0 +1,2 @@ +30 +42 ===================================== testsuite/tests/driver/T16737include/T16737.h ===================================== @@ -0,0 +1,7 @@ +#pragma once + +#if defined(__cplusplus) +#define FUN cxx_value +#else +#define FUN c_value +#endif ===================================== testsuite/tests/driver/all.T ===================================== @@ -270,3 +270,4 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) +test('T16737', [extra_files(['T16737include/'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/cfd3e0f1cfd16c8f35cae139d2a871a32eb4d2e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/cfd3e0f1cfd16c8f35cae139d2a871a32eb4d2e1 You're receiving 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 Jun 7 14:28:14 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:28:14 -0400 Subject: [Git][ghc/ghc][master] base: Export Finalizers Message-ID: <5cfa747ed52d0_6f73fe60d0787c07344ac@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 1 changed file: - libraries/base/GHC/ForeignPtr.hs Changes: ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -25,6 +25,7 @@ module GHC.ForeignPtr ( ForeignPtr(..), ForeignPtrContents(..), + Finalizers(..), FinalizerPtr, FinalizerEnvPtr, newForeignPtr_, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5991d877a3da69da63ab93ea277bd89965c97573 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5991d877a3da69da63ab93ea277bd89965c97573 You're receiving 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 Jun 7 14:28:52 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:28:52 -0400 Subject: [Git][ghc/ghc][master] Hadrian: use deb9 Docker images instead of deb8 for CI jobs Message-ID: <5cfa74a477447_6f7cfff814738680@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -158,10 +158,10 @@ lint-release-changelogs: - ghc.tar.xz - junit.xml -validate-x86_64-linux-deb8-hadrian: +validate-x86_64-linux-deb9-hadrian: extends: .validate-hadrian stage: build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . @@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian: hadrian-ghc-in-ghci: <<: *only-default stage: build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3d97bad67ea64b7ee690c0a8836579bceef47cb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3d97bad67ea64b7ee690c0a8836579bceef47cb5 You're receiving 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 Jun 7 14:29:26 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 10:29:26 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Create index.html in documentation deployment Message-ID: <5cfa74c65f30a_6f73fe61a2d9b38742445@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -864,6 +864,12 @@ pages: - tar -xf haddock.html.tar.xz -C public/doc - tar -xf libraries.html.tar.xz -C public/doc - tar -xf users_guide.html.tar.xz -C public/doc + - | + cat >public/index.html < + + + EOF - cp -f index.html public/doc only: - master View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1afb499583f741a95cceb3207c5455c8ec6f5b87 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1afb499583f741a95cceb3207c5455c8ec6f5b87 You're receiving 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 Jun 7 14:31:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 10:31:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] Bump Cabal Message-ID: <5cfa754a253d1_6f7e33938074894c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 183dcc5e by Ben Gamari at 2019-06-07T14:31:10Z Bump Cabal - - - - - 3 changed files: - hadrian/hadrian.cabal - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - libraries/Cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -116,7 +116,7 @@ executable hadrian other-extensions: MultiParamTypeClasses , TypeFamilies build-depends: base >= 4.8 && < 5 - , Cabal >= 2.5 && < 2.6 + , Cabal >= 3.0 && < 3.1 , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , extra >= 1.4.7 ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal.Parse @@ -17,6 +16,7 @@ module Hadrian.Haskell.Cabal.Parse ( import Data.Bifunctor import Data.List.Extra import Development.Shake +import qualified Distribution.Compat.Graph as Graph import qualified Distribution.ModuleName as C import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C @@ -30,6 +30,7 @@ import qualified Distribution.Simple.Utils as C import qualified Distribution.Simple.Program.Types as C import qualified Distribution.Simple.Configure as C (getPersistBuildConfig) import qualified Distribution.Simple.Build as C +import qualified Distribution.Types.ComponentLocalBuildInfo as C import qualified Distribution.Types.ComponentRequestedSpec as C import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as C @@ -215,7 +216,7 @@ resolveContextData context at Context {..} = do -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 - let extDeps = C.externalPackageDeps lbi' + let extDeps = externalPackageDeps lbi' deps = map (C.display . snd) extDeps depDirect = map (fromMaybe (error "resolveContextData: depDirect failed") . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps @@ -288,7 +289,20 @@ resolveContextData context at Context {..} = do getHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo getHookedBuildInfo [] = return C.emptyHookedBuildInfo getHookedBuildInfo (baseDir:baseDirs) = do - maybeInfoFile <- C.findHookedPackageDesc baseDir + maybeInfoFile <- C.findHookedPackageDesc C.normal baseDir case maybeInfoFile of Nothing -> getHookedBuildInfo baseDirs Just infoFile -> C.readHookedBuildInfo C.silent infoFile + +externalPackageDeps :: C.LocalBuildInfo -> [(C.UnitId, C.MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (C.componentGraph lbi) + , (ipkgid, pkgid) <- C.componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . C.componentUnitId) (Graph.toList (C.componentGraph lbi)) + ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 15675844bb36929448c189d6b4aabf7e853b3ee1 +Subproject commit f697d3209990c3314efe840be54fb7c5a967e6ff View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/183dcc5e2a8e779fc2871b0e78ea7e0fe7fbaed5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/183dcc5e2a8e779fc2871b0e78ea7e0fe7fbaed5 You're receiving 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 Jun 7 14:33:48 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:33:48 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] fetch all yolo Message-ID: <5cfa75cc12aea_6f73fe5e07e55d0752342@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 000be767 by Matthew Pickering at 2019-06-07T14:33:37Z fetch all yolo - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -53,6 +53,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + - git fetch --all origin - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/000be767f0ee9a68c735a35e6243d6f5067de387 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/000be767f0ee9a68c735a35e6243d6f5067de387 You're receiving 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 Jun 7 14:34:41 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:34:41 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] no arg Message-ID: <5cfa7601a8541_6f73fe61a2d9b3875324c@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 46bbf546 by Matthew Pickering at 2019-06-07T14:34:33Z no arg - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -53,7 +53,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch --all origin + - git fetch --all - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/46bbf546c6533d6f9c7df1cadb6464a86c1f63ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/46bbf546c6533d6f9c7df1cadb6464a86c1f63ea You're receiving 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 Jun 7 14:39:22 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:39:22 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] dbg Message-ID: <5cfa771a64067_6f73fe5e07e55d07539d9@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 8885e978 by Matthew Pickering at 2019-06-07T14:39:13Z dbg - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -57,6 +57,8 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" + - git merge-base FETCH_HEAD $CI_COMMIT_SHA || echo "Failed to find base" + - echo "Finding base" - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Merge base $base" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8885e9780fae1f5bd9bf7696e8afe667fa2cbbf8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8885e9780fae1f5bd9bf7696e8afe667fa2cbbf8 You're receiving 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 Jun 7 14:40:42 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:40:42 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Set depth = 500 Message-ID: <5cfa776a9e9d_6f7e3393807546d@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 75d57056 by Matthew Pickering at 2019-06-07T14:40:33Z Set depth = 500 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -69,6 +69,8 @@ ghc-linters: dependencies: [] tags: - lint + variables: + GIT_DEPTH: "500" only: refs: - merge_requests View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/75d57056d23cb66ea3fcbf2ede1fe2674db2cd72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/75d57056d23cb66ea3fcbf2ede1fe2674db2cd72 You're receiving 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 Jun 7 14:42:57 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:42:57 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] show commits Message-ID: <5cfa77f1d7d4_6f73fe61146f26c756952@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: ba05a2fd by Matthew Pickering at 2019-06-07T14:42:51Z show commits - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,7 +49,6 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: @@ -57,6 +56,8 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" + - git show FETCH_HEAD + - git show $CI_COMMIT_SHA - git merge-base FETCH_HEAD $CI_COMMIT_SHA || echo "Failed to find base" - echo "Finding base" - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba05a2fd866b06aeb3325207ecc58285a2715f01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ba05a2fd866b06aeb3325207ecc58285a2715f01 You're receiving 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 Jun 7 14:44:53 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Fri, 07 Jun 2019 10:44:53 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Set depth Message-ID: <5cfa786588d27_6f73fe5e07e55d07577b0@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 467172e3 by Matthew Pickering at 2019-06-07T14:44:47Z Set depth - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,9 +52,8 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch --all - - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_SOURCE_PROJECT_URL" $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME --depth=500 + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME --depth=500 - echo "Linting changes between $(git rev-parse FETCH_HEAD)..$CI_COMMIT_SHA" - git show FETCH_HEAD - git show $CI_COMMIT_SHA View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/467172e3951f65c312a8720f9b7bca164687229e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/467172e3951f65c312a8720f9b7bca164687229e You're receiving 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 Jun 7 15:01:46 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:01:46 -0400 Subject: [Git][ghc/ghc][wip/fix-linters] 4 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfa7c5a758b3_6f7e339380764932@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-linters at Glasgow Haskell Compiler / GHC Commits: 2c9fbf09 by Matthew Pickering at 2019-06-07T14:55:49Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - ecb99799 by Matthew Pickering at 2019-06-07T14:55:49Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 1e3f59eb by Matthew Pickering at 2019-06-07T14:55:49Z Fix two lint failures in rts/linker/MachO.c - - - - - 20822dd7 by Ben Gamari at 2019-06-07T15:01:20Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - 2 changed files: - .gitlab-ci.yml - rts/linker/MachO.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,13 +49,16 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + # GitLab creates a shallow clone which means that we may not have the base + # commit of the MR being tested (e.g. if the MR is quite old), causing `git + # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that + # we have the entire history. + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Merge base $base" + - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) - validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA) - .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA @@ -101,6 +104,9 @@ lint-submods-mr: only: refs: - merge_requests + except: + variables: + - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ .lint-changelogs: stage: lint ===================================== rts/linker/MachO.c ===================================== @@ -1220,7 +1220,7 @@ ocGetNames_MachO(ObjectCode* oc) IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", oc->n_sections)); -#if defined (ios_HOST_OS) +#if defined(ios_HOST_OS) for(int i=0; i < oc->n_sections; i++) { MachOSection * section = &oc->info->macho_sections[i]; @@ -1645,7 +1645,7 @@ ocResolve_MachO(ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); -#if defined aarch64_HOST_ARCH +#if defined(aarch64_HOST_ARCH) if (!relocateSectionAarch64(oc, &oc->sections[i])) return 0; #else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4c3bb004ca8e2222732f1883425de2ac90b43e92...20822dd763f97708017b872c1a34e331fac2006f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4c3bb004ca8e2222732f1883425de2ac90b43e92...20822dd763f97708017b872c1a34e331fac2006f You're receiving 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 Jun 7 15:04:46 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:04:46 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 4 commits: Fix two lint failures in rts/linker/MachO.c Message-ID: <5cfa7d0ee8b22_6f73fe5e07e55d0766068@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 975b7972 by Matthew Pickering at 2019-06-07T15:04:19Z Fix two lint failures in rts/linker/MachO.c - - - - - a623940c by Matthew Pickering at 2019-06-07T15:04:22Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - 9553a920 by Matthew Pickering at 2019-06-07T15:04:23Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 60373c3d by Ben Gamari at 2019-06-07T15:04:25Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - 2 changed files: - .gitlab-ci.yml - rts/linker/MachO.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,13 +49,16 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + # GitLab creates a shallow clone which means that we may not have the base + # commit of the MR being tested (e.g. if the MR is quite old), causing `git + # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that + # we have the entire history. + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Merge base $base" + - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) - validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA) - .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA @@ -101,6 +104,9 @@ lint-submods-mr: only: refs: - merge_requests + except: + variables: + - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ .lint-changelogs: stage: lint ===================================== rts/linker/MachO.c ===================================== @@ -1216,7 +1216,7 @@ ocGetNames_MachO(ObjectCode* oc) IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", oc->n_sections)); -#if defined (ios_HOST_OS) +#if defined(ios_HOST_OS) for(int i=0; i < oc->n_sections; i++) { MachOSection * section = &oc->info->macho_sections[i]; @@ -1641,7 +1641,7 @@ ocResolve_MachO(ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); -#if defined aarch64_HOST_ARCH +#if defined(aarch64_HOST_ARCH) if (!relocateSectionAarch64(oc, &oc->sections[i])) return 0; #else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/467172e3951f65c312a8720f9b7bca164687229e...60373c3d871a419766a181280d5c85f6c601f550 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/467172e3951f65c312a8720f9b7bca164687229e...60373c3d871a419766a181280d5c85f6c601f550 You're receiving 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 Jun 7 15:09:46 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:09:46 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Fix whitespace Message-ID: <5cfa7e3aec5cc_6f73fe5e07e55d077245d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 89c0b258 by Ben Gamari at 2019-06-07T15:09:35Z Fix whitespace - - - - - 1 changed file: - includes/stg/SMP.h Changes: ===================================== includes/stg/SMP.h ===================================== @@ -159,7 +159,7 @@ EXTERN_INLINE void load_load_barrier(void); * * Note that thread stacks are inherently thread-local and consequently allocating an * object and introducing a reference to it to our stack needs no barrier. - * + * * Finally, we take pains to ensure that we flush all write buffers before * entering GC, since stacks may be read by other cores. * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/89c0b258bfb031c81332d5bc62c4296824b9e7cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/89c0b258bfb031c81332d5bc62c4296824b9e7cb You're receiving 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 Jun 7 15:15:01 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:15:01 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 2 commits: gitlab-ci: Fix submodule linter Message-ID: <5cfa7f75e12c6_6f73fe61a2d9b38775068@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 4acac14e by Ben Gamari at 2019-06-07T15:14:07Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - 9caa7ab8 by Ben Gamari at 2019-06-07T15:14:42Z gitlab-ci: A few clarifying comments - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,6 +52,8 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # Note [Unshallow clone for linting] + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # GitLab creates a shallow clone which means that we may not have the base # commit of the MR being tested (e.g. if the MR is quite old), causing `git # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that @@ -78,6 +80,10 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # See Note [Unshallow clone for linting] + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" + - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -100,6 +106,8 @@ lint-submods-marge: lint-submods-mr: extends: .lint-submods + # Allow failure since any necessary submodule patches may not be upstreamed + # yet. allow_failure: true only: refs: @@ -123,6 +131,7 @@ lint-submods-mr: lint-changelogs: extends: .lint-changelogs + # Allow failure since this isn't a final release. allow_failure: true only: refs: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/89c0b258bfb031c81332d5bc62c4296824b9e7cb...9caa7ab8f878a1a5e4c4fcf2fad15d94fb0fe56c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/89c0b258bfb031c81332d5bc62c4296824b9e7cb...9caa7ab8f878a1a5e4c4fcf2fad15d94fb0fe56c You're receiving 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 Jun 7 15:15:37 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:15:37 -0400 Subject: [Git][ghc/ghc][wip/fix-linters] 2 commits: gitlab-ci: Fix submodule linter Message-ID: <5cfa7f994b4c6_6f7e588744776478@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-linters at Glasgow Haskell Compiler / GHC Commits: b5bbc612 by Ben Gamari at 2019-06-07T15:15:24Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - 8ec83227 by Ben Gamari at 2019-06-07T15:15:25Z gitlab-ci: A few clarifying comments - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -52,6 +52,8 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # Note [Unshallow clone for linting] + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # GitLab creates a shallow clone which means that we may not have the base # commit of the MR being tested (e.g. if the MR is quite old), causing `git # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that @@ -78,6 +80,10 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # See Note [Unshallow clone for linting] + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" + - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -100,6 +106,8 @@ lint-submods-marge: lint-submods-mr: extends: .lint-submods + # Allow failure since any necessary submodule patches may not be upstreamed + # yet. allow_failure: true only: refs: @@ -123,6 +131,7 @@ lint-submods-mr: lint-changelogs: extends: .lint-changelogs + # Allow failure since this isn't a final release. allow_failure: true only: refs: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20822dd763f97708017b872c1a34e331fac2006f...8ec83227c4b6b1c8d5c5e66fae601650a5f22837 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20822dd763f97708017b872c1a34e331fac2006f...8ec83227c4b6b1c8d5c5e66fae601650a5f22837 You're receiving 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 Jun 7 15:19:05 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 11:19:05 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 7 commits: Clean up Message-ID: <5cfa80698c45e_6f73fe60d68f17c7769e5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: b4fc5d93 by Ben Gamari at 2019-06-07T15:18:50Z Clean up - - - - - a23aa325 by Matthew Pickering at 2019-06-07T15:18:50Z Fix two lint failures in rts/linker/MachO.c - - - - - dd11684f by Matthew Pickering at 2019-06-07T15:18:50Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - afebd872 by Matthew Pickering at 2019-06-07T15:18:50Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 0bbf3f8b by Ben Gamari at 2019-06-07T15:18:50Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - 442e4b0e by Ben Gamari at 2019-06-07T15:18:50Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - 78574759 by Ben Gamari at 2019-06-07T15:18:50Z gitlab-ci: A few clarifying comments - - - - - 19 changed files: - .gitlab-ci.yml - includes/stg/SMP.h - rts/Apply.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsAPI.c - rts/StgMiscClosures.cmm - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/Weak.c - rts/linker/MachO.c - rts/sm/CNF.c - rts/sm/Compact.c - rts/sm/MarkWeak.c - rts/sm/Scav.c - rts/sm/Storage.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,13 +49,18 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + # Note [Unshallow clone for linting] + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # GitLab creates a shallow clone which means that we may not have the base + # commit of the MR being tested (e.g. if the MR is quite old), causing `git + # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that + # we have the entire history. + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Merge base $base" + - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) - validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA) - .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA @@ -75,6 +80,10 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # See Note [Unshallow clone for linting] + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" + - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -97,10 +106,15 @@ lint-submods-marge: lint-submods-mr: extends: .lint-submods + # Allow failure since any necessary submodule patches may not be upstreamed + # yet. allow_failure: true only: refs: - merge_requests + except: + variables: + - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ .lint-changelogs: stage: lint @@ -117,6 +131,7 @@ lint-submods-mr: lint-changelogs: extends: .lint-changelogs + # Allow failure since this isn't a final release. allow_failure: true only: refs: ===================================== includes/stg/SMP.h ===================================== @@ -98,15 +98,15 @@ EXTERN_INLINE void load_load_barrier(void); /* * Note [Heap memory barriers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ * * Machines with weak memory ordering semantics have consequences for how - * closures are observed and mutated. For example, consider a closure that needs + * closures are observed and mutated. For example, consider a thunk that needs * to be updated to an indirection. In order for the indirection to be safe for * concurrent observers to enter, said observers must read the indirection's - * info table before they read the indirectee. Furthermore, the entering - * observer makes assumptions about the closure based on its info table - * contents, e.g. an INFO_TYPE of IND imples the closure has an indirectee - * pointer that is safe to follow. + * info table before they read the indirectee. Furthermore, the indirectee must + * be set before the info table pointer. This ensures that if the observer sees + * an IND info table then the indirectee is valid. * * When a closure is updated with an indirection, both its info table and its * indirectee must be written. With weak memory ordering, these two writes can @@ -145,6 +145,24 @@ EXTERN_INLINE void load_load_barrier(void); * - Read the closure's info pointer. * - Read barrier. * - Read the closure's (non-info table) fields. + * + * We must also take care when we expose a newly-allocated closure to other cores + * by writing a pointer to it to some shared data structure (e.g. an MVar#, a Message, + * or MutVar#). Specifically, we need to ensure that all writes constructing the + * closure are visible *before* the write exposing the new closure is made visible: + * + * - Allocate memory for the closure + * - Write the closure's info pointer and fields (ordering betweeen this doesn't + * matter since the closure isn't yet visible to anyone else). + * - Write barrier + * - Make closure visible to other cores + * + * Note that thread stacks are inherently thread-local and consequently allocating an + * object and introducing a reference to it to our stack needs no barrier. + * + * Finally, we take pains to ensure that we flush all write buffers before + * entering GC, since stacks may be read by other cores. + * */ /* ---------------------------------------------------------------------------- ===================================== rts/Apply.cmm ===================================== @@ -63,7 +63,7 @@ again: P_ untaggedfun; W_ arity; // We must obey the correct heap object observation pattern in - // note [Heap memory barriers] in SMP.h. + // Note [Heap memory barriers] in SMP.h. untaggedfun = UNTAG(fun); info = %INFO_PTR(untaggedfun); prim_read_barrier; @@ -107,6 +107,7 @@ again: CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD); P_ pap; pap = Hp - SIZEOF_StgPAP + WDS(1); + SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = arity; if (arity <= TAG_MASK) { // TODO: Shouldn't this already be tagged? If not why did we @@ -115,8 +116,6 @@ again: } StgPAP_fun(pap) = fun; StgPAP_n_args(pap) = 0; - prim_write_barrier; - SET_HDR(pap, stg_PAP_info, CCCS); return (pap); } } @@ -136,6 +135,7 @@ again: pap = Hp - size + WDS(1); // We'll lose the original PAP, so we should enter its CCS ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); + SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = StgPAP_arity(untaggedfun); StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); StgPAP_fun(pap) = StgPAP_fun(fun); @@ -143,8 +143,6 @@ again: i = TO_W_(StgPAP_n_args(untaggedfun)); loop: if (i == 0) { - prim_write_barrier; - SET_HDR(pap, stg_PAP_info, CCCS); return (pap); } i = i - 1; ===================================== rts/Interpreter.c ===================================== @@ -249,11 +249,10 @@ StgClosure * newEmptyPAP (Capability *cap, uint32_t arity) { StgPAP *pap = (StgPAP *)allocate(cap, sizeofW(StgPAP)); + SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); pap->arity = arity; pap->n_args = 0; pap->fun = tagged_obj; - write_barrier(); - SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); return (StgClosure *)pap; } @@ -274,7 +273,7 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap) for (i = 0; i < ((StgPAP *)pap)->n_args; i++) { pap->payload[i] = oldpap->payload[i]; } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); return (StgClosure *)pap; } @@ -483,9 +482,8 @@ eval_obj: { StgUpdateFrame *__frame; __frame = (StgUpdateFrame *)Sp; - __frame->updatee = (StgClosure *)(ap); - write_barrier(); SET_INFO((StgClosure *)__frame, (StgInfoTable *)&stg_upd_frame_info); + __frame->updatee = (StgClosure *)(ap); } ENTER_CCS_THUNK(cap,ap); @@ -811,7 +809,7 @@ do_apply: for (i = 0; i < m; i++) { new_pap->payload[pap->n_args + i] = (StgClosure *)SpW(i); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)new_pap; Sp_addW(m); @@ -854,7 +852,7 @@ do_apply: for (i = 0; i < m; i++) { pap->payload[i] = (StgClosure *)SpW(i); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)pap; Sp_addW(m); @@ -1099,7 +1097,7 @@ run_BCO: new_aps->payload[i] = (StgClosure *)SpW(i-2); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS); // Arrange the stack to call the breakpoint IO action, and @@ -1428,10 +1426,11 @@ run_BCO: StgAP* ap; int n_payload = BCO_NEXT; ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); + SpW(-1) = (W_)ap; ap->n_args = n_payload; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(ap, &stg_AP_info, cap->r.rCCCS) - SpW(-1) = (W_)ap; Sp_subW(1); goto nextInsn; } @@ -1440,10 +1439,11 @@ run_BCO: StgAP* ap; int n_payload = BCO_NEXT; ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); + SpW(-1) = (W_)ap; ap->n_args = n_payload; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS) - SpW(-1) = (W_)ap; Sp_subW(1); goto nextInsn; } @@ -1453,11 +1453,12 @@ run_BCO: int arity = BCO_NEXT; int n_payload = BCO_NEXT; pap = (StgPAP*)allocate(cap, PAP_sizeW(n_payload)); + SpW(-1) = (W_)pap; pap->n_args = n_payload; pap->arity = arity; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS) - SpW(-1) = (W_)pap; Sp_subW(1); goto nextInsn; } @@ -1538,7 +1539,8 @@ run_BCO: } Sp_addW(n_words); Sp_subW(1); - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS); SpW(0) = (W_)con; IF_DEBUG(interpreter, ===================================== rts/Messages.c ===================================== @@ -28,7 +28,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) #if defined(DEBUG) { const StgInfoTable *i = msg->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (i != &stg_MSG_THROWTO_info && i != &stg_MSG_BLACKHOLE_info && i != &stg_MSG_TRY_WAKEUP_info && @@ -71,7 +71,7 @@ executeMessage (Capability *cap, Message *m) loop: write_barrier(); // allow m->header to be modified by another thread i = m->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (i == &stg_MSG_TRY_WAKEUP_info) { StgTSO *tso = ((MessageWakeup *)m)->tso; @@ -175,7 +175,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) "blackhole %p", (W_)msg->tso->id, msg->bh); info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h // If we got this message in our inbox, it might be that the // BLACKHOLE has already been updated, and GC has shorted out the @@ -199,7 +199,7 @@ loop: // and turns this into an infinite loop. p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee)); info = p->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (info == &stg_IND_info) { @@ -241,8 +241,11 @@ loop: // a collision to update a BLACKHOLE and a BLOCKING_QUEUE // becomes orphaned (see updateThunk()). bq->link = owner->bq; - write_barrier(); SET_HDR(bq, &stg_BLOCKING_QUEUE_DIRTY_info, CCS_SYSTEM); + // We are about to make the newly-constructed message visible to other cores; + // a barrier is necessary to ensure that all writes are visible. + // See Note [Heap memory barriers] in SMP.h. + write_barrier(); owner->bq = bq; dirty_TSO(cap, owner); // we modified owner->bq @@ -291,11 +294,14 @@ loop: msg->link = bq->queue; bq->queue = msg; + // No barrier is necessary here: we are only exposing the + // closure to the GC. See Note [Heap memory barriers] in SMP.h. recordClosureMutated(cap,(StgClosure*)msg); if (info == &stg_BLOCKING_QUEUE_CLEAN_info) { - write_barrier(); bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; + // No barrier is necessary here: we are only exposing the + // closure to the GC. See Note [Heap memory barriers] in SMP.h. recordClosureMutated(cap,(StgClosure*)bq); } @@ -325,7 +331,7 @@ StgTSO * blackHoleOwner (StgClosure *bh) StgClosure *p; info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // XXX if (info != &stg_BLACKHOLE_info && info != &stg_CAF_BLACKHOLE_info && @@ -341,7 +347,7 @@ loop: // and turns this into an infinite loop. p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee)); info = p->header.info; - load_load_barrier(); + load_load_barrier(); // XXX if (info == &stg_IND_info) goto loop; ===================================== rts/PrimOps.cmm ===================================== @@ -65,9 +65,8 @@ stg_newByteArrayzh ( W_ n ) jump stg_raisezh(base_GHCziIOziException_heapOverflow_closure); } TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0); - StgArrBytes_bytes(p) = n; - prim_write_barrier; SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -103,9 +102,9 @@ stg_newPinnedByteArrayzh ( W_ n ) to BA_ALIGN bytes: */ p = p + ((-p - SIZEOF_StgArrBytes) & BA_MASK); - StgArrBytes_bytes(p) = n; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -146,9 +145,9 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) is a power of 2, which is technically not guaranteed */ p = p + ((-p - SIZEOF_StgArrBytes) & (alignment - 1)); - StgArrBytes_bytes(p) = n; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -257,6 +256,8 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) } TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); + /* No write barrier needed since this is a new allocation. */ + SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; @@ -269,9 +270,6 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); - return (arr); } @@ -283,13 +281,11 @@ stg_unsafeThawArrayzh ( gcptr arr ) // mut_list so no need to add it again. MUT_ARR_PTRS_FROZEN_CLEAN means it's // not and we should add it to a mut_list. if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN_DIRTY_info) { - prim_write_barrier; // see below: SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); // must be done after SET_INFO, because it ASSERTs closure_MUTABLE(): recordMutable(arr); return (arr); } else { - prim_write_barrier; SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); return (arr); } @@ -377,6 +373,7 @@ stg_newArrayArrayzh ( W_ n /* words */ ) } TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); + SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]); StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; @@ -389,9 +386,6 @@ stg_newArrayArrayzh ( W_ n /* words */ ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]); - return (arr); } @@ -414,6 +408,8 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) } TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); + /* No write barrier needed since this is a new allocation. */ + SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS); StgSmallMutArrPtrs_ptrs(arr) = n; // Initialise all elements of the array with the value in R2 @@ -428,9 +424,6 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS); - return (arr); } @@ -439,13 +432,11 @@ stg_unsafeThawSmallArrayzh ( gcptr arr ) // See stg_unsafeThawArrayzh if (StgHeader_info(arr) != stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info) { SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - prim_write_barrier; recordMutable(arr); // must be done after SET_INFO, because it ASSERTs closure_MUTABLE() return (arr); } else { SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - prim_write_barrier; return (arr); } } @@ -475,14 +466,13 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n) { W_ dst_p, src_p, bytes; + SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); + dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); bytes = WDS(n); prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); - prim_write_barrier; - SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - return (); } @@ -490,6 +480,8 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n { W_ dst_p, src_p, bytes; + SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); + dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); bytes = WDS(n); @@ -499,9 +491,6 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); } - prim_write_barrier; - SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - return (); } @@ -537,9 +526,9 @@ stg_newMutVarzh ( gcptr init ) ALLOC_PRIM_P (SIZEOF_StgMutVar, stg_newMutVarzh, init); mv = Hp - SIZEOF_StgMutVar + WDS(1); - StgMutVar_var(mv) = init; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS); + StgMutVar_var(mv) = init; return (mv); } @@ -622,18 +611,16 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f ) TICK_ALLOC_THUNK_2(); CCCS_ALLOC(THUNK_2_SIZE); z = Hp - THUNK_2_SIZE + WDS(1); + SET_HDR(z, stg_ap_2_upd_info, CCCS); LDV_RECORD_CREATE(z); StgThunk_payload(z,0) = f; - prim_write_barrier; - SET_HDR(z, stg_ap_2_upd_info, CCCS); TICK_ALLOC_THUNK_1(); CCCS_ALLOC(THUNK_1_SIZE); y = z - THUNK_1_SIZE; + SET_HDR(y, stg_sel_0_upd_info, CCCS); LDV_RECORD_CREATE(y); StgThunk_payload(y,0) = z; - prim_write_barrier; - SET_HDR(y, stg_sel_0_upd_info, CCCS); retry: x = StgMutVar_var(mv); @@ -683,10 +670,9 @@ stg_atomicModifyMutVarzuzh ( gcptr mv, gcptr f ) TICK_ALLOC_THUNK(); CCCS_ALLOC(THUNK_SIZE); z = Hp - THUNK_SIZE + WDS(1); + SET_HDR(z, stg_ap_2_upd_info, CCCS); LDV_RECORD_CREATE(z); StgThunk_payload(z,0) = f; - prim_write_barrier; - SET_HDR(z, stg_ap_2_upd_info, CCCS); retry: x = StgMutVar_var(mv); @@ -719,6 +705,8 @@ stg_mkWeakzh ( gcptr key, ALLOC_PRIM (SIZEOF_StgWeak) w = Hp - SIZEOF_StgWeak + WDS(1); + // No memory barrier needed as this is a new allocation. + SET_HDR(w, stg_WEAK_info, CCCS); StgWeak_key(w) = key; StgWeak_value(w) = value; @@ -726,10 +714,6 @@ stg_mkWeakzh ( gcptr key, StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure; StgWeak_link(w) = Capability_weak_ptr_list_hd(MyCapability()); - - prim_write_barrier; - SET_HDR(w, stg_WEAK_info, CCCS); - Capability_weak_ptr_list_hd(MyCapability()) = w; if (Capability_weak_ptr_list_tl(MyCapability()) == NULL) { Capability_weak_ptr_list_tl(MyCapability()) = w; @@ -756,15 +740,13 @@ stg_addCFinalizzerToWeakzh ( W_ fptr, // finalizer ALLOC_PRIM (SIZEOF_StgCFinalizerList) c = Hp - SIZEOF_StgCFinalizerList + WDS(1); + SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS); StgCFinalizerList_fptr(c) = fptr; StgCFinalizerList_ptr(c) = ptr; StgCFinalizerList_eptr(c) = eptr; StgCFinalizerList_flag(c) = flag; - prim_write_barrier; - SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS); - LOCK_CLOSURE(w, info); if (info == stg_DEAD_WEAK_info) { @@ -1485,12 +1467,12 @@ stg_newMVarzh () ALLOC_PRIM_ (SIZEOF_StgMVar, stg_newMVarzh); mvar = Hp - SIZEOF_StgMVar + WDS(1); + // No memory barrier needed as this is a new allocation. + SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS); + // MVARs start dirty: generation 0 has no mutable list StgMVar_head(mvar) = stg_END_TSO_QUEUE_closure; StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure; - prim_write_barrier; - SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS); - // MVARs start dirty: generation 0 has no mutable list return (mvar); } @@ -1534,9 +1516,10 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ ) StgMVarTSOQueue_link(q) = END_TSO_QUEUE; StgMVarTSOQueue_tso(q) = CurrentTSO; - - prim_write_barrier; SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); + // Write barrier before we make the new MVAR_TSO_QUEUE + // visible to other cores. + prim_write_barrier; if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { StgMVar_head(mvar) = q; @@ -1958,10 +1941,10 @@ stg_makeStableNamezh ( P_ obj ) // too complicated and doesn't buy us much. See D5342?id=18700.) ("ptr" sn_obj) = ccall allocate(MyCapability() "ptr", BYTES_TO_WDS(SIZEOF_StgStableName)); + SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); StgStableName_sn(sn_obj) = index; - snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj; prim_write_barrier; - SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); + snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj; } else { sn_obj = snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry); } @@ -2002,6 +1985,8 @@ stg_newBCOzh ( P_ instrs, ALLOC_PRIM (bytes); bco = Hp - bytes + WDS(1); + // No memory barrier necessary as this is a new allocation. + SET_HDR(bco, stg_BCO_info, CCS_MAIN); StgBCO_instrs(bco) = instrs; StgBCO_literals(bco) = literals; @@ -2019,9 +2004,6 @@ for: goto for; } - prim_write_barrier; - SET_HDR(bco, stg_BCO_info, CCS_MAIN); - return (bco); } @@ -2040,13 +2022,12 @@ stg_mkApUpd0zh ( P_ bco ) CCCS_ALLOC(SIZEOF_StgAP); ap = Hp - SIZEOF_StgAP + WDS(1); + // No memory barrier necessary as this is a new allocation. + SET_HDR(ap, stg_AP_info, CCS_MAIN); StgAP_n_args(ap) = HALF_W_(0); StgAP_fun(ap) = bco; - prim_write_barrier; - SET_HDR(ap, stg_AP_info, CCS_MAIN); - return (ap); } @@ -2075,6 +2056,7 @@ stg_unpackClosurezh ( P_ closure ) dat_arr = Hp - dat_arr_sz + WDS(1); + SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS); StgArrBytes_bytes(dat_arr) = WDS(len); p = 0; for: @@ -2089,9 +2071,6 @@ for: // Follow the pointers ("ptr" ptrArray) = foreign "C" heap_view_closurePtrs(MyCapability() "ptr", clos "ptr"); - prim_write_barrier; - SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS); - return (info, dat_arr, ptrArray); } ===================================== rts/RaiseAsync.c ===================================== @@ -870,7 +870,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); TICK_ALLOC_UP_THK(WDS(words+1),0); @@ -922,7 +922,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_NOUPD_info,stack->header.prof.ccs); TICK_ALLOC_SE_THK(WDS(words+1),0); @@ -961,7 +961,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1); TICK_ALLOC_SE_THK(WDS(1),0); - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs); raise->payload[0] = exception; @@ -1042,9 +1042,8 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, atomically = (StgThunk*)allocate(cap,sizeofW(StgThunk)+1); TICK_ALLOC_SE_THK(1,0); - atomically->payload[0] = af->code; - write_barrier(); SET_HDR(atomically,&stg_atomically_info,af->header.prof.ccs); + atomically->payload[0] = af->code; // discard stack up to and including the ATOMICALLY_FRAME frame += sizeofW(StgAtomicallyFrame); ===================================== rts/RtsAPI.c ===================================== @@ -30,9 +30,8 @@ HaskellObj rts_mkChar (Capability *cap, HsChar c) { StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(StgChar)c; - write_barrier(); SET_HDR(p, Czh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(StgChar)c; return p; } @@ -40,9 +39,8 @@ HaskellObj rts_mkInt (Capability *cap, HsInt i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); SET_HDR(p, Izh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgInt)i; return p; } @@ -50,10 +48,9 @@ HaskellObj rts_mkInt8 (Capability *cap, HsInt8 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); + SET_HDR(p, I8zh_con_info, CCS_SYSTEM); /* Make sure we mask out the bits above the lowest 8 */ p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); - SET_HDR(p, I8zh_con_info, CCS_SYSTEM); return p; } @@ -61,10 +58,9 @@ HaskellObj rts_mkInt16 (Capability *cap, HsInt16 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); + SET_HDR(p, I16zh_con_info, CCS_SYSTEM); /* Make sure we mask out the relevant bits */ p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); - SET_HDR(p, I16zh_con_info, CCS_SYSTEM); return p; } @@ -72,9 +68,8 @@ HaskellObj rts_mkInt32 (Capability *cap, HsInt32 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); SET_HDR(p, I32zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgInt)i; return p; } @@ -82,9 +77,8 @@ HaskellObj rts_mkInt64 (Capability *cap, HsInt64 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); - ASSIGN_Int64((P_)&(p->payload[0]), i); - write_barrier(); SET_HDR(p, I64zh_con_info, CCS_SYSTEM); + ASSIGN_Int64((P_)&(p->payload[0]), i); return p; } @@ -92,9 +86,8 @@ HaskellObj rts_mkWord (Capability *cap, HsWord i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)i; - write_barrier(); SET_HDR(p, Wzh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)i; return p; } @@ -103,9 +96,8 @@ rts_mkWord8 (Capability *cap, HsWord8 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xff); - write_barrier(); SET_HDR(p, W8zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xff); return p; } @@ -114,9 +106,8 @@ rts_mkWord16 (Capability *cap, HsWord16 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff); - write_barrier(); SET_HDR(p, W16zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff); return p; } @@ -125,9 +116,8 @@ rts_mkWord32 (Capability *cap, HsWord32 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff); - write_barrier(); SET_HDR(p, W32zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff); return p; } @@ -136,9 +126,8 @@ rts_mkWord64 (Capability *cap, HsWord64 w) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); /* see mk_Int8 comment */ - ASSIGN_Word64((P_)&(p->payload[0]), w); - write_barrier(); SET_HDR(p, W64zh_con_info, CCS_SYSTEM); + ASSIGN_Word64((P_)&(p->payload[0]), w); return p; } @@ -147,9 +136,8 @@ HaskellObj rts_mkFloat (Capability *cap, HsFloat f) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - ASSIGN_FLT((P_)p->payload, (StgFloat)f); - write_barrier(); SET_HDR(p, Fzh_con_info, CCS_SYSTEM); + ASSIGN_FLT((P_)p->payload, (StgFloat)f); return p; } @@ -157,9 +145,8 @@ HaskellObj rts_mkDouble (Capability *cap, HsDouble d) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble))); - ASSIGN_DBL((P_)p->payload, (StgDouble)d); - write_barrier(); SET_HDR(p, Dzh_con_info, CCS_SYSTEM); + ASSIGN_DBL((P_)p->payload, (StgDouble)d); return p; } @@ -167,9 +154,8 @@ HaskellObj rts_mkStablePtr (Capability *cap, HsStablePtr s) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)s; - write_barrier(); SET_HDR(p, StablePtr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)s; return p; } @@ -177,9 +163,8 @@ HaskellObj rts_mkPtr (Capability *cap, HsPtr a) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)a; - write_barrier(); SET_HDR(p, Ptr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)a; return p; } @@ -187,9 +172,8 @@ HaskellObj rts_mkFunPtr (Capability *cap, HsFunPtr a) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)a; - write_barrier(); SET_HDR(p, FunPtr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)a; return p; } @@ -218,10 +202,9 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg) // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre, // and evaluating Haskell code under a hidden cost centre leads to // confusing profiling output. (#7753) + SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); ap->payload[0] = f; ap->payload[1] = arg; - write_barrier(); - SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); return (StgClosure *)ap; } ===================================== rts/StgMiscClosures.cmm ===================================== @@ -317,8 +317,10 @@ retry: MessageBlackHole_tso(msg) = CurrentTSO; MessageBlackHole_bh(msg) = node; - prim_write_barrier; SET_HDR(msg, stg_MSG_BLACKHOLE_info, CCS_SYSTEM); + // Write barrier to ensure that writes constructing Message are + // committed before we expose to other threads. + prim_write_barrier; (r) = ccall messageBlackHole(MyCapability() "ptr", msg "ptr"); ===================================== rts/ThreadPaused.c ===================================== @@ -229,6 +229,7 @@ threadPaused(Capability *cap, StgTSO *tso) // If we've already marked this frame, then stop here. frame_info = frame->header.info; + // Ensure that read from frame->updatee below sees any pending writes load_load_barrier(); if (frame_info == (StgInfoTable *)&stg_marked_upd_frame_info) { if (prev_was_update_frame) { @@ -239,12 +240,11 @@ threadPaused(Capability *cap, StgTSO *tso) goto end; } - write_barrier(); SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info); bh = ((StgUpdateFrame *)frame)->updatee; bh_info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // XXX: Why is this needed? #if defined(THREADED_RTS) retry: ===================================== rts/Threads.c ===================================== @@ -82,14 +82,14 @@ createThread(Capability *cap, W_ size) stack_size = round_to_mblocks(size - sizeofW(StgTSO)); stack = (StgStack *)allocate(cap, stack_size); TICK_ALLOC_STACK(stack_size); + SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS); stack->stack_size = stack_size - sizeofW(StgStack); stack->sp = stack->stack + stack->stack_size; stack->dirty = 1; - write_barrier(); - SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS); tso = (StgTSO *)allocate(cap, sizeofW(StgTSO)); TICK_ALLOC_TSO(); + SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); // Always start with the compiled code evaluator tso->what_next = ThreadRunGHC; @@ -116,9 +116,6 @@ createThread(Capability *cap, W_ size) tso->prof.cccs = CCS_MAIN; #endif - write_barrier(); - SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); - // put a stop frame on the stack stack->sp -= sizeofW(StgStopFrame); SET_HDR((StgClosure*)stack->sp, @@ -129,6 +126,8 @@ createThread(Capability *cap, W_ size) ACQUIRE_LOCK(&sched_mutex); tso->id = next_thread_id++; // while we have the mutex tso->global_link = g0->threads; + /* Mutations above need no memory barrier since this lock will provide + * a release barrier */ g0->threads = tso; RELEASE_LOCK(&sched_mutex); @@ -261,8 +260,9 @@ tryWakeupThread (Capability *cap, StgTSO *tso) MessageWakeup *msg; msg = (MessageWakeup *)allocate(cap,sizeofW(MessageWakeup)); msg->tso = tso; - write_barrier(); SET_HDR(msg, &stg_MSG_TRY_WAKEUP_info, CCS_SYSTEM); + // Ensure that writes constructing Message are committed before sending. + write_barrier(); sendMessage(cap, tso->cap, (Message*)msg); debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld on cap %d", (W_)tso->id, tso->cap->no); @@ -389,8 +389,6 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) { StgBlockingQueue *bq, *next; StgClosure *p; - const StgInfoTable *bqinfo; - const StgInfoTable *pinfo; debugTraceCap(DEBUG_sched, cap, "collision occurred; checking blocking queues for thread %ld", @@ -399,8 +397,8 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) for (bq = tso->bq; bq != (StgBlockingQueue*)END_TSO_QUEUE; bq = next) { next = bq->link; - bqinfo = bq->header.info; - load_load_barrier(); + const StgInfoTable *bqinfo = bq->header.info; + load_load_barrier(); // XXX: Is this needed? if (bqinfo == &stg_IND_info) { // ToDo: could short it out right here, to avoid // traversing this IND multiple times. @@ -408,7 +406,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) } p = bq->bh; - pinfo = p->header.info; + const StgInfoTable *pinfo = p->header.info; load_load_barrier(); if (pinfo != &stg_BLACKHOLE_info || ((StgInd *)p)->indirectee != (StgClosure*)bq) @@ -609,13 +607,12 @@ threadStackOverflow (Capability *cap, StgTSO *tso) new_stack = (StgStack*) allocate(cap, chunk_size); cap->r.rCurrentTSO = NULL; + SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs); TICK_ALLOC_STACK(chunk_size); new_stack->dirty = 0; // begin clean, we'll mark it dirty below new_stack->stack_size = chunk_size - sizeofW(StgStack); new_stack->sp = new_stack->stack + new_stack->stack_size; - write_barrier(); - SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs); tso->tot_stack_size += new_stack->stack_size; @@ -664,9 +661,8 @@ threadStackOverflow (Capability *cap, StgTSO *tso) } else { new_stack->sp -= sizeofW(StgUnderflowFrame); frame = (StgUnderflowFrame*)new_stack->sp; - frame->next_chunk = old_stack; - write_barrier(); frame->info = &stg_stack_underflow_frame_info; + frame->next_chunk = old_stack; } // copy the stack chunk between tso->sp and sp to @@ -681,6 +677,8 @@ threadStackOverflow (Capability *cap, StgTSO *tso) new_stack->sp -= chunk_words; } + // No write barriers needed; all of the writes above are to structured + // owned by our capability. tso->stackobj = new_stack; // we're about to run it, better mark it dirty ===================================== rts/Updates.h ===================================== @@ -39,6 +39,12 @@ PROF_HDR_FIELDS(w_,ccs,p2) \ p_ updatee +/* + * Getting the memory barriers correct here is quite tricky. Essentially + * the write barrier ensures that any writes to the new indirectee are visible + * before we introduce the indirection. + * See Note [Heap memory barriers] in SMP.h. + */ #define updateWithIndirection(p1, p2, and_then) \ W_ bd; \ \ @@ -69,6 +75,7 @@ INLINE_HEADER void updateWithIndirection (Capability *cap, ASSERT( (P_)p1 != (P_)p2 ); /* not necessarily true: ASSERT( !closure_IND(p1) ); */ /* occurs in RaiseAsync.c:raiseAsync() */ + /* See Note [Heap memory barriers] in SMP.h */ write_barrier(); OVERWRITING_CLOSURE(p1); ((StgInd *)p1)->indirectee = p2; ===================================== rts/Weak.c ===================================== @@ -42,7 +42,6 @@ void runAllCFinalizers(StgWeak *list) { StgWeak *w; - const StgInfoTable *winfo; Task *task; task = myTask(); @@ -58,7 +57,7 @@ runAllCFinalizers(StgWeak *list) // If there's no major GC between the time that the finalizer for the // object from the oldest generation is manually called and shutdown // we end up running the same finalizer twice. See #7170. - winfo = w->header.info; + const StgInfoTable *winfo = w->header.info; load_load_barrier(); if (winfo != &stg_DEAD_WEAK_info) { runCFinalizers((StgCFinalizerList *)w->cfinalizers); @@ -129,7 +128,6 @@ scheduleFinalizers(Capability *cap, StgWeak *list) // there's a later call to finalizeWeak# on this weak pointer, // we don't run the finalizer again. SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); - write_barrier(); } n_finalizers = i; @@ -142,6 +140,8 @@ scheduleFinalizers(Capability *cap, StgWeak *list) size = n + mutArrPtrsCardTableSize(n); arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); + // No write barrier needed here; this array is only going to referred to by this core. + SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCS_SYSTEM); arr->ptrs = n; arr->size = size; @@ -157,9 +157,6 @@ scheduleFinalizers(Capability *cap, StgWeak *list) arr->payload[i] = (StgClosure *)(W_)(-1); } - write_barrier(); - SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCS_SYSTEM); - t = createIOThread(cap, RtsFlags.GcFlags.initialStkSize, rts_apply(cap, ===================================== rts/linker/MachO.c ===================================== @@ -1216,7 +1216,7 @@ ocGetNames_MachO(ObjectCode* oc) IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", oc->n_sections)); -#if defined (ios_HOST_OS) +#if defined(ios_HOST_OS) for(int i=0; i < oc->n_sections; i++) { MachOSection * section = &oc->info->macho_sections[i]; @@ -1641,7 +1641,7 @@ ocResolve_MachO(ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); -#if defined aarch64_HOST_ARCH +#if defined(aarch64_HOST_ARCH) if (!relocateSectionAarch64(oc, &oc->sections[i])) return 0; #else ===================================== rts/sm/CNF.c ===================================== @@ -373,6 +373,7 @@ compactNew (Capability *cap, StgWord size) ALLOCATE_NEW); self = firstBlockGetCompact(block); + SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM); self->autoBlockW = aligned_size / sizeof(StgWord); self->nursery = block; self->last = block; @@ -389,9 +390,6 @@ compactNew (Capability *cap, StgWord size) debugTrace(DEBUG_compact, "compactNew: size %" FMT_Word, size); - write_barrier(); - SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM); - return self; } ===================================== rts/sm/Compact.c ===================================== @@ -553,8 +553,6 @@ update_fwd_large( bdescr *bd ) static /* STATIC_INLINE */ StgPtr thread_obj (const StgInfoTable *info, StgPtr p) { - load_load_barrier(); - switch (info->type) { case THUNK_0_1: return p + sizeofW(StgThunk) + 1; ===================================== rts/sm/MarkWeak.c ===================================== @@ -235,6 +235,7 @@ static bool tidyWeakList(generation *gen) for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { info = get_itbl((StgClosure *)w); + load_load_barrier(); /* There might be a DEAD_WEAK on the list if finalizeWeak# was * called on a live weak pointer object. Just remove it. ===================================== rts/sm/Scav.c ===================================== @@ -187,7 +187,6 @@ scavenge_compact(StgCompactNFData *str) str, Bdescr((P_)str)->gen_no, str->totalW * sizeof(W_)) gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_DIRTY_info; } else { @@ -453,7 +452,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -471,7 +469,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -606,7 +603,6 @@ scavenge_block (bdescr *bd) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -626,7 +622,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -679,7 +674,6 @@ scavenge_block (bdescr *bd) p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -697,7 +691,6 @@ scavenge_block (bdescr *bd) { p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -723,7 +716,6 @@ scavenge_block (bdescr *bd) } gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -745,7 +737,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -886,7 +877,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -903,7 +893,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -1010,7 +999,6 @@ scavenge_mark_stack(void) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -1030,7 +1018,6 @@ scavenge_mark_stack(void) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -1079,7 +1066,6 @@ scavenge_mark_stack(void) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1099,7 +1085,6 @@ scavenge_mark_stack(void) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1127,7 +1112,6 @@ scavenge_mark_stack(void) } gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1149,7 +1133,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1256,7 +1239,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -1273,7 +1255,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -1338,7 +1319,6 @@ scavenge_one(StgPtr p) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -1358,7 +1338,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -1407,7 +1386,6 @@ scavenge_one(StgPtr p) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1425,7 +1403,6 @@ scavenge_one(StgPtr p) // follow everything scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1453,7 +1430,6 @@ scavenge_one(StgPtr p) } gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1475,7 +1451,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1599,10 +1574,6 @@ scavenge_mutable_list(bdescr *bd, generation *gen) StgPtr p, q; uint32_t gen_no; -#if defined(DEBUG) - const StgInfoTable *pinfo; -#endif - gen_no = gen->no; gct->evac_gen_no = gen_no; for (; bd != NULL; bd = bd->link) { @@ -1611,6 +1582,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen) ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); #if defined(DEBUG) + const StgInfoTable *pinfo; switch (get_itbl((StgClosure *)p)->type) { case MUT_VAR_CLEAN: // can happen due to concurrent writeMutVars @@ -1664,7 +1636,6 @@ scavenge_mutable_list(bdescr *bd, generation *gen) scavenge_mut_arr_ptrs_marked((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ===================================== rts/sm/Storage.c ===================================== @@ -408,8 +408,9 @@ lockCAF (StgRegTable *reg, StgIndStatic *caf) // Allocate the blackhole indirection closure bh = (StgInd *)allocate(cap, sizeofW(*bh)); bh->indirectee = (StgClosure *)cap->r.rCurrentTSO; - write_barrier(); SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs); + // Ensure that above writes are visible before we introduce reference as CAF indirectee. + write_barrier(); caf->indirectee = (StgClosure *)bh; write_barrier(); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9caa7ab8f878a1a5e4c4fcf2fad15d94fb0fe56c...7857475924202b7732d4beb1d88da59b22360a57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9caa7ab8f878a1a5e4c4fcf2fad15d94fb0fe56c...7857475924202b7732d4beb1d88da59b22360a57 You're receiving 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 Jun 7 16:32:37 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 12:32:37 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 2 commits: rts: Fix memory barriers Message-ID: <5cfa91a533648_6f73fe611ab0cd4796615@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: c51a0abc by Ben Gamari at 2019-06-07T15:35:11Z rts: Fix memory barriers This reverts and fixes some of the barriers introduced in the previous patch. In particular, we only need barriers on closures which are visible to other cores. This means we can exclude barriers on newly-allocated closures. However, when we make a closure visible to other cores (e.g. by introducing a pointer to it into another possibly-visible closure) then we must first place a write barrier to ensure that other cores cannot see a partially constructed closure. - - - - - ce2d7dc9 by Ben Gamari at 2019-06-07T16:31:41Z More comments - - - - - 18 changed files: - compiler/codeGen/StgCmmBind.hs - includes/stg/SMP.h - rts/Apply.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsAPI.c - rts/StgMiscClosures.cmm - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/Weak.c - rts/sm/CNF.c - rts/sm/Compact.c - rts/sm/MarkWeak.c - rts/sm/Scav.c - rts/sm/Storage.c Changes: ===================================== compiler/codeGen/StgCmmBind.hs ===================================== @@ -632,6 +632,7 @@ emitBlackHoleCode node = do when eager_blackholing $ do emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags)) currentTSOExpr + -- See Note [Heap memory barriers] in SMP.h. emitPrimCall [] MO_WriteBarrier [] emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo)) ===================================== includes/stg/SMP.h ===================================== @@ -98,15 +98,15 @@ EXTERN_INLINE void load_load_barrier(void); /* * Note [Heap memory barriers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ * * Machines with weak memory ordering semantics have consequences for how - * closures are observed and mutated. For example, consider a closure that needs + * closures are observed and mutated. For example, consider a thunk that needs * to be updated to an indirection. In order for the indirection to be safe for * concurrent observers to enter, said observers must read the indirection's - * info table before they read the indirectee. Furthermore, the entering - * observer makes assumptions about the closure based on its info table - * contents, e.g. an INFO_TYPE of IND imples the closure has an indirectee - * pointer that is safe to follow. + * info table before they read the indirectee. Furthermore, the indirectee must + * be set before the info table pointer. This ensures that if the observer sees + * an IND info table then the indirectee is valid. * * When a closure is updated with an indirection, both its info table and its * indirectee must be written. With weak memory ordering, these two writes can @@ -145,6 +145,84 @@ EXTERN_INLINE void load_load_barrier(void); * - Read the closure's info pointer. * - Read barrier. * - Read the closure's (non-info table) fields. + * + * We must also take care when we expose a newly-allocated closure to other cores + * by writing a pointer to it to some shared data structure (e.g. an MVar#, a Message, + * or MutVar#). Specifically, we need to ensure that all writes constructing the + * closure are visible *before* the write exposing the new closure is made visible: + * + * - Allocate memory for the closure + * - Write the closure's info pointer and fields (ordering betweeen this doesn't + * matter since the closure isn't yet visible to anyone else). + * - Write barrier + * - Make closure visible to other cores + * + * Note that thread stacks are inherently thread-local and consequently allocating an + * object and introducing a reference to it to our stack needs no barrier. + * + * There are several ways in which the mutator may make a newly-allocated + * closure visible to other cores: + * + * - Eager blackholing a THUNK: + * This is protected by an explicit write barrier in the eager blackholing + * code produced by the codegen. See StgCmmBind.emitBlackHoleCode. + * + * - Lazy blackholing a THUNK: + * This is is protected by an explicit write barrier in the thread suspension + * code. See ThreadPaused.c:threadPaused. + * + * - Updating a BLACKHOLE: + * This case is protected by explicit write barriers in the the update frame + * entry code (see rts/Updates.h). + * + * - Writing to the thread's local stack, followed by the thread blocking: + * This is protected by the write barrier necessary to place the thread on + * whichever blocking queue it is blocked on: + * + * - a BLACKHOLE's BLOCKING_QUEUE: explicit barriers in + * Messages.c:messageBlackHole and Messages.c:sendMessage. + * + * - a TVAR's STM_TVAR_WATCH_QUEUE: The CAS in STM.c:unlock_stm, called by + * STM.c:stmWaitUnlock. + * + * - an MVAR's MVAR_TSO_QUEUE: explicit write barriers in the appropriate + * MVar primops (e.g. stg_takeMVarzh). + * + * - Write to a TVar#: + * This is protected by the full barrier implied by the CAS in STM.c:lock_stm. + * + * - Write to an Array#, ArrayArray#, or SmallArray#: + * This case is protected by an explicit write barrier in the code produced + * for this primop by the codegen. See StgCmmPrim.doWritePtrArrayOp and + * StgCmmPrim.doWriteSmallPtrArrayOp. Relevant issue: #12469. + * + * - Write to MutVar# via writeMutVar#: + * This case is protected by an explicit write barrier in the code produced + * for this primop by the codegen. + * + * - Write to MutVar# via atomicModifyMutVar# or casMutVar#: + * This is protected by the full barrier implied by the cmpxchg operations + * in this primops. + * + * - Write to an MVar#: + * This protected by the full barrier implied by the CAS in putMVar#. + * + * - Sending a Message to another capability: + * This is protected by the acquition and release of the target capability's + * lock in Messages.c:sendMessage. + * + * Finally, we must ensure that we flush all cores store buffers before + * entering and leaving GC, since stacks may be read by other cores. This + * happens as a side-effect of taking and release mutexes (which implies + * acquire and release barriers, respectively). + * + * N.B. recordClosureMutated places a reference to the mutated object on + * the capability-local mut_list. Consequently this does not require any memory + * barrier. + * + * During parallel GC cores are each scavenging disjoint sets of blocks and + * consequently no barriers are needed. + * */ /* ---------------------------------------------------------------------------- ===================================== rts/Apply.cmm ===================================== @@ -63,7 +63,7 @@ again: P_ untaggedfun; W_ arity; // We must obey the correct heap object observation pattern in - // note [Heap memory barriers] in SMP.h. + // Note [Heap memory barriers] in SMP.h. untaggedfun = UNTAG(fun); info = %INFO_PTR(untaggedfun); prim_read_barrier; @@ -107,6 +107,7 @@ again: CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD); P_ pap; pap = Hp - SIZEOF_StgPAP + WDS(1); + SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = arity; if (arity <= TAG_MASK) { // TODO: Shouldn't this already be tagged? If not why did we @@ -115,8 +116,6 @@ again: } StgPAP_fun(pap) = fun; StgPAP_n_args(pap) = 0; - prim_write_barrier; - SET_HDR(pap, stg_PAP_info, CCCS); return (pap); } } @@ -136,6 +135,7 @@ again: pap = Hp - size + WDS(1); // We'll lose the original PAP, so we should enter its CCS ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); + SET_HDR(pap, stg_PAP_info, CCCS); StgPAP_arity(pap) = StgPAP_arity(untaggedfun); StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); StgPAP_fun(pap) = StgPAP_fun(fun); @@ -143,8 +143,6 @@ again: i = TO_W_(StgPAP_n_args(untaggedfun)); loop: if (i == 0) { - prim_write_barrier; - SET_HDR(pap, stg_PAP_info, CCCS); return (pap); } i = i - 1; ===================================== rts/Interpreter.c ===================================== @@ -249,11 +249,10 @@ StgClosure * newEmptyPAP (Capability *cap, uint32_t arity) { StgPAP *pap = (StgPAP *)allocate(cap, sizeofW(StgPAP)); + SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); pap->arity = arity; pap->n_args = 0; pap->fun = tagged_obj; - write_barrier(); - SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); return (StgClosure *)pap; } @@ -274,7 +273,7 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap) for (i = 0; i < ((StgPAP *)pap)->n_args; i++) { pap->payload[i] = oldpap->payload[i]; } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); return (StgClosure *)pap; } @@ -483,9 +482,8 @@ eval_obj: { StgUpdateFrame *__frame; __frame = (StgUpdateFrame *)Sp; - __frame->updatee = (StgClosure *)(ap); - write_barrier(); SET_INFO((StgClosure *)__frame, (StgInfoTable *)&stg_upd_frame_info); + __frame->updatee = (StgClosure *)(ap); } ENTER_CCS_THUNK(cap,ap); @@ -811,7 +809,7 @@ do_apply: for (i = 0; i < m; i++) { new_pap->payload[pap->n_args + i] = (StgClosure *)SpW(i); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)new_pap; Sp_addW(m); @@ -854,7 +852,7 @@ do_apply: for (i = 0; i < m; i++) { pap->payload[i] = (StgClosure *)SpW(i); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)pap; Sp_addW(m); @@ -1099,7 +1097,7 @@ run_BCO: new_aps->payload[i] = (StgClosure *)SpW(i-2); } - write_barrier(); + // No write barrier is needed here as this is a new allocation SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS); // Arrange the stack to call the breakpoint IO action, and @@ -1428,10 +1426,11 @@ run_BCO: StgAP* ap; int n_payload = BCO_NEXT; ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); + SpW(-1) = (W_)ap; ap->n_args = n_payload; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(ap, &stg_AP_info, cap->r.rCCCS) - SpW(-1) = (W_)ap; Sp_subW(1); goto nextInsn; } @@ -1440,10 +1439,11 @@ run_BCO: StgAP* ap; int n_payload = BCO_NEXT; ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); + SpW(-1) = (W_)ap; ap->n_args = n_payload; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS) - SpW(-1) = (W_)ap; Sp_subW(1); goto nextInsn; } @@ -1453,11 +1453,12 @@ run_BCO: int arity = BCO_NEXT; int n_payload = BCO_NEXT; pap = (StgPAP*)allocate(cap, PAP_sizeW(n_payload)); + SpW(-1) = (W_)pap; pap->n_args = n_payload; pap->arity = arity; - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS) - SpW(-1) = (W_)pap; Sp_subW(1); goto nextInsn; } @@ -1538,7 +1539,8 @@ run_BCO: } Sp_addW(n_words); Sp_subW(1); - write_barrier(); + // No write barrier is needed here as this is a new allocation + // visible only from our stack SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS); SpW(0) = (W_)con; IF_DEBUG(interpreter, ===================================== rts/Messages.c ===================================== @@ -28,7 +28,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) #if defined(DEBUG) { const StgInfoTable *i = msg->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (i != &stg_MSG_THROWTO_info && i != &stg_MSG_BLACKHOLE_info && i != &stg_MSG_TRY_WAKEUP_info && @@ -71,7 +71,7 @@ executeMessage (Capability *cap, Message *m) loop: write_barrier(); // allow m->header to be modified by another thread i = m->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (i == &stg_MSG_TRY_WAKEUP_info) { StgTSO *tso = ((MessageWakeup *)m)->tso; @@ -175,7 +175,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) "blackhole %p", (W_)msg->tso->id, msg->bh); info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h // If we got this message in our inbox, it might be that the // BLACKHOLE has already been updated, and GC has shorted out the @@ -199,7 +199,7 @@ loop: // and turns this into an infinite loop. p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee)); info = p->header.info; - load_load_barrier(); + load_load_barrier(); // See Note [Heap memory barriers] in SMP.h if (info == &stg_IND_info) { @@ -241,8 +241,11 @@ loop: // a collision to update a BLACKHOLE and a BLOCKING_QUEUE // becomes orphaned (see updateThunk()). bq->link = owner->bq; - write_barrier(); SET_HDR(bq, &stg_BLOCKING_QUEUE_DIRTY_info, CCS_SYSTEM); + // We are about to make the newly-constructed message visible to other cores; + // a barrier is necessary to ensure that all writes are visible. + // See Note [Heap memory barriers] in SMP.h. + write_barrier(); owner->bq = bq; dirty_TSO(cap, owner); // we modified owner->bq @@ -260,7 +263,7 @@ loop: } // point to the BLOCKING_QUEUE from the BLACKHOLE - write_barrier(); // make the BQ visible + write_barrier(); // make the BQ visible, see Note [Heap memory barriers]. ((StgInd*)bh)->indirectee = (StgClosure *)bq; recordClosureMutated(cap,bh); // bh was mutated @@ -291,11 +294,14 @@ loop: msg->link = bq->queue; bq->queue = msg; + // No barrier is necessary here: we are only exposing the + // closure to the GC. See Note [Heap memory barriers] in SMP.h. recordClosureMutated(cap,(StgClosure*)msg); if (info == &stg_BLOCKING_QUEUE_CLEAN_info) { - write_barrier(); bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; + // No barrier is necessary here: we are only exposing the + // closure to the GC. See Note [Heap memory barriers] in SMP.h. recordClosureMutated(cap,(StgClosure*)bq); } @@ -325,7 +331,7 @@ StgTSO * blackHoleOwner (StgClosure *bh) StgClosure *p; info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // XXX if (info != &stg_BLACKHOLE_info && info != &stg_CAF_BLACKHOLE_info && @@ -341,7 +347,7 @@ loop: // and turns this into an infinite loop. p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee)); info = p->header.info; - load_load_barrier(); + load_load_barrier(); // XXX if (info == &stg_IND_info) goto loop; ===================================== rts/PrimOps.cmm ===================================== @@ -65,9 +65,8 @@ stg_newByteArrayzh ( W_ n ) jump stg_raisezh(base_GHCziIOziException_heapOverflow_closure); } TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0); - StgArrBytes_bytes(p) = n; - prim_write_barrier; SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -103,9 +102,9 @@ stg_newPinnedByteArrayzh ( W_ n ) to BA_ALIGN bytes: */ p = p + ((-p - SIZEOF_StgArrBytes) & BA_MASK); - StgArrBytes_bytes(p) = n; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -146,9 +145,9 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) is a power of 2, which is technically not guaranteed */ p = p + ((-p - SIZEOF_StgArrBytes) & (alignment - 1)); - StgArrBytes_bytes(p) = n; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(p, stg_ARR_WORDS_info, CCCS); + StgArrBytes_bytes(p) = n; return (p); } @@ -257,6 +256,8 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) } TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); + /* No write barrier needed since this is a new allocation. */ + SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; @@ -269,9 +270,6 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); - return (arr); } @@ -283,13 +281,11 @@ stg_unsafeThawArrayzh ( gcptr arr ) // mut_list so no need to add it again. MUT_ARR_PTRS_FROZEN_CLEAN means it's // not and we should add it to a mut_list. if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN_DIRTY_info) { - prim_write_barrier; // see below: SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); // must be done after SET_INFO, because it ASSERTs closure_MUTABLE(): recordMutable(arr); return (arr); } else { - prim_write_barrier; SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); return (arr); } @@ -377,6 +373,7 @@ stg_newArrayArrayzh ( W_ n /* words */ ) } TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); + SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]); StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; @@ -389,9 +386,6 @@ stg_newArrayArrayzh ( W_ n /* words */ ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]); - return (arr); } @@ -414,6 +408,8 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) } TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); + /* No write barrier needed since this is a new allocation. */ + SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS); StgSmallMutArrPtrs_ptrs(arr) = n; // Initialise all elements of the array with the value in R2 @@ -428,9 +424,6 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) goto for; } - prim_write_barrier; - SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS); - return (arr); } @@ -439,13 +432,11 @@ stg_unsafeThawSmallArrayzh ( gcptr arr ) // See stg_unsafeThawArrayzh if (StgHeader_info(arr) != stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info) { SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - prim_write_barrier; recordMutable(arr); // must be done after SET_INFO, because it ASSERTs closure_MUTABLE() return (arr); } else { SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - prim_write_barrier; return (arr); } } @@ -475,14 +466,13 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n) { W_ dst_p, src_p, bytes; + SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); + dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); bytes = WDS(n); prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); - prim_write_barrier; - SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - return (); } @@ -490,6 +480,8 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n { W_ dst_p, src_p, bytes; + SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); + dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); bytes = WDS(n); @@ -499,9 +491,6 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); } - prim_write_barrier; - SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); - return (); } @@ -537,9 +526,9 @@ stg_newMutVarzh ( gcptr init ) ALLOC_PRIM_P (SIZEOF_StgMutVar, stg_newMutVarzh, init); mv = Hp - SIZEOF_StgMutVar + WDS(1); - StgMutVar_var(mv) = init; - prim_write_barrier; + /* No write barrier needed since this is a new allocation. */ SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS); + StgMutVar_var(mv) = init; return (mv); } @@ -622,18 +611,16 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f ) TICK_ALLOC_THUNK_2(); CCCS_ALLOC(THUNK_2_SIZE); z = Hp - THUNK_2_SIZE + WDS(1); + SET_HDR(z, stg_ap_2_upd_info, CCCS); LDV_RECORD_CREATE(z); StgThunk_payload(z,0) = f; - prim_write_barrier; - SET_HDR(z, stg_ap_2_upd_info, CCCS); TICK_ALLOC_THUNK_1(); CCCS_ALLOC(THUNK_1_SIZE); y = z - THUNK_1_SIZE; + SET_HDR(y, stg_sel_0_upd_info, CCCS); LDV_RECORD_CREATE(y); StgThunk_payload(y,0) = z; - prim_write_barrier; - SET_HDR(y, stg_sel_0_upd_info, CCCS); retry: x = StgMutVar_var(mv); @@ -683,10 +670,9 @@ stg_atomicModifyMutVarzuzh ( gcptr mv, gcptr f ) TICK_ALLOC_THUNK(); CCCS_ALLOC(THUNK_SIZE); z = Hp - THUNK_SIZE + WDS(1); + SET_HDR(z, stg_ap_2_upd_info, CCCS); LDV_RECORD_CREATE(z); StgThunk_payload(z,0) = f; - prim_write_barrier; - SET_HDR(z, stg_ap_2_upd_info, CCCS); retry: x = StgMutVar_var(mv); @@ -719,6 +705,8 @@ stg_mkWeakzh ( gcptr key, ALLOC_PRIM (SIZEOF_StgWeak) w = Hp - SIZEOF_StgWeak + WDS(1); + // No memory barrier needed as this is a new allocation. + SET_HDR(w, stg_WEAK_info, CCCS); StgWeak_key(w) = key; StgWeak_value(w) = value; @@ -726,10 +714,6 @@ stg_mkWeakzh ( gcptr key, StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure; StgWeak_link(w) = Capability_weak_ptr_list_hd(MyCapability()); - - prim_write_barrier; - SET_HDR(w, stg_WEAK_info, CCCS); - Capability_weak_ptr_list_hd(MyCapability()) = w; if (Capability_weak_ptr_list_tl(MyCapability()) == NULL) { Capability_weak_ptr_list_tl(MyCapability()) = w; @@ -756,15 +740,13 @@ stg_addCFinalizzerToWeakzh ( W_ fptr, // finalizer ALLOC_PRIM (SIZEOF_StgCFinalizerList) c = Hp - SIZEOF_StgCFinalizerList + WDS(1); + SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS); StgCFinalizerList_fptr(c) = fptr; StgCFinalizerList_ptr(c) = ptr; StgCFinalizerList_eptr(c) = eptr; StgCFinalizerList_flag(c) = flag; - prim_write_barrier; - SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS); - LOCK_CLOSURE(w, info); if (info == stg_DEAD_WEAK_info) { @@ -1485,12 +1467,12 @@ stg_newMVarzh () ALLOC_PRIM_ (SIZEOF_StgMVar, stg_newMVarzh); mvar = Hp - SIZEOF_StgMVar + WDS(1); + // No memory barrier needed as this is a new allocation. + SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS); + // MVARs start dirty: generation 0 has no mutable list StgMVar_head(mvar) = stg_END_TSO_QUEUE_closure; StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure; - prim_write_barrier; - SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS); - // MVARs start dirty: generation 0 has no mutable list return (mvar); } @@ -1534,9 +1516,10 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ ) StgMVarTSOQueue_link(q) = END_TSO_QUEUE; StgMVarTSOQueue_tso(q) = CurrentTSO; - - prim_write_barrier; SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); + // Write barrier before we make the new MVAR_TSO_QUEUE + // visible to other cores. + prim_write_barrier; if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { StgMVar_head(mvar) = q; @@ -1958,10 +1941,10 @@ stg_makeStableNamezh ( P_ obj ) // too complicated and doesn't buy us much. See D5342?id=18700.) ("ptr" sn_obj) = ccall allocate(MyCapability() "ptr", BYTES_TO_WDS(SIZEOF_StgStableName)); + SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); StgStableName_sn(sn_obj) = index; - snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj; prim_write_barrier; - SET_HDR(sn_obj, stg_STABLE_NAME_info, CCCS); + snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj; } else { sn_obj = snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry); } @@ -2002,6 +1985,8 @@ stg_newBCOzh ( P_ instrs, ALLOC_PRIM (bytes); bco = Hp - bytes + WDS(1); + // No memory barrier necessary as this is a new allocation. + SET_HDR(bco, stg_BCO_info, CCS_MAIN); StgBCO_instrs(bco) = instrs; StgBCO_literals(bco) = literals; @@ -2019,9 +2004,6 @@ for: goto for; } - prim_write_barrier; - SET_HDR(bco, stg_BCO_info, CCS_MAIN); - return (bco); } @@ -2040,13 +2022,12 @@ stg_mkApUpd0zh ( P_ bco ) CCCS_ALLOC(SIZEOF_StgAP); ap = Hp - SIZEOF_StgAP + WDS(1); + // No memory barrier necessary as this is a new allocation. + SET_HDR(ap, stg_AP_info, CCS_MAIN); StgAP_n_args(ap) = HALF_W_(0); StgAP_fun(ap) = bco; - prim_write_barrier; - SET_HDR(ap, stg_AP_info, CCS_MAIN); - return (ap); } @@ -2075,6 +2056,7 @@ stg_unpackClosurezh ( P_ closure ) dat_arr = Hp - dat_arr_sz + WDS(1); + SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS); StgArrBytes_bytes(dat_arr) = WDS(len); p = 0; for: @@ -2089,9 +2071,6 @@ for: // Follow the pointers ("ptr" ptrArray) = foreign "C" heap_view_closurePtrs(MyCapability() "ptr", clos "ptr"); - prim_write_barrier; - SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS); - return (info, dat_arr, ptrArray); } ===================================== rts/RaiseAsync.c ===================================== @@ -870,7 +870,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); TICK_ALLOC_UP_THK(WDS(words+1),0); @@ -922,7 +922,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_NOUPD_info,stack->header.prof.ccs); TICK_ALLOC_SE_THK(WDS(words+1),0); @@ -961,7 +961,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1); TICK_ALLOC_SE_THK(WDS(1),0); - write_barrier(); + write_barrier(); // XXX: Necessary? SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs); raise->payload[0] = exception; @@ -1042,9 +1042,8 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, atomically = (StgThunk*)allocate(cap,sizeofW(StgThunk)+1); TICK_ALLOC_SE_THK(1,0); - atomically->payload[0] = af->code; - write_barrier(); SET_HDR(atomically,&stg_atomically_info,af->header.prof.ccs); + atomically->payload[0] = af->code; // discard stack up to and including the ATOMICALLY_FRAME frame += sizeofW(StgAtomicallyFrame); ===================================== rts/RtsAPI.c ===================================== @@ -30,9 +30,8 @@ HaskellObj rts_mkChar (Capability *cap, HsChar c) { StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(StgChar)c; - write_barrier(); SET_HDR(p, Czh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(StgChar)c; return p; } @@ -40,9 +39,8 @@ HaskellObj rts_mkInt (Capability *cap, HsInt i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); SET_HDR(p, Izh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgInt)i; return p; } @@ -50,10 +48,9 @@ HaskellObj rts_mkInt8 (Capability *cap, HsInt8 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); + SET_HDR(p, I8zh_con_info, CCS_SYSTEM); /* Make sure we mask out the bits above the lowest 8 */ p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); - SET_HDR(p, I8zh_con_info, CCS_SYSTEM); return p; } @@ -61,10 +58,9 @@ HaskellObj rts_mkInt16 (Capability *cap, HsInt16 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); + SET_HDR(p, I16zh_con_info, CCS_SYSTEM); /* Make sure we mask out the relevant bits */ p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); - SET_HDR(p, I16zh_con_info, CCS_SYSTEM); return p; } @@ -72,9 +68,8 @@ HaskellObj rts_mkInt32 (Capability *cap, HsInt32 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgInt)i; - write_barrier(); SET_HDR(p, I32zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgInt)i; return p; } @@ -82,9 +77,8 @@ HaskellObj rts_mkInt64 (Capability *cap, HsInt64 i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); - ASSIGN_Int64((P_)&(p->payload[0]), i); - write_barrier(); SET_HDR(p, I64zh_con_info, CCS_SYSTEM); + ASSIGN_Int64((P_)&(p->payload[0]), i); return p; } @@ -92,9 +86,8 @@ HaskellObj rts_mkWord (Capability *cap, HsWord i) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)i; - write_barrier(); SET_HDR(p, Wzh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)i; return p; } @@ -103,9 +96,8 @@ rts_mkWord8 (Capability *cap, HsWord8 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xff); - write_barrier(); SET_HDR(p, W8zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xff); return p; } @@ -114,9 +106,8 @@ rts_mkWord16 (Capability *cap, HsWord16 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff); - write_barrier(); SET_HDR(p, W16zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff); return p; } @@ -125,9 +116,8 @@ rts_mkWord32 (Capability *cap, HsWord32 w) { /* see rts_mkInt* comments */ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff); - write_barrier(); SET_HDR(p, W32zh_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff); return p; } @@ -136,9 +126,8 @@ rts_mkWord64 (Capability *cap, HsWord64 w) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2)); /* see mk_Int8 comment */ - ASSIGN_Word64((P_)&(p->payload[0]), w); - write_barrier(); SET_HDR(p, W64zh_con_info, CCS_SYSTEM); + ASSIGN_Word64((P_)&(p->payload[0]), w); return p; } @@ -147,9 +136,8 @@ HaskellObj rts_mkFloat (Capability *cap, HsFloat f) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1)); - ASSIGN_FLT((P_)p->payload, (StgFloat)f); - write_barrier(); SET_HDR(p, Fzh_con_info, CCS_SYSTEM); + ASSIGN_FLT((P_)p->payload, (StgFloat)f); return p; } @@ -157,9 +145,8 @@ HaskellObj rts_mkDouble (Capability *cap, HsDouble d) { StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble))); - ASSIGN_DBL((P_)p->payload, (StgDouble)d); - write_barrier(); SET_HDR(p, Dzh_con_info, CCS_SYSTEM); + ASSIGN_DBL((P_)p->payload, (StgDouble)d); return p; } @@ -167,9 +154,8 @@ HaskellObj rts_mkStablePtr (Capability *cap, HsStablePtr s) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)s; - write_barrier(); SET_HDR(p, StablePtr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)s; return p; } @@ -177,9 +163,8 @@ HaskellObj rts_mkPtr (Capability *cap, HsPtr a) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)a; - write_barrier(); SET_HDR(p, Ptr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)a; return p; } @@ -187,9 +172,8 @@ HaskellObj rts_mkFunPtr (Capability *cap, HsFunPtr a) { StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1); - p->payload[0] = (StgClosure *)a; - write_barrier(); SET_HDR(p, FunPtr_con_info, CCS_SYSTEM); + p->payload[0] = (StgClosure *)a; return p; } @@ -218,10 +202,9 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg) // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre, // and evaluating Haskell code under a hidden cost centre leads to // confusing profiling output. (#7753) + SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); ap->payload[0] = f; ap->payload[1] = arg; - write_barrier(); - SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN); return (StgClosure *)ap; } ===================================== rts/StgMiscClosures.cmm ===================================== @@ -317,8 +317,9 @@ retry: MessageBlackHole_tso(msg) = CurrentTSO; MessageBlackHole_bh(msg) = node; - prim_write_barrier; SET_HDR(msg, stg_MSG_BLACKHOLE_info, CCS_SYSTEM); + // messageBlackHole has appropriate memory barriers when this object is exposed. + // See Note [Heap memory barriers]. (r) = ccall messageBlackHole(MyCapability() "ptr", msg "ptr"); ===================================== rts/ThreadPaused.c ===================================== @@ -229,6 +229,7 @@ threadPaused(Capability *cap, StgTSO *tso) // If we've already marked this frame, then stop here. frame_info = frame->header.info; + // Ensure that read from frame->updatee below sees any pending writes load_load_barrier(); if (frame_info == (StgInfoTable *)&stg_marked_upd_frame_info) { if (prev_was_update_frame) { @@ -239,12 +240,11 @@ threadPaused(Capability *cap, StgTSO *tso) goto end; } - write_barrier(); SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info); bh = ((StgUpdateFrame *)frame)->updatee; bh_info = bh->header.info; - load_load_barrier(); + load_load_barrier(); // XXX: Why is this needed? #if defined(THREADED_RTS) retry: ===================================== rts/Threads.c ===================================== @@ -82,14 +82,14 @@ createThread(Capability *cap, W_ size) stack_size = round_to_mblocks(size - sizeofW(StgTSO)); stack = (StgStack *)allocate(cap, stack_size); TICK_ALLOC_STACK(stack_size); + SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS); stack->stack_size = stack_size - sizeofW(StgStack); stack->sp = stack->stack + stack->stack_size; stack->dirty = 1; - write_barrier(); - SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS); tso = (StgTSO *)allocate(cap, sizeofW(StgTSO)); TICK_ALLOC_TSO(); + SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); // Always start with the compiled code evaluator tso->what_next = ThreadRunGHC; @@ -116,9 +116,6 @@ createThread(Capability *cap, W_ size) tso->prof.cccs = CCS_MAIN; #endif - write_barrier(); - SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); - // put a stop frame on the stack stack->sp -= sizeofW(StgStopFrame); SET_HDR((StgClosure*)stack->sp, @@ -129,6 +126,8 @@ createThread(Capability *cap, W_ size) ACQUIRE_LOCK(&sched_mutex); tso->id = next_thread_id++; // while we have the mutex tso->global_link = g0->threads; + /* Mutations above need no memory barrier since this lock will provide + * a release barrier */ g0->threads = tso; RELEASE_LOCK(&sched_mutex); @@ -261,8 +260,9 @@ tryWakeupThread (Capability *cap, StgTSO *tso) MessageWakeup *msg; msg = (MessageWakeup *)allocate(cap,sizeofW(MessageWakeup)); msg->tso = tso; - write_barrier(); SET_HDR(msg, &stg_MSG_TRY_WAKEUP_info, CCS_SYSTEM); + // Ensure that writes constructing Message are committed before sending. + write_barrier(); sendMessage(cap, tso->cap, (Message*)msg); debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld on cap %d", (W_)tso->id, tso->cap->no); @@ -389,8 +389,6 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) { StgBlockingQueue *bq, *next; StgClosure *p; - const StgInfoTable *bqinfo; - const StgInfoTable *pinfo; debugTraceCap(DEBUG_sched, cap, "collision occurred; checking blocking queues for thread %ld", @@ -399,8 +397,8 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) for (bq = tso->bq; bq != (StgBlockingQueue*)END_TSO_QUEUE; bq = next) { next = bq->link; - bqinfo = bq->header.info; - load_load_barrier(); + const StgInfoTable *bqinfo = bq->header.info; + load_load_barrier(); // XXX: Is this needed? if (bqinfo == &stg_IND_info) { // ToDo: could short it out right here, to avoid // traversing this IND multiple times. @@ -408,7 +406,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) } p = bq->bh; - pinfo = p->header.info; + const StgInfoTable *pinfo = p->header.info; load_load_barrier(); if (pinfo != &stg_BLACKHOLE_info || ((StgInd *)p)->indirectee != (StgClosure*)bq) @@ -609,13 +607,12 @@ threadStackOverflow (Capability *cap, StgTSO *tso) new_stack = (StgStack*) allocate(cap, chunk_size); cap->r.rCurrentTSO = NULL; + SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs); TICK_ALLOC_STACK(chunk_size); new_stack->dirty = 0; // begin clean, we'll mark it dirty below new_stack->stack_size = chunk_size - sizeofW(StgStack); new_stack->sp = new_stack->stack + new_stack->stack_size; - write_barrier(); - SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs); tso->tot_stack_size += new_stack->stack_size; @@ -664,9 +661,8 @@ threadStackOverflow (Capability *cap, StgTSO *tso) } else { new_stack->sp -= sizeofW(StgUnderflowFrame); frame = (StgUnderflowFrame*)new_stack->sp; - frame->next_chunk = old_stack; - write_barrier(); frame->info = &stg_stack_underflow_frame_info; + frame->next_chunk = old_stack; } // copy the stack chunk between tso->sp and sp to @@ -681,6 +677,8 @@ threadStackOverflow (Capability *cap, StgTSO *tso) new_stack->sp -= chunk_words; } + // No write barriers needed; all of the writes above are to structured + // owned by our capability. tso->stackobj = new_stack; // we're about to run it, better mark it dirty ===================================== rts/Updates.h ===================================== @@ -39,6 +39,12 @@ PROF_HDR_FIELDS(w_,ccs,p2) \ p_ updatee +/* + * Getting the memory barriers correct here is quite tricky. Essentially + * the write barrier ensures that any writes to the new indirectee are visible + * before we introduce the indirection. + * See Note [Heap memory barriers] in SMP.h. + */ #define updateWithIndirection(p1, p2, and_then) \ W_ bd; \ \ @@ -69,6 +75,7 @@ INLINE_HEADER void updateWithIndirection (Capability *cap, ASSERT( (P_)p1 != (P_)p2 ); /* not necessarily true: ASSERT( !closure_IND(p1) ); */ /* occurs in RaiseAsync.c:raiseAsync() */ + /* See Note [Heap memory barriers] in SMP.h */ write_barrier(); OVERWRITING_CLOSURE(p1); ((StgInd *)p1)->indirectee = p2; ===================================== rts/Weak.c ===================================== @@ -42,7 +42,6 @@ void runAllCFinalizers(StgWeak *list) { StgWeak *w; - const StgInfoTable *winfo; Task *task; task = myTask(); @@ -58,7 +57,7 @@ runAllCFinalizers(StgWeak *list) // If there's no major GC between the time that the finalizer for the // object from the oldest generation is manually called and shutdown // we end up running the same finalizer twice. See #7170. - winfo = w->header.info; + const StgInfoTable *winfo = w->header.info; load_load_barrier(); if (winfo != &stg_DEAD_WEAK_info) { runCFinalizers((StgCFinalizerList *)w->cfinalizers); @@ -129,7 +128,6 @@ scheduleFinalizers(Capability *cap, StgWeak *list) // there's a later call to finalizeWeak# on this weak pointer, // we don't run the finalizer again. SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); - write_barrier(); } n_finalizers = i; @@ -142,6 +140,8 @@ scheduleFinalizers(Capability *cap, StgWeak *list) size = n + mutArrPtrsCardTableSize(n); arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); + // No write barrier needed here; this array is only going to referred to by this core. + SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCS_SYSTEM); arr->ptrs = n; arr->size = size; @@ -157,9 +157,6 @@ scheduleFinalizers(Capability *cap, StgWeak *list) arr->payload[i] = (StgClosure *)(W_)(-1); } - write_barrier(); - SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCS_SYSTEM); - t = createIOThread(cap, RtsFlags.GcFlags.initialStkSize, rts_apply(cap, ===================================== rts/sm/CNF.c ===================================== @@ -373,6 +373,7 @@ compactNew (Capability *cap, StgWord size) ALLOCATE_NEW); self = firstBlockGetCompact(block); + SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM); self->autoBlockW = aligned_size / sizeof(StgWord); self->nursery = block; self->last = block; @@ -389,9 +390,6 @@ compactNew (Capability *cap, StgWord size) debugTrace(DEBUG_compact, "compactNew: size %" FMT_Word, size); - write_barrier(); - SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM); - return self; } ===================================== rts/sm/Compact.c ===================================== @@ -553,8 +553,6 @@ update_fwd_large( bdescr *bd ) static /* STATIC_INLINE */ StgPtr thread_obj (const StgInfoTable *info, StgPtr p) { - load_load_barrier(); - switch (info->type) { case THUNK_0_1: return p + sizeofW(StgThunk) + 1; ===================================== rts/sm/MarkWeak.c ===================================== @@ -235,6 +235,7 @@ static bool tidyWeakList(generation *gen) for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { info = get_itbl((StgClosure *)w); + load_load_barrier(); /* There might be a DEAD_WEAK on the list if finalizeWeak# was * called on a live weak pointer object. Just remove it. ===================================== rts/sm/Scav.c ===================================== @@ -187,7 +187,6 @@ scavenge_compact(StgCompactNFData *str) str, Bdescr((P_)str)->gen_no, str->totalW * sizeof(W_)) gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_DIRTY_info; } else { @@ -453,7 +452,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -471,7 +469,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -606,7 +603,6 @@ scavenge_block (bdescr *bd) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -626,7 +622,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -679,7 +674,6 @@ scavenge_block (bdescr *bd) p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -697,7 +691,6 @@ scavenge_block (bdescr *bd) { p = scavenge_mut_arr_ptrs((StgMutArrPtrs*)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -723,7 +716,6 @@ scavenge_block (bdescr *bd) } gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -745,7 +737,6 @@ scavenge_block (bdescr *bd) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -886,7 +877,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -903,7 +893,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -1010,7 +999,6 @@ scavenge_mark_stack(void) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -1030,7 +1018,6 @@ scavenge_mark_stack(void) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -1079,7 +1066,6 @@ scavenge_mark_stack(void) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1099,7 +1085,6 @@ scavenge_mark_stack(void) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1127,7 +1112,6 @@ scavenge_mark_stack(void) } gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1149,7 +1133,6 @@ scavenge_mark_stack(void) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1256,7 +1239,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)&mvar->value); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { mvar->header.info = &stg_MVAR_DIRTY_info; } else { @@ -1273,7 +1255,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)&tvar->first_watch_queue_entry); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { tvar->header.info = &stg_TVAR_DIRTY_info; } else { @@ -1338,7 +1319,6 @@ scavenge_one(StgPtr p) evacuate(&((StgMutVar *)p)->var); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; } else { @@ -1358,7 +1338,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure**)&bq->link); gct->eager_promotion = saved_eager_promotion; - write_barrier(); if (gct->failed_to_evac) { bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; } else { @@ -1407,7 +1386,6 @@ scavenge_one(StgPtr p) scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1425,7 +1403,6 @@ scavenge_one(StgPtr p) // follow everything scavenge_mut_arr_ptrs((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1453,7 +1430,6 @@ scavenge_one(StgPtr p) } gct->eager_promotion = saved_eager; - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info; } else { @@ -1475,7 +1451,6 @@ scavenge_one(StgPtr p) evacuate((StgClosure **)p); } - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info; } else { @@ -1599,10 +1574,6 @@ scavenge_mutable_list(bdescr *bd, generation *gen) StgPtr p, q; uint32_t gen_no; -#if defined(DEBUG) - const StgInfoTable *pinfo; -#endif - gen_no = gen->no; gct->evac_gen_no = gen_no; for (; bd != NULL; bd = bd->link) { @@ -1611,6 +1582,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen) ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); #if defined(DEBUG) + const StgInfoTable *pinfo; switch (get_itbl((StgClosure *)p)->type) { case MUT_VAR_CLEAN: // can happen due to concurrent writeMutVars @@ -1664,7 +1636,6 @@ scavenge_mutable_list(bdescr *bd, generation *gen) scavenge_mut_arr_ptrs_marked((StgMutArrPtrs *)p); - write_barrier(); if (gct->failed_to_evac) { ((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; } else { ===================================== rts/sm/Storage.c ===================================== @@ -408,8 +408,9 @@ lockCAF (StgRegTable *reg, StgIndStatic *caf) // Allocate the blackhole indirection closure bh = (StgInd *)allocate(cap, sizeofW(*bh)); bh->indirectee = (StgClosure *)cap->r.rCurrentTSO; - write_barrier(); SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs); + // Ensure that above writes are visible before we introduce reference as CAF indirectee. + write_barrier(); caf->indirectee = (StgClosure *)bh; write_barrier(); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7857475924202b7732d4beb1d88da59b22360a57...ce2d7dc9fcb4577188e343a3928e14db378601ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7857475924202b7732d4beb1d88da59b22360a57...ce2d7dc9fcb4577188e343a3928e14db378601ca You're receiving 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 Jun 7 16:35:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 12:35:54 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 66 commits: Hadrian: always generate the libffi dynlibs manifest with globbing Message-ID: <5cfa926a8c625_6f73fe5e07e55d08013a2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - d97ee47b by Travis Whitaker at 2019-06-07T16:35:44Z Correct closure observation, construction, and mutation on weak memory machines. Here the following changes are introduced: - A read barrier machine op is added to Cmm. - The order in which a closure's fields are read and written is changed. - Memory barriers are added to RTS code to ensure correctness on out-or-order machines with weak memory ordering. Cmm has a new CallishMachOp called MO_ReadBarrier. On weak memory machines, this is lowered to an instruction that ensures memory reads that occur after said instruction in program order are not performed before reads coming before said instruction in program order. On machines with strong memory ordering properties (e.g. X86, SPARC in TSO mode) no such instruction is necessary, so MO_ReadBarrier is simply erased. However, such an instruction is necessary on weakly ordered machines, e.g. ARM and PowerPC. Weam memory ordering has consequences for how closures are observed and mutated. For example, consider a closure that needs to be updated to an indirection. In order for the indirection to be safe for concurrent observers to enter, said observers must read the indirection's info table before they read the indirectee. Furthermore, the entering observer makes assumptions about the closure based on its info table contents, e.g. an INFO_TYPE of IND imples the closure has an indirectee pointer that is safe to follow. When a closure is updated with an indirection, both its info table and its indirectee must be written. With weak memory ordering, these two writes can be arbitrarily reordered, and perhaps even interleaved with other threads' reads and writes (in the absence of memory barrier instructions). Consider this example of a bad reordering: - An updater writes to a closure's info table (INFO_TYPE is now IND). - A concurrent observer branches upon reading the closure's INFO_TYPE as IND. - A concurrent observer reads the closure's indirectee and enters it. (!!!) - An updater writes the closure's indirectee. Here the update to the indirectee comes too late and the concurrent observer has jumped off into the abyss. Speculative execution can also cause us issues, consider: - An observer is about to case on a value in closure's info table. - The observer speculatively reads one or more of closure's fields. - An updater writes to closure's info table. - The observer takes a branch based on the new info table value, but with the old closure fields! - The updater writes to the closure's other fields, but its too late. Because of these effects, reads and writes to a closure's info table must be ordered carefully with respect to reads and writes to the closure's other fields, and memory barriers must be placed to ensure that reads and writes occur in program order. Specifically, updates to a closure must follow the following pattern: - Update the closure's (non-info table) fields. - Write barrier. - Update the closure's info table. Observing a closure's fields must follow the following pattern: - Read the closure's info pointer. - Read barrier. - Read the closure's (non-info table) fields. This patch updates RTS code to obey this pattern. This should fix long-standing SMP bugs on ARM (specifically newer aarch64 microarchitectures supporting out-of-order execution) and PowerPC. This fixesd issue #15449. - - - - - b8b72edf by Ben Gamari at 2019-06-07T16:35:44Z rts: Fix memory barriers This reverts and fixes some of the barriers introduced in the previous patch. In particular, we only need barriers on closures which are visible to other cores. This means we can exclude barriers on newly-allocated closures. However, when we make a closure visible to other cores (e.g. by introducing a pointer to it into another possibly-visible closure) then we must first place a write barrier to ensure that other cores cannot see a partially constructed closure. - - - - - 79166c80 by Ben Gamari at 2019-06-07T16:35:44Z More comments - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/CmmParse.y - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DriverPipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ce2d7dc9fcb4577188e343a3928e14db378601ca...79166c807194f05b27dbc9f0a40b57c5d63eb09e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ce2d7dc9fcb4577188e343a3928e14db378601ca...79166c807194f05b27dbc9f0a40b57c5d63eb09e You're receiving 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 Jun 7 16:54:40 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 07 Jun 2019 12:54:40 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cfa96d06ed3f_6f73fe61a2d9b38805627@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 17739b9a by Sebastian Graf at 2019-06-07T16:54:15Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 22 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/typecheck/TcRnTypes.hs - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - − compiler/utils/ListT.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,79 +92,38 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA - PmGrd :: { pm_grd_pv :: PatVec + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + PmGrd :: { pm_grd_pv :: PatVec -- ^ Always has 'patVecArity' 1. , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. PmFake :: PmPat 'PAT +-- | Should not face a user. instance Outputable (PmPat a) where - ppr = pprPmPatDebug + ppr (PmCon cc _arg_tys _con_tvs con_args) + = hsep [ppr cc, hsep (map ppr con_args)] + -- the @ is to differentiate (flexible) variables from rigid constructors and + -- literals + ppr (PmVar vid) = char '@' <> ppr vid + ppr (PmLit li) = ppr li + ppr (PmGrd pv ge) = hsep (map ppr pv) <+> text "<-" <+> ppr ge + ppr PmFake = text "" -- data T a where -- MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p] @@ -185,6 +144,17 @@ data Delta = MkDelta { delta_ty_cs :: Bag EvVar type ValSetAbs = [ValVec] -- ^ Value Set Abstractions type Uncovered = ValSetAbs +-- | Should not face a user. See 'pprValVecSubstituted' for that. +instance Outputable ValVec where + ppr (ValVec vva delta) = ppr vva <+> text "|>" <+> ppr_delta delta + where + ppr_delta _d = hcat [ + -- intentionally formatted this way enable the dev to comment in only + -- the info she needs + ppr (delta_tm_cs delta), + ppr (delta_ty_cs delta) + ] + -- Instead of keeping the whole sets in memory, we keep a boolean for both the -- covered and the divergent set (we store the uncovered set though, since we -- want to print it). For both the covered and the divergent we have: @@ -200,8 +170,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +187,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +198,27 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa - + ppr (PartialResult c vsa d) + = hang (text "PartialResult" <+> ppr c <+> ppr d) 2 (ppr_vsa vsa) + where + ppr_vsa = braces . fsep . punctuate comma . map ppr instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +236,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +267,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +284,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +293,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] - tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) + tracePm "checkSingle': missing" (vcat (map ppr missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered normaliseValVec us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +326,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +348,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars - tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + tracePm "checkMatches': missing" (vcat (map ppr missing)) + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered normaliseValVec us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +405,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +456,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +519,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -628,7 +568,7 @@ that we expect. pmIsSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> [Type] -- ^ The strict argument types. -> PmM (Maybe Delta) @@ -654,7 +594,7 @@ pmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do tmTyCsAreSatisfiable :: Delta -- ^ The ambient term and type constraints -- (known to be satisfiable). - -> TmEq -- ^ The new term constraint. + -> TmVarCt -- ^ The new term constraint. -> Bag EvVar -- ^ The new type constraints. -> PmM (Maybe Delta) -- ^ @'Just' delta@ if the constraints (@delta@) are @@ -671,12 +611,98 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | Tests whether the 'Id' can inhabit the given 'ConLike' in the context +-- expressed by the 'Delta'. +type InhabitationTest = Delta -> Id -> ConLike -> PmM Bool + +-- | An 'InhabitationTest' consulting 'mkOneSatisfiableConFull'. Precise, but +-- expensive. +isConSatisfiable :: InhabitationTest +isConSatisfiable delta x con = do + tracePm "conInhabitsId" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> mkOneSatisfiableConFull delta x con + +-- | Cheap 'InhabitationTest', always returning @True at . +cheapInhabitationTest :: InhabitationTest +cheapInhabitationTest _ _ _ = pure True + +normaliseValAbs :: InhabitationTest -> Delta -> ValAbs -> PmM (Maybe (Delta, ValAbs)) +normaliseValAbs is_con_inh delta = runMaybeT . go_va delta + where + go_va :: Delta -> ValAbs -> MaybeT PmM (Delta, ValAbs) + go_va delta pm at PmCon{ pm_con_args = args } = do + (delta', args') <- mapAccumLM go_va delta args + pure (delta', pm { pm_con_args = args' }) + go_va delta va@(PmVar x) + | let (ty, pacs) = lookupRefutableAltCons (delta_tm_cs delta) x + -- TODO: Even if ncons is empty, we might have a complete match ('Void', + -- constraints). Figure out how to the complete matches solely from + -- @ty at . + , ncons@(cl:_) <- [ cl | PmAltConLike cl <- pacs ] = do + grps <- lift (allCompleteMatches cl ty) + let is_grp_inh = filterM (lift . is_con_inh delta x) . (\\ ncons) + incomplete_grps <- traverse is_grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValAbs is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- @PmCon@ for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a @PmCon@ (which won't normalise + -- any further) when @p@ is just the 'cheapInhabitationTest'. + -- Thus, we have to assert satisfiability here, even if the + -- expensive 'isConSatisfiable' already did so. Also, we have to + -- store the constraints in @delta at . + (delta', ic) <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (delta', ic_val_abs ic) + _ -> pure (delta, va) + go_va delta va = pure (delta, va) + +-- | Something that normalises a 'ValVec' by consulting the given +-- 'InhabitationTest' to weed out vacuous 'ValAbs'. +-- See also 'normaliseValVecHead' and 'normaliseValVec'. +type ValVecNormaliser = InhabitationTest -> ValVec -> PmM (Maybe ValVec) + +-- | A 'ValVecNormaliser' that normalises all components of a 'ValVec'. This is +-- the 'ValVecNormaliser' to choose once at the end. +normaliseValVec :: ValVecNormaliser +normaliseValVec test (ValVec vva delta) = runMaybeT $ do + (delta', vva') <- mapAccumLM ((MaybeT .) . normaliseValAbs test) delta vva + pure (ValVec vva' delta') + +-- | A 'ValVecNormaliser' that only tries to normalise the head of each +-- 'ValVec'. This is mandatory for pattern guards, where we call 'utail' on the +-- temporarily extended 'ValVec', hence there's no way to delay this check. +-- Of course we could 'normaliseValVec' instead, but that's unnecessarily +-- expensive. +normaliseValVecHead :: ValVecNormaliser +normaliseValVecHead _ vva@(ValVec [] _) = pure (Just vva) +normaliseValVecHead test (ValVec (va:vva) delta) = runMaybeT $ do + (delta', va') <- MaybeT (normaliseValAbs test delta va) + pure (ValVec (va':vva) delta') + +-- | This weeds out 'ValVec's with 'PmVar's where at least one COMPLETE set is +-- rendered vacuous by equality constraints, by calling out the given +-- 'ValVecNormaliser' with different 'InhabitationTest's. +-- +-- This is quite costly due to the many oracle queries, so we only call this at +-- the last possible moment. I.e., with 'normaliseValVecHead' when leaving a +-- pattern guard and with 'normaliseValVec' on the final uncovered set. +normaliseUncovered :: ValVecNormaliser -> Uncovered -> PmM Uncovered +normaliseUncovered normalise_val_vec us = do + -- We'll first do a cheap sweep without consulting the oracles + us1 <- mapMaybeM (normalise_val_vec cheapInhabitationTest) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + us2 <- mapMaybeM (normalise_val_vec isConSatisfiable) us1 + tracePm "normaliseUncovered" (vcat (map ppr us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +859,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +873,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +883,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +893,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +951,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +959,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +968,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +993,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1072,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1209,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1270,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1290,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1319,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1327,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1340,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1452,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1481,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1464,7 +1495,7 @@ pmPatType PmFake = pmPatType truePattern data InhabitationCandidate = InhabitationCandidate { ic_val_abs :: ValAbs - , ic_tm_ct :: TmEq + , ic_tm_ct :: TmVarCt , ic_ty_cs :: Bag EvVar , ic_strict_arg_tys :: [Type] } @@ -1477,10 +1508,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1634,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1685,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,52 +1725,54 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate { ic_val_abs = con_abs - , ic_tm_ct = (x, vaToPmExpr con_abs) + , ic_tm_ct = TVC x (vaToPmExpr con_abs) , ic_ty_cs = listToBag evvars , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe (Delta, InhabitationCandidate)) +mkOneSatisfiableConFull delta x con = do + ic <- mkOneConFull x con + ((,ic) <$>) <$> pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmEq -mkPosEq x l = (x, PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) -mkIdEq :: Id -> TmEq -mkIdEq x = (x, PmExprVar (idName x)) +mkIdEq :: Id -> TmVarCt +mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1781,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1792,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1808,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1854,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1956,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,10 +2038,11 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheck" (ppr n <> colon + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr vva) res <- pmcheck ps guards vva tracePm "pmCheckResult:" (ppr res) return res @@ -1986,7 +2051,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,12 +2059,12 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p - $$ pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprPmPatDebug va - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheckHdI" (ppr n <> colon <+> ppr p + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr va + $$ ppr vva) res <- pmcheckHd p ps guards va vva tracePm "pmCheckHdI: res" (ppr res) @@ -2024,10 +2089,15 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + -- The heads of the ValVecs in the uncovered set might be vacuous, so + -- normalise them + us <- normaliseUncovered normaliseValVecHead (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2109,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2054,7 +2123,7 @@ pmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -- Var pmcheckHd (PmVar x) ps guards va (ValVec vva delta) - | Just tm_state <- solveOneEq (delta_tm_cs delta) (x, vaToPmExpr va) + | Just tm_state <- solveOneEq (delta_tm_cs delta) (TVC x (vaToPmExpr va)) = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state})) | otherwise = return mempty @@ -2077,72 +2146,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2202,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2213,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2368,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2378,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2397,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2418,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2403,22 +2452,22 @@ these constraints. genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee -> [Pat GhcTc] -- LHS (should have length 1) -> [Id] -- MatchVars (should have length 1) - -> DsM (Bag TmEq) + -> DsM (Bag TmVarCt) genCaseTmCs2 Nothing _ _ = return emptyBag genCaseTmCs2 (Just scr) [p] [var] = do fam_insts <- dsGetFamInstEnvs [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p let scr_e = lhsExprToPmExpr scr - return $ listToBag [(var, e), (var, scr_e)] + return $ listToBag [(TVC var e), (TVC var scr_e)] genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase" -- | Generate a simple equality when checking a case expression: -- case x of { matches } -- When checking matches we record that (x ~ y) where y is the initial -- uncovered. All matches will have to satisfy this equality. -genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmEq +genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag TmVarCt genCaseTmCs1 Nothing _ = emptyBag -genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr) +genCaseTmCs1 (Just scr) [var] = unitBag (TVC var (lhsExprToPmExpr scr)) genCaseTmCs1 _ _ = panic "genCaseTmCs1: HsCase" {- Note [Literals in PmPat] @@ -2478,23 +2527,23 @@ isAnyPmCheckEnabled :: DynFlags -> DsMatchContext -> Bool isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind -instance Outputable ValVec where - ppr (ValVec vva delta) - = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in pprUncovered (vector, refuts) +pprValVecSubstituted :: ValVec -> SDoc +pprValVecSubstituted (ValVec vva delta) = pprUncovered (vector, refuts) + where + (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). -substInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr] +substInValAbs :: TmVarCtEnv -> [ValAbs] -> [PmExpr] substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) -- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2560,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2571,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2536,7 +2582,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" - _missing -> let us = map ppr qs + _missing -> let us = map pprValVecSubstituted qs in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -2637,39 +2683,8 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags Opt_D_dump_ec_trace (text herald $$ (nest 2 doc)) - - -pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) - = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] -pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid -pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl -pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) - <+> ppr ge -pprPmPatDebug PmFake = text "PmFake" - -pprPatVec :: PatVec -> SDoc -pprPatVec ps = hang (text "Pattern:") 2 - (brackets $ sep - $ punctuate (comma <> char '\n') (map pprPmPatDebug ps)) - -pprValAbs :: [ValAbs] -> SDoc -pprValAbs ps = hang (text "ValAbs:") 2 - (brackets $ sep - $ punctuate (comma) (map pprPmPatDebug ps)) - -pprValVecDebug :: ValVec -> SDoc -pprValVecDebug (ValVec vas _d) = text "ValVec" <+> - parens (pprValAbs vas) - -- $$ ppr (delta_tm_cs _d) - -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/DsMonad.hs ===================================== @@ -396,11 +396,11 @@ addDictsDs ev_vars = updLclEnv (\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) }) -- | Get in-scope term constraints (pm check) -getTmCsDs :: DsM (Bag TmEq) +getTmCsDs :: DsM (Bag TmVarCt) getTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) } -- | Add in-scope term constraints (pm check) -addTmCsDs :: Bag TmEq -> DsM a -> DsM a +addTmCsDs :: Bag TmVarCt -> DsM a -> DsM a addTmCsDs tm_cs = updLclEnv (\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) }) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -29,6 +30,7 @@ import TcType (isStringTy) import TysWiredIn import Outputable import SrcLoc +import Data.Bifunctor (first) {- %************************************************************************ @@ -53,34 +55,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq + +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -148,8 +145,11 @@ impact of this is the following: appearance of the warnings and is, in practice safe. -} --- | Term equalities -type TmEq = (Id, PmExpr) +-- | A term constraint. @TVC x e@ encodes that @x@ is equal to @e at . +data TmVarCt = TVC !Id !PmExpr + +instance Outputable TmVarCt where + ppr (TVC x e) = ppr x <+> char '~' <+> ppr e -- ---------------------------------------------------------------------------- -- ** Predicates on PmExpr @@ -189,17 +189,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -246,7 +246,35 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells, optionally +-- terminated by a wildcard variable instead of @[]@. +-- +-- So, @pmExprAsList (a:b:[]) == Just ([a,b], Nothing)@ is a @[]@ terminated, +-- while @pmExprAsList (a:b:c) == Just ([a,b], Just c)@ signifies a list prefix +-- @[a,b]++@ with an unspecified suffix represented by @c at . The prefix shall +-- never be empty if a suffix is returned (we don't consider that a list). +-- Returns @Nothing@ in all other cases. +pmExprAsList :: PmExpr -> Maybe ([PmExpr], Maybe Name) +pmExprAsList = go False + where + go allow_id_suffix (PmExprVar x) + -- We only allow an Id suffix when we are sure the prefix is not empty + | allow_id_suffix + = Just ([], Just x) + go _ (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just ([], Nothing) + | c == consDataCon + = ASSERT( length es == 2 ) first (es !! 0 :) <$> go True (es !! 1) + go _ _ + = Nothing {- %************************************************************************ @@ -260,18 +288,19 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l - go _ (PmExprVar v) = ppr v - go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (pmExprAsList -> Just (list, suff)) = case suff of + Nothing -> brackets $ fsep $ punctuate comma $ map ppr list + Just x -> parens $ fcat $ punctuate colon $ map ppr list ++ [ppr x] + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hsep (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,35 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just (list, suff) <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = case suff of + Nothing -> brackets . fsep . punctuate comma <$> mapM pprPmExpr list + Just x -> parens . fcat . punctuate colon <$> mapM pprPmExpr (list ++ [PmExprVar x]) +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +176,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmEq, PmVarEnv, PmRefutEnv, - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -52,25 +48,29 @@ import UniqDFM %************************************************************************ -} --- | The type of substitutions. -type PmVarEnv = NameEnv PmExpr +-- | Pretty much a @['TmVarCt']@ association list where the domain is 'Name' +-- instead of 'Id'. This is the type of 'tm_pos', where we store solutions for +-- rigid pattern match variables. +type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a -- refutation. So, if this maps @x :-> [Just]@, then trying to solve a --- 'TmEq' like @x ~ Just False@ immediately leads to a contradiction. +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in --- 'PmPpr.pprUncovered'. We don't do the same for 'PmVarEnv', so that is a plain +-- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). -- -- Subject to Note [The Pos/Neg invariant]. data TmState = TmS - { tm_pos :: !PmVarEnv + { tm_pos :: !TmVarCtEnv -- ^ A substitution with solutions we extend with every step and return as a -- result. The substitution is in /triangular form/: It might map @x@ to @y@ -- where @y@ itself occurs in the domain of 'tm_pos', rendering lookup @@ -78,12 +78,20 @@ data TmState = TmS -- along a chain of var-to-var mappings until we find the solution but has the -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. - , tm_neg :: !PmRefutEnv + -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. + , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -92,7 +100,7 @@ Invariant: In any 'TmState', The domains of 'tm_pos' and 'tm_neg' are disjoint. For example, it would make no sense to say both tm_pos = [...x :-> 3 ...] - tm_neg = [...x :-> [3,42]... ] + tm_neg = [...x :-> [4,42]... ] The positive information is strictly more informative than the negative. Suppose we are adding the (positive) fact @x :-> e@ to 'tm_pos'. Then we must @@ -109,7 +117,7 @@ instance Outputable TmState where pos = map pos_eq (nonDetUFMToList (tm_pos state)) neg = map neg_eq (udfmToList (tm_neg state)) pos_eq (l, r) = ppr l <+> char '~' <+> ppr r - neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + neg_eq (l, r) = ppr l <+> text "/~" <+> ppr r -- | Initial state of the oracle. initialTmState :: TmState @@ -117,13 +125,13 @@ initialTmState = TmS emptyNameEnv emptyDNameEnv -- | Wrap up the term oracle's state once solving is complete. Return the -- flattened 'tm_pos' and 'tm_neg'. -wrapUpTmState :: TmState -> (PmVarEnv, PmRefutEnv) +wrapUpTmState :: TmState -> (TmVarCtEnv, PmRefutEnv) wrapUpTmState solver_state - = (flattenPmVarEnv (tm_pos solver_state), tm_neg solver_state) + = (flattenTmVarCtEnv (tm_pos solver_state), tm_neg solver_state) -- | Flatten the triangular subsitution. -flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env +flattenTmVarCtEnv :: TmVarCtEnv -> TmVarCtEnv +flattenTmVarCtEnv env = mapNameEnv (exprDeepLookup env) env -- | Check whether a constraint (x ~ BOT) can succeed, -- given the resulting state of the term oracle. @@ -144,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). -solveOneEq :: TmState -> TmEq -> Maybe TmState -solveOneEq solver_env (x, e) = unify solver_env (PmExprVar (idName x), e) +solveOneEq :: TmState -> TmVarCt -> Maybe TmState +solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -168,20 +178,24 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] -lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) +-- +-- Note that because of Note [The Pos/Neg invariant], this will return an empty +-- list of alt cons for 'Id's which already have a solution. +lookupRefutableAltCons :: TmState -> Id -> (Type, [PmAltCon]) +lookupRefutableAltCons _tms at TmS{ tm_pos = pos, tm_neg = neg } x + = fromMaybe (idType x, []) (lookupDNameEnv neg y) + where + (y, _e) = varDeepLookup pos (idName x) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -193,6 +207,11 @@ isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x isFlexible :: TmState -> Name -> Bool isFlexible tms = isNothing . isRigid tms +-- | Is this a solution for a variable, i.e., something in WHNF? +isSolution :: PmExpr -> Bool +isSolution PmExprCon{} = True +isSolution _ = False + -- | Try to unify two 'PmExpr's and record the gained knowledge in the -- 'TmState'. -- @@ -205,12 +224,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -224,42 +239,46 @@ unify tms eq@(e1, e2) = case eq of | Just e1' <- isRigid tms x -> unify tms (e1', e2) (_, PmExprVar y) | Just e2' <- isRigid tms y -> unify tms (e1, e2') - (PmExprVar x, _) -> extendSubstAndSolve x e2 tms - (_, PmExprVar y) -> extendSubstAndSolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS + (PmExprVar x, PmExprVar y) -> Just (equate x y tms) + (PmExprVar x, _) -> trySolve x e2 tms + (_, PmExprVar y) -> trySolve y e1 tms where boring = Just tms unsat = Nothing +-- | Merges the equivalence classes of @x@ and @y@ by extending the substitution +-- with @x :-> y at . +-- Preconditions: @x /= y@ and both @x@ and @y@ are flexible (cf. +-- 'isFlexible'/'isRigid'). +equate :: Name -> Name -> TmState -> TmState +equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } + = ASSERT( x /= y ) + ASSERT( isFlexible tms x ) + ASSERT( isFlexible tms y ) + tms' + where + pos' = extendNameEnv pos x (PmExprVar y) + -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts + -- of x into those of y + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x + tms' = TmS { tm_pos = pos', tm_neg = neg' } + -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- --- Precondition: @a@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is not @y@, where @y@ is in the equivalence class --- represented by @x at . -extendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState -extendSubstAndSolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } +-- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). +-- Precondition: @e@ is a solution, i.e., 'PmExprCon' (cf. 'isSolution'). +trySolve:: Name -> PmExpr -> TmState -> Maybe TmState +trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _assert_is_not_cyclic ) - isRefutable x e' neg -- NB: e', the newly flattened solution for @x@ + ASSERT( isSolution e ) + isRefutable x e neg = Nothing | otherwise - = Just (TmS new_pos new_neg) - where - new_pos = extendNameEnv pos x e - (y, e') = varDeepLookup new_pos x - -- Be careful to uphold Note [The Pos/Neg invariant] by adjusting 'tm_neg' - neg' | x == y = neg - | otherwise = case lookupDNameEnv neg x of - Nothing -> neg - Just nalts -> - alterDNameEnv (delNulls (unionLists nalts)) neg y - new_neg = delFromDNameEnv neg' x - _assert_is_not_cyclic = case e of - PmExprVar z -> fst (varDeepLookup pos z) /= x - _ -> True + = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -278,7 +297,7 @@ extendSubst y e solver_state at TmS{ tm_pos = pos } -- representative in the triangular substitution @env@ and the completely -- substituted expression. The latter may just be the representative wrapped -- with 'PmExprVar' if we haven't found a solution for it yet. -varDeepLookup :: PmVarEnv -> Name -> (Name, PmExpr) +varDeepLookup :: TmVarCtEnv -> Name -> (Name, PmExpr) varDeepLookup env x = case lookupNameEnv env x of Just (PmExprVar y) -> varDeepLookup env y Just e -> (x, exprDeepLookup env e) -- go deeper @@ -286,13 +305,13 @@ varDeepLookup env x = case lookupNameEnv env x of {-# INLINE varDeepLookup #-} -- | Apply an (un-flattened) substitution to an expression. -exprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr +exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. -tmOracle :: TmState -> [TmEq] -> Maybe TmState +tmOracle :: TmState -> [TmVarCt] -> Maybe TmState tmOracle tm_state eqs = foldlM solveOneEq tm_state eqs -- | Type of a PmLit @@ -340,9 +359,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -557,7 +557,6 @@ Library IOEnv Json ListSetOps - ListT Maybes MonadUtils OrdList ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -391,7 +391,7 @@ data DsLclEnv = DsLclEnv { -- These two fields are augmented as we walk inwards, -- through each patttern match in turn dsl_dicts :: Bag EvVar, -- Constraints from GADT pattern-matching - dsl_tm_cs :: Bag TmEq, -- Constraints form term-level pattern matching + dsl_tm_cs :: Bag TmVarCt, -- Constraints form term-level pattern matching dsl_pm_iter :: IORef Int -- Number of iterations for pmcheck so far -- We fail if this gets too big ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== compiler/utils/ListT.hs deleted ===================================== @@ -1,80 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -------------------------------------------------------------------------- --- | --- Module : Control.Monad.Logic --- Copyright : (c) Dan Doel --- License : BSD3 --- --- Maintainer : dan.doel at gmail.com --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- A backtracking, logic programming monad. --- --- Adapted from the paper --- /Backtracking, Interleaving, and Terminating --- Monad Transformers/, by --- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry --- (). -------------------------------------------------------------------------- - -module ListT ( - ListT(..), - runListT, - select, - fold - ) where - -import GhcPrelude - -import Control.Applicative - -import Control.Monad -import Control.Monad.Fail as MonadFail - -------------------------------------------------------------------------- --- | A monad transformer for performing backtracking computations --- layered over another monad 'm' -newtype ListT m a = - ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r } - -select :: Monad m => [a] -> ListT m a -select xs = foldr (<|>) mzero (map pure xs) - -fold :: ListT m a -> (a -> m r -> m r) -> m r -> m r -fold = runListT - -------------------------------------------------------------------------- --- | Runs a ListT computation with the specified initial success and --- failure continuations. -runListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r -runListT = unListT - -instance Functor (ListT f) where - fmap f lt = ListT $ \sk fk -> unListT lt (sk . f) fk - -instance Applicative (ListT f) where - pure a = ListT $ \sk fk -> sk a fk - f <*> a = ListT $ \sk fk -> unListT f (\g fk' -> unListT a (sk . g) fk') fk - -instance Alternative (ListT f) where - empty = ListT $ \_ fk -> fk - f1 <|> f2 = ListT $ \sk fk -> unListT f1 sk (unListT f2 sk fk) - -instance Monad (ListT m) where - m >>= f = ListT $ \sk fk -> unListT m (\a fk' -> unListT (f a) sk fk') fk -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail (ListT m) where - fail _ = ListT $ \_ fk -> fk - -instance MonadPlus (ListT m) where - mzero = ListT $ \_ fk -> fk - m1 `mplus` m2 = ListT $ \sk fk -> unListT m1 sk (unListT m2 sk fk) ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,12 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/17739b9aaf03dc90d4cf961c367ea47156c5bede -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/17739b9aaf03dc90d4cf961c367ea47156c5bede You're receiving 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 Jun 7 18:37:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 14:37:53 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cfaaf015051c_6f73fe611ab0cd48263bf@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 02a3436e by Ben Gamari at 2019-06-07T18:35:48Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. Specifically, ticks appearing in two places to defeat the rule: b. Surrounding the fold function a. Surrounding the inner application of `unpackFoldrCString#` The former caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,22 +1368,28 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , cheapEqExpr' tickishFloatable c1 c2 + , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1 + , c2Ticks <- stripTicksTopT tickishFloatable c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` mkTicks (c1Ticks ++ c2Ticks) c1' + `App` n -match_append_lit _ _ _ _ = Nothing +match_append_lit _ _ _ e = pprTrace "append_it_failed" (ppr e) Nothing --------------------------------------------------- -- The rule is this: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/02a3436e9b8e51e468eb5e5fc171c1db0c3e72a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/02a3436e9b8e51e468eb5e5fc171c1db0c3e72a8 You're receiving 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 Jun 7 18:42:21 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 07 Jun 2019 14:42:21 -0400 Subject: [Git][ghc/ghc][wip/T16728] 19 commits: gitlab-ci: Disable darwin hadrian job Message-ID: <5cfab00d51df7_6f73fe60ab86bc482687d@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - c70ea23d by Simon Peyton Jones at 2019-06-07T18:16:58Z Fix two places that failed the substitution invariant The substition invariant relies on keeping the in-scope set in sync, and we weren't always doing so, which means that a DEBUG compiler crashes sometimes with an assertion failure This patch fixes a couple more cases. Still not validate clean (with -DEEBUG) but closer! - - - - - 18e22a12 by Simon Peyton Jones at 2019-06-07T18:16:58Z Fix typechecking of partial type signatures Partial type sigs had grown hair. tcHsParialSigType was doing lots of unnecessary work, and tcInstSig was cloning it unnecessarily -- and the result didn't even work: #16728. This patch cleans it all up, described by TcHsType Note [Checking parital type signatures] I basically just deleted code... but very carefully! Some refactoring along the way * Distinguish more explicintly between "anonymous" wildcards "_" and "named" wildcards "_a". I changed the names of a number of functions to make this distinction much more apparent. The patch also revealed that the code in `TcExpr` that implements the special typing rule for `($)` was wrong. It called `getRuntimeRep` in a situation where where was no particular reason to suppose that the thing had kind `TYPE r`. This caused a crash in typecheck/should_run/T10846. The fix was easy, and actually simplifies the code in `TcExpr` quite a bit. Hooray. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/main/DriverPipeline.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnTypes.hs - compiler/typecheck/Inst.hs - compiler/typecheck/TcBinds.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnMonad.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcType.hs - compiler/types/Type.hs - compiler/utils/ListSetOps.hs - docs/users_guide/eventlog-formats.rst - ghc/GHCi/UI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/097558e690aa3936226c5ca96d0c7a1a50b755b5...18e22a12db3278c71fedcff68251401ca6c672e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/097558e690aa3936226c5ca96d0c7a1a50b755b5...18e22a12db3278c71fedcff68251401ca6c672e5 You're receiving 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 Jun 7 18:57:20 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 14:57:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/test-g3 Message-ID: <5cfab390edee7_6f78b1076c836095@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/test-g3 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/test-g3 You're receiving 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 Jun 7 20:17:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 16:17:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-windows Message-ID: <5cfac655e7af4_6f73fe61146f26c863093@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fix-windows at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-windows You're receiving 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 Jun 7 20:20:15 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 16:20:15 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] gitlab-ci: Don't allow Windows make job to fail Message-ID: <5cfac6ff4a426_6f7e339380863222@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: afe2837c by Ben Gamari at 2019-06-07T20:20:01Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -640,8 +640,6 @@ nightly-i386-windows-hadrian: .build-windows-make: extends: .build-windows stage: full-build - # due to #16084 - allow_failure: true variables: BUILD_FLAVOUR: "quick" GHC_VERSION: "8.6.5" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/afe2837ce1d1d04e335811feb1d9d8e9dc05116b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/afe2837ce1d1d04e335811feb1d9d8e9dc05116b You're receiving 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 Jun 7 20:25:47 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 16:25:47 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] testsuite: Mark OldModLocation as broken on Windows Message-ID: <5cfac84b31056_6f7e339380866390@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: dbf69982 by Ben Gamari at 2019-06-07T20:24:43Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - 1 changed file: - testsuite/tests/ghc-api/downsweep/all.T Changes: ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -9,6 +9,7 @@ test('PartialDownsweep', test('OldModLocation', [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('mingw32'), expect_broken(16772)) ], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dbf6998290783650558623cd30370807aa3dce94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dbf6998290783650558623cd30370807aa3dce94 You're receiving 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 Jun 7 21:01:56 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 07 Jun 2019 17:01:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 43 commits: [skip ci] Improve the documentation of the CNF primops. In this context, the... Message-ID: <5cfad0c4196ff_6f7e5887449173ab@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 2a29053f by Matthew Pickering at 2019-06-07T21:01:33Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - f99c9e9c by Ben Gamari at 2019-06-07T21:01:34Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 7d033488 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 92cdf6d7 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Make closureSize less sensitive to optimisation - - - - - a007d970 by Ben Gamari at 2019-06-07T21:01:34Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - a7d20c1b by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - dc93ef65 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - de23ef35 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - aa496014 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - c75a6191 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - f782313e by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 53e7a906 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - a8bbf562 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 75894070 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 81722107 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Fix fragile_for test modifier - - - - - 18a6b937 by Ben Gamari at 2019-06-07T21:01:34Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - e69ceb05 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - b193231b by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 38aebda4 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 9f4bb548 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - c77f45f7 by Ben Gamari at 2019-06-07T21:01:34Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 374134f0 by Alp Mestanogullari at 2019-06-07T21:01:36Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 61b03456 by nineonine at 2019-06-07T21:01:38Z Do not report error if Name in pragma is unbound - - - - - 20efbff7 by David Eichmann at 2019-06-07T21:01:41Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 4861b701 by Matthew Pickering at 2019-06-07T21:01:42Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - be403d5b by Richard Eisenberg at 2019-06-07T21:01:44Z Comments only: document newtypes' DataConWrapId - - - - - 66848cbd by Ben Gamari at 2019-06-07T21:01:45Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/MkId.hs - compiler/basicTypes/NameEnv.hs - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmForeign.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/GHCi.hs - compiler/ghci/Linker.hs - compiler/ghci/LinkerTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/BaseDir.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/rename/RnExpr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ed03ee3f7c9c919ed679e35beddba901fea0fa56...66848cbddd5f7aaf1f28c2b517f77df593edea8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ed03ee3f7c9c919ed679e35beddba901fea0fa56...66848cbddd5f7aaf1f28c2b517f77df593edea8f You're receiving 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 Jun 7 21:35:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 17:35:53 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] 2 commits: Bump Cabal submodule Message-ID: <5cfad8b96cf0b_6f78b1076c94187a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 764f1094 by Ben Gamari at 2019-06-07T21:33:50Z Bump Cabal submodule - - - - - d37edd15 by Ben Gamari at 2019-06-07T21:34:16Z Bump binary to 0.8.7.0 - - - - - 9 changed files: - hadrian/hadrian.cabal - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - libraries/Cabal - libraries/binary - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/Main.hs - utils/ghc-cabal/ghc-cabal.cabal - utils/ghctags/ghctags.cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -116,7 +116,7 @@ executable hadrian other-extensions: MultiParamTypeClasses , TypeFamilies build-depends: base >= 4.8 && < 5 - , Cabal >= 2.5 && < 2.6 + , Cabal >= 3.0 && < 3.1 , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , extra >= 1.4.7 ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal.Parse @@ -17,6 +16,7 @@ module Hadrian.Haskell.Cabal.Parse ( import Data.Bifunctor import Data.List.Extra import Development.Shake +import qualified Distribution.Compat.Graph as Graph import qualified Distribution.ModuleName as C import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C @@ -30,6 +30,7 @@ import qualified Distribution.Simple.Utils as C import qualified Distribution.Simple.Program.Types as C import qualified Distribution.Simple.Configure as C (getPersistBuildConfig) import qualified Distribution.Simple.Build as C +import qualified Distribution.Types.ComponentLocalBuildInfo as C import qualified Distribution.Types.ComponentRequestedSpec as C import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as C @@ -215,7 +216,7 @@ resolveContextData context at Context {..} = do -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 - let extDeps = C.externalPackageDeps lbi' + let extDeps = externalPackageDeps lbi' deps = map (C.display . snd) extDeps depDirect = map (fromMaybe (error "resolveContextData: depDirect failed") . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps @@ -288,7 +289,20 @@ resolveContextData context at Context {..} = do getHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo getHookedBuildInfo [] = return C.emptyHookedBuildInfo getHookedBuildInfo (baseDir:baseDirs) = do - maybeInfoFile <- C.findHookedPackageDesc baseDir + maybeInfoFile <- C.findHookedPackageDesc C.normal baseDir case maybeInfoFile of Nothing -> getHookedBuildInfo baseDirs Just infoFile -> C.readHookedBuildInfo C.silent infoFile + +externalPackageDeps :: C.LocalBuildInfo -> [(C.UnitId, C.MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (C.componentGraph lbi) + , (ipkgid, pkgid) <- C.componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . C.componentUnitId) (Graph.toList (C.componentGraph lbi)) + ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 27fc0fe9608ba502ef62647629a6d4ebe01fa33d +Subproject commit f697d3209990c3314efe840be54fb7c5a967e6ff ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit fcd9d3cb2a942c54347d28bcb80a1b46d2d7d673 ===================================== utils/check-api-annotations/check-api-annotations.cabal ===================================== @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, ghc ===================================== utils/check-ppr/check-ppr.cabal ===================================== @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, filepath, ghc ===================================== utils/ghc-cabal/Main.hs ===================================== @@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register +import qualified Distribution.Compat.Graph as Graph import Distribution.Text import Distribution.Types.MungedPackageId +import Distribution.Types.LocalBuildInfo import Distribution.Verbosity import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex @@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } +externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (componentGraph lbi) + , (ipkgid, pkgid) <- componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) + generate :: FilePath -> FilePath -> [String] -> IO () generate directory distdir config_args = withCurrentDirectory directory @@ -274,8 +288,8 @@ generate directory distdir config_args -- cabal 2.2+ will expect it, but fallback to the old default -- location if we don't find any. This is the case of the -- bindist, which doesn't ship the $dist/build folder. - maybe_infoFile <- findHookedPackageDesc (cwd distdir "build") - <|> defaultHookedPackageDesc + maybe_infoFile <- findHookedPackageDesc verbosity (cwd distdir "build") + <|> fmap Just (defaultPackageDesc verbosity) case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -307,8 +321,9 @@ generate directory distdir config_args let comp = compiler lbi - libBiModules lib = (libBuildInfo lib, libModules lib) + libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName)) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) + biModuless :: [(BuildInfo, [ModuleName.ModuleName])] biModuless = (map libBiModules . maybeToList $ library pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 ===================================== utils/ghctags/ghctags.cabal ===================================== @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && <2.6, + Cabal >= 3.0 && <3.1, ghc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/183dcc5e2a8e779fc2871b0e78ea7e0fe7fbaed5...d37edd155084161af69741af887be8075234b9d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/183dcc5e2a8e779fc2871b0e78ea7e0fe7fbaed5...d37edd155084161af69741af887be8075234b9d1 You're receiving 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 Jun 7 22:43:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 18:43:38 -0400 Subject: [Git][ghc/ghc][wip/T16509-test] 93 commits: Lowercase windows imports Message-ID: <5cfae89a4af03_6f755730001041435@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16509-test at Glasgow Haskell Compiler / GHC Commits: 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 76d5c62a by Ben Gamari at 2019-06-07T22:43:26Z testsuite: Add test for #16509 - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - + compiler/main/CliOption.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4b1addca61800eb199c504a7183c2a8f7d4135df...76d5c62aa2a1020abb3a9c74f2b73788474f4804 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4b1addca61800eb199c504a7183c2a8f7d4135df...76d5c62aa2a1020abb3a9c74f2b73788474f4804 You're receiving 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 Jun 7 22:46:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 18:46:42 -0400 Subject: [Git][ghc/ghc][wip/D5285] 714 commits: Add support for ASM foreign files (.s) in TH (#16180) Message-ID: <5cfae952edc41_6f75573000104534f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/D5285 at Glasgow Haskell Compiler / GHC Commits: f035504b by Sylvain Henry at 2019-01-21T02:35:20Z Add support for ASM foreign files (.s) in TH (#16180) - - - - - 38d837a4 by Matthew Pickering at 2019-01-21T17:17:20Z Fix typo in TcRnTypes.hs [skip ci] - - - - - 5ebcfc04 by Ben Gamari at 2019-01-21T23:05:52Z gitlab: Add merge request template This begins to define our expectations of contributions. [skip-ci] - - - - - 7262a815 by Ben Gamari at 2019-01-21T23:06:30Z Add CODEOWNERS GitLab uses this file to suggest reviewers based upon the files that a Merge Request touches. [skip-ci] - - - - - 64ce6afa by Samuel Holland at 2019-01-21T23:28:38Z Extend linker-script workaround to work with musl libc GHC has code to handle unsuffixed .so files that are linker scripts pointing to the real shared library. The detection is done by parsing the result of `dlerror()` after calling `dlopen()` and looking for certain error strings. On musl libc, the error message is "Exec format error", which happens to be `strerror(ENOEXEC)`: ``` $ cat tmp.c #include <dlfcn.h> #include <stdio.h> int main(void) { dlopen("libz.so", RTLD_NOW | RTLD_GLOBAL); puts(dlerror()); return 0; } $ gcc -o tmp tmp.c $ ./tmp Error loading shared library libz.so: Exec format error $ ``` This change fixes the workaround to also work on musl libc. Link: https://phabricator.haskell.org/D5474 - - - - - a5373c1f by Simon Peyton Jones at 2019-01-22T08:02:20Z Fix bogus worker for newtypes The "worker" for a newtype is actually a function with a small (compulsory) unfolding, namely a cast. But the construction of this function was plain wrong for newtype /instances/; it cast the arguemnt to the family type rather than the representation type. This never actually bit us because, in the case of a family instance, we immediately cast the result to the family type. So we get \x. (x |> co1) |> co2 where the compositio of co1 and co2 is ill-kinded. However the optimiser (even the simple optimiser) just collapsed those casts, ignoring the mis-match in the middle, so we never saw the problem. Trac #16191 is indeed a dup of #16141; but the resaon these tickets produce Lint errors is not the unnecessary forcing; it's because of the ill-typed casts. This patch fixes the ill-typed casts, properly. I can't see a way to trigger an actual failure prior to this patch, but it's still wrong wrong wrong to have ill-typed casts, so better to get rid of them. - - - - - c9fe14cc by Herbert Valerio Riedel at 2019-01-22T17:11:32Z Update transformers module - - - - - 54a50a6e by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Reenable Hadrian build on Windows - - - - - 5fcee8aa by Ben Price at 2019-01-23T19:07:28Z users guide: consistent spelling of inlinable - - - - - 395c8eaa by Ben Price at 2019-01-23T19:07:28Z users guide: fix typesetting of pragmas - - - - - cfe64019 by Matthew Pickering at 2019-01-23T19:07:28Z Fix hadrian prof flavour so that it builds a profiled version of GHC In Alp's refactoring of `getProgramContexts` he removed a call to `getProgramContext` which was where the logic for this used to be implemented. Fixes #16214 - - - - - 33aba191 by Joachim Breitner at 2019-01-23T19:07:28Z Minor typo in docs for KProxy really minor, but it annoyed me when reading it :-) - - - - - b19ee0e9 by Joachim Breitner at 2019-01-23T19:07:28Z Add myself to CODEOWNERS for a few files - - - - - 512a5f36 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Ensure that config.{msys,cygwin} are initialized Reviewers: monoidal Reviewed By: monoidal Subscribers: monoidal, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5056 - - - - - d26869ac by Alec Theriault at 2019-01-23T19:07:28Z Hadrian: install patches 'haddock-{html,interface}' Since the `$(docdir)` can be picked independently from the `$(libdir)`, we need to make sure that that the `haddock-html` and `haddock-interface` fields in the package DB (which is in the `$(libdir)`) get updated to point to the appropriate places in the `$(docdir)`. NB: in the make system, `ghc-cabal` would cover this sort of thing by re-running `configure` on installation, but here we get away with a couple lines of `sed` and a call to `ghc-pkg recache`. Fixes #16202. - - - - - 0b705fad by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Mark ghci063 as broken on Darwin This is the last failing test on Darwin preventing us from disallowing CI failures. See #16201. - - - - - 57142eb9 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Mark T16180 as broken on Darwin See #16218. - - - - - daff24bc by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Disallow failure - - - - - efc95841 by Alec Theriault at 2019-01-23T19:07:28Z Hadrian: support in-tree GMP Summary: This adds top-level configure flags '--with-intree-gmp' and '--with-framework-preferred', both of which are especially relevant on MacOS. Besides gaining two new flags, Hadrian also had to be taught what to do with the 'framework' in .cabal files. Test Plan: ./boot && ./configure --with-intree-gmp && ./hadrian/build.sh ./boot && ./configure --with-gmp-framework-preferred && ./hadrian/build.sh # on macos Reviewers: carter, snowleopard, alpmestan, hvr, goldfire, bgamari Subscribers: rwbarton, erikd GHC Trac Issues: #16001 Differential Revision: https://phabricator.haskell.org/D5417 - - - - - cd45f8c4 by Alec Theriault at 2019-01-23T19:07:28Z Update Darwin CI to use new toplevel --with-intree-gmp configure flag - - - - - a90a2aea by Ben Gamari at 2019-01-23T19:07:28Z gitlab: Collect artifacts on Windows - - - - - 5341edf3 by Alec Theriault at 2019-01-23T19:07:28Z Error out of invalid Int/Word bit shifts Although the Haddock's for `shiftL` and `shiftR` do require the number of bits to be non-negative, we should still check this before calling out to primitives (which also have undefined behaviour for negative bit shifts). If a user _really_ wants to bypass checks that the number of bits is sensible, they already have the aptly-named `unsafeShiftL`/`unsafeShiftR` at their disposal. See #16111. - - - - - c9a02dfc by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Drop CircleCI jobs It's pretty unlikely we will be going back to circleci at this point [skip-ci] - - - - - bb2acfe0 by Gabor Greif at 2019-01-23T19:07:28Z A few typofixes - - - - - b397e979 by Gabor Greif at 2019-01-23T19:07:28Z Minor refactor [ci skip] - - - - - 35c58c33 by Ben Gamari at 2019-01-23T19:07:28Z testsuite: Skip ghcilink002 when unregisterised See #16085. - - - - - 886ddb27 by Ben Gamari at 2019-01-23T19:07:28Z gitlab-ci: Explicitly clear dependencies of all jobs Apparently GitLab CI defaults to declaring all jobs of the previous stage as dependencies of a job. This meant that we would end up downloading all of our binary distributions during the `cleanup` stage, eating up a truly remarkable amount of S3 tranfers. - - - - - 571e45d6 by Richard Eisenberg at 2019-01-25T03:34:08Z Add Simon and Richard as more CODEOWNERS [skip ci] - - - - - 3cbee255 by Sebastian Graf at 2019-01-26T17:44:23Z Add @sgraf to CODEOWNERS [skip ci] - - - - - 1dd251b8 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add predicate for CPU feature availability Previously testing code-generation for ISA extensions was nearly impossible since we had no ability to determine whether the host supports the needed extension. Here we fix this by introducing a simple /proc/cpuinfo-based testsuite predicate. We really ought to - - - - - 372b5d1b by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add test for #16104 - - - - - 0d9f105b by Ben Gamari at 2019-01-27T13:32:12Z GhcPlugins: Fix lookup of TH names Previously `thNameToGhcName` was calling `lookupOrigNameCache` directly, which failed to handle the case that the name wasn't already in the name cache. This happens, for instance, when the name was in scope in a plugin being used during compilation but not in scope in the module being compiled. In this case we the interface file containing the name won't be loaded and `lookupOrigNameCache` fails. This was the cause of #16104. The solution is simple: use the nicely packaged `lookupOrigIO` instead. - - - - - fc44e0b2 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Normalise style - - - - - 236beaca by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Remove directories that already exist when seeding extra_files Otherwise the testsuite driver crashes when run multiple times with CLEANUP=NO on a test containing such extra_files. - - - - - 55bbe9cc by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Mark hWaitForInput-accurate-socket as requiring unix It imports System.Posix.IO. - - - - - f75c86ab by Herbert Valerio Riedel at 2019-01-27T13:32:12Z Update binary submodule to latest master branch tip - - - - - d0b8a16e by Herbert Valerio Riedel at 2019-01-27T13:32:12Z Update Cabal submodule to latest master branch tip - - - - - 5cb071af by Adam Sandberg Eriksson at 2019-01-27T13:32:12Z hadrian: use new-exec to make sure alex & happy are in PATH (#16120) - - - - - 3cf12e60 by Alan Zimmerman at 2019-01-27T13:32:12Z check-api-annotations checks for annotation preceding its span For an API annotation to be useful, it must not occur before the span it is enclosed in. So, for check-api-annotation output, a line such as ((Test16212.hs:3:22-36,AnnOpenP), [Test16212.hs:3:21]), should be flagged as an error, as the AnnOpenP location of 3:21 precedes its enclosing span of 3:22-26. This patch does this. Closes #16217 - - - - - 022a7176 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Skip T1288_ghci in unregisterised As pointed out in #16085, these ghci tests are fragile in the unregisterised way. - - - - - dc6fd390 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Skip foreignInterruptible in unregisterised way See #15467. - - - - - def84a10 by Ben Gamari at 2019-01-27T13:32:12Z testsuite: Add tests from #11982 - - - - - 18bd2724 by Ömer Sinan Ağacan at 2019-01-27T13:32:31Z Add myself to a few more places - - - - - 019127b8 by Moritz Angermann at 2019-01-27T13:32:31Z Update CODEOWNERS - - - - - e7164384 by Simon Marlow at 2019-01-27T13:32:55Z Add @simonmar to various things in CODEOWNERS - - - - - 10faf44d by Matthew Pickering at 2019-01-27T13:32:55Z Don't overwrite the set log_action when using --interactive -ddump-json didn't work with --interactive as --interactive overwrote the log_action in terms of defaultLogAction. Reviewers: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14078 Differential Revision: https://phabricator.haskell.org/D4533 - - - - - b89b6e71 by Alec Theriault at 2019-01-28T04:26:56Z Fix incorrectly named configure options Although we should use 'AC_ARG_ENABLE' for boolean flags, it also means options get named '--enable-*', not '--with-*'. This should unbreak the --with-intree-gmp option. - - - - - 7223b44d by klebinger.andreas at gmx.at at 2019-01-28T04:27:55Z Fix regDotColor for amd64. Add missing color mappings to regDotColor for amd64. Also set fakeRegs to red instead of xmm regs. - - - - - f8605fa2 by Tamar Christina at 2019-01-28T04:28:10Z Update CODEOWNERS files with utils - - - - - 6da9f4c8 by Ben Gamari at 2019-01-28T04:30:00Z gitlab-ci: Fix Windows cleanup command line Why is it so hard to delete a directory's contents without deleting the directory itself in Windows? This will forever remain a mystery. - - - - - 79a5afb6 by Andrew Martin at 2019-01-28T04:30:47Z Test that hsc2hs works with promoted data constructors - - - - - 77974922 by Richard Eisenberg at 2019-01-28T04:33:40Z Some refactoring in tcInferApps Should be no change in behavior, but this makes the control flow a little more apparent. - - - - - b1e569a5 by Ryan Scott at 2019-01-28T17:23:16Z Use sigPrec in more places in Convert and HsUtils Trac #16183 was caused by TH conversion (in `Convert`) not properly inserting parentheses around occurrences of explicit signatures where appropriate, such as in applications, function types, and type family equations. Solution: use `parenthesizeHsType sigPrec` in these places. While I was in town, I also updated `nlHsFunTy` to do the same thing. - - - - - 7cdcd3e1 by Roland Senn at 2019-01-28T21:53:59Z Fix #12509: ghci -XSafe fails in an inscrutable way - - - - - 76c8fd67 by Ben Gamari at 2019-01-30T06:06:12Z Batch merge - - - - - 172a5933 by Ben Gamari at 2019-01-30T15:05:19Z Revert "Batch merge" This reverts commit 76c8fd674435a652c75a96c85abbf26f1f221876. - - - - - bdb559a6 by Ben Gamari at 2019-01-30T15:06:31Z testsuite: Introduce makefile_test - - - - - 513a449c by Ben Gamari at 2019-01-30T15:06:31Z testsuite: Use makefile_test This eliminates most uses of run_command in the testsuite in favor of the more structured makefile_test. - - - - - cc2261d4 by David Eichmann at 2019-01-30T15:06:31Z Performance tests: recover a baseline from ancestor commits and CI results. gitlab-ci: push performance metrics as git notes to the "GHC Performance Notes" repository. - - - - - c1d9416f by Dmitry Ivanov at 2019-01-30T15:06:31Z Compile count{Leading,Trailing}Zeros to corresponding x86_64 instructions under -mbmi2 This works similarly to existing implementation for popCount. Trac ticket: #16086. - - - - - cfbd39bd by Ben Gamari at 2019-01-30T15:06:31Z gitlab-ci: Use build cleanup logic on Darwin as well We use the shell executor on Darwin as well as Windows. See https://gitlab.com/gitlab-org/gitlab-runner/issues/3856. - - - - - 924a4607 by Neil Mitchell at 2019-01-30T15:06:31Z Avoid compiling Hadrian dependencies with profiling on Cabal/Windows - - - - - c85d708c by Neil Mitchell at 2019-01-30T15:06:31Z Avoid compiling Hadrian dependencies with profiling on Cabal/Linux - - - - - f00b35f4 by Moritz Angermann at 2019-01-30T15:06:31Z make ghc-pkg shut up - - - - - 6fa38663 by Alec Theriault at 2019-01-30T15:06:32Z Use `NameEnv Id` instead of `Map Name Id` This is more consistent with the rest of the GHC codebase. - - - - - 5ed48d25 by Alec Theriault at 2019-01-30T15:06:32Z Include type info for only some exprs in HIE files This commit relinquishes some some type information in `.hie` files in exchange for better performance. See #16233 for more on this. Using `.hie` files to generate hyperlinked sources is a crucial milestone towards Hi Haddock (the initiative to move Haddock to work over `.hi` files and embed docstrings in those). Unfortunately, even after much optimization on the Haddock side, the `.hie` based solution is still considerably slower and more memory hungry than the existing implementation - and the @.hie@ code is to blame. This changes `.hie` file generation to track type information for only a limited subset of expressions (specifically, those that might eventually turn into hyperlinks in the Haddock's hyperlinker backend). - - - - - e7e5f4ae by Matthew Pickering at 2019-01-30T15:06:32Z Only build vanilla way in devel2 flavour Fixes #16210 - - - - - 4bf35da4 by Alan Zimmerman at 2019-01-30T15:06:32Z API Annotations: Parens not attached correctly for ClassDecl The parens around the kinded tyvars should be attached to the class declaration as a whole, they are attached to the tyvar instead, outside the span. An annotation must always be within or after the span it is contained in. Closes #16212 - - - - - e29b1ee7 by Zejun Wu at 2019-01-30T15:06:32Z Add a RTS option -xp to load PIC object anywhere in address space Summary: This re-applies {D5195} with fixes for i386: * Fix unused label warnings, see {D5230} or {D5273} * Fix a silly bug introduced by moving `#if` {P190} Add a RTS option -xp to load PIC object anywhere in address space. We do this by relaxing the requirement of <0x80000000 result of `mmapForLinker` and implying USE_CONTIGUOUS_MMAP. We also need to change calls to `ocInit` and `ocGetNames` to avoid dangling pointers when the address of `oc->image` is changed by `ocAllocateSymbolExtra`. Test Plan: See {D5195}, also test under i386: ``` $ uname -a Linux watashi-arch32 4.18.5-arch1-1.0-ARCH #1 SMP PREEMPT Tue Aug 28 20:45:30 CEST 2018 i686 GNU/Linux $ cd testsuite/tests/th/ && make test ... ``` will run `./validate` on stacked diff. Reviewers: simonmar, bgamari, alpmestan, trommler, hvr, erikd Reviewed By: simonmar Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5289 - - - - - 740534d4 by Zejun Wu at 2019-01-30T15:06:32Z Allocate bss section within proper range of other sections Summary: This re-applies {D5195} and {D5235}, they were reverted as part of diff stack to unbreak i386. The proper fix is done in {D5289}. Allocate bss section within proper range of other sections: * when `+RTS -xp` is passed, allocate it contiguously as we did for jump islands * when we mmap the code to lower 2Gb, we should allocate bss section there too Test Plan: 1. `./validate` 2. with ``` DYNAMIC_GHC_PROGRAMS = NO DYNAMIC_BY_DEFAULT = NO ``` `TEST="T15729" make test` passed in both linux (both i386 and x86_64) and macos. 3. Also test in a use case where we used to encouter error like: ``` ghc-iserv-prof: R_X86_64_PC32 relocation out of range: (noname) = b90282ba ``` and now, everything works fine. Reviewers: simonmar, bgamari, angerman, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15729 Differential Revision: https://phabricator.haskell.org/D5290 - - - - - 6e96aa2d by Zejun Wu at 2019-01-30T15:06:32Z Don't use X86_64_ELF_NONPIC_HACK for +RTS -xp Summary: When `+RTS -xp` is passed, when don't need the X86_64_ELF_NONPIC_HACK, becasue the relocation offset should only be out of range if * the object file was not compiled with `-fPIC -fexternal-dynamic-refs`; * ghc generates non-pic code while it should (e.g. #15723) In either case, we should print an error message rather that silently attempt to use a hacky workaround that may not work. This could have made debugging #15723 and #15729 much easier. Test Plan: Run this in a case where ghci used to crash becasue of T15723. Now we see helpful message like: ``` ghc-iserv-prof: R_X86_64_PC32 relocation out of range: stmzm2zi4zi4zi1zmJQn4hNPyYjP5m9AcbI88Ve_ControlziConcurrentziSTMziTMVar_readTMVar_C61n_cc = 9b95ffac ``` Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar, bgamari Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5233 - - - - - deab6d64 by Matthew Pickering at 2019-01-31T11:02:25Z Fix syntax in CODEOWNERS file [skip ci] - - - - - 4fa32293 by Sylvain Henry at 2019-01-31T17:46:51Z Use ByteString to represent Cmm string literals (#16198) Also used ByteString in some other relevant places - - - - - d887f374 by Sylvain Henry at 2019-01-31T17:46:51Z Optimize pprASCII * Use `ByteString.foldr` instead of `(List.foldr . BS.unpack)` * Avoid calling `chr` and its test that checks for invalid Unicode codepoints: we stay in the ASCII range so we know we're ok * Avoid calling `isPrint` (unsafe FFI call): we can check the ASCII printable range directly * Use bit operations (`unsafeShiftR`, `.&.`) instead of `div` and `mod` - - - - - 98ff3010 by Ben Gamari at 2019-01-31T17:46:51Z hWaitForInput-accurate-stdin test - - - - - 0593e938 by Zejun Wu at 2019-01-31T17:46:51Z Add -fdefer-diagnostics to defer and group diagnostic messages in make-mode When loading many modules in parallel there can a lot of warnings and errors get mixed up with regular output. When the compilation fails, the relevant error message can be thousands of lines backward and is hard to find. When the compilation successes, warning message is likely to be ignored as it is not seen. We can address this by deferring the warning and error message after the compilation. We also put errors after warnings so it is more visible. This idea was originally proposed by Bartosz Nitka in https://phabricator.haskell.org/D4219. - - - - - 92c7e70f by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Use O2 on stage1 for faster overall build times with make. Build times when using the quick flavour: stage1 opt | time (wall) | time (user) -O1 | 13m | 53m -O2 | 13m | 51m So even when we compile stage2 with -O0 (quick) using -O2 on stage1 is already faster. The difference is even bigger when freezing stage1 and doing multiple builds or compiling stage2 with optimizations. - - - - - 1be81c50 by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Add O2 to hsCompiler on stage0 for most hadrian flavours. - - - - - e08974e8 by Zejun Wu at 2019-01-31T17:46:51Z Introduce GhciMonad and generalize types of functions in GHCi.UI Summary: Introduce `GhciMonad`, which is bascially `GhcMonad` + `HasGhciState`. Generalize the commands and help functions defined in `GHCi.UI` so they can be used as both `GHCi a` and `InputT GHCi a`. The long term plan is to move reusable bits to ghci library and make it easier to build a customized interactive ui which carries customized state and provides customized commands. Most changes are trivial in this diff by relaxing the type constraint or add/remove lift as necessary. The non-trivial changes are: * Change `HasGhciState` to `GhciMonad` and expose it. * Implementation of `reifyGHCi`. Test Plan: ./validate Reviewers: simonmar, hvr, bgamari Reviewed By: simonmar Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5433 - - - - - 5b970d8e by Ben Gamari at 2019-01-31T17:46:51Z testsuite: Add test for #14828 - - - - - ff2d6018 by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Replace BlockSequence with OrdList in BlockLayout.hs OrdList does the same thing and more so there is no reason to have both. - - - - - 438c11cc by klebinger.andreas at gmx.at at 2019-01-31T17:46:51Z Small optimizations to BlockLayout. * Remove `takeL/R 1` occurences by lastOL/headOL. * Make BlockChain a OrdList newtype by removing the set of blocks. Initially BlockChain contained both, a set for membership test and a ordered list of blocks. The set is not used for any performance sensitive lookups so we get rid of it. - - - - - 4376d881 by Peter Trommler at 2019-01-31T17:46:51Z PPC NCG: Promote integers to word size in C calls Fixes #16222 - - - - - 9bcef368 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update hsc2hs submodule - - - - - 038de6ab by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update text submodule - - - - - 03030bcf by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update unix submodule - - - - - edca7837 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update deepseq submodule - - - - - 229f097d by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update haskeline submodule - - - - - ffd2035c by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update parsec submodule - - - - - 4a9e14be by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update process submodule - - - - - 713271db by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update stm submodule - - - - - 86734329 by Herbert Valerio Riedel at 2019-01-31T17:46:51Z Update terminfo submodule - - - - - 780bcdaf by Andrey Mokhov at 2019-01-31T17:46:51Z Hadrian: Update instructions for building on Windows The `hadrian/doc/windows.md` file has falled out of date. In particular it still points to the old GitHub repository, and uses incorrect path to GHC. This patch fixes it. - - - - - 21462a3a by Andrey Mokhov at 2019-01-31T17:46:51Z Hadrian: Fix outdated link. - - - - - ebe2d344 by Ben Gamari at 2019-02-01T00:47:53Z Revert "Performance tests: recover a baseline from ancestor commits and CI results." Unfortunately this has broken all future commits due to spurious(?) performance changes which I have been unable to work around. This reverts commit cc2261d42f6a954d88e355aaad41f001f65c95da. - - - - - d6d735c1 by Edward Z. Yang at 2019-02-01T01:02:12Z Fix #16219: TemplateHaskell causes indefinite package build error It should work to write an indefinite package using TemplateHaskell, so long as all of the actual TH code lives outside of the package. However, cleverness we had to build TH code even when building with -fno-code meant that we attempted to build object code for modules in an indefinite package, even when the signatures were not instantiated. This patch disables said logic in the event that an indefinite package is being typechecked. Signed-off-by: Edward Z. Yang <ezyang at fb.com> Test Plan: validate Reviewers: simonpj, bgamari Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #16219 Differential Revision: https://phabricator.haskell.org/D5475 - - - - - ef6b2833 by Sebastian Graf at 2019-02-01T11:46:32Z Remove ExnStr and ThrowsExn business - - - - - f0cd728f by Ryan Scott at 2019-02-02T00:10:55Z Reject oversaturated VKAs in type family equations - - - - - 6dae133f by Sebastian Graf at 2019-02-02T19:02:35Z Update user-settings.md with a pointer to `Packages` [skip ci] - - - - - 97231c35 by Sebastian Graf at 2019-02-02T19:03:21Z Polished Note [Exceptions and strictness] [ci skip] - - - - - 2d79cd15 by Matthew Pickering at 2019-02-03T03:05:36Z Turn on -Werror when validating - - - - - 558550a6 by Sebastian Graf at 2019-02-03T03:05:36Z Remove unused imports - - - - - 45bd04d6 by Sebastian Graf at 2019-02-03T03:05:36Z Bump hsc2hs for removed unused match - - - - - 71dae4eb by Matthew Pickering at 2019-02-03T03:05:36Z Turn on -Wno-unused-imports in make build system This mirrors Hadrian and it good enough to get us unstuck. - - - - - 59d622d7 by Zejun Wu at 2019-02-03T08:14:03Z docs: change meta-variable of -interactive-print from expr to name `-interactive-print` doesn't accept **expr** as `-e` or `:def` does. It must be a qualified or unqualified **name** in scope. - - - - - 59516e4b by Vladislav Zavialov at 2019-02-03T13:39:15Z Fix missing space in ppr_cmd for HsCmdArrForm - - - - - 8dcd00ce by Matthew Pickering at 2019-02-03T19:20:27Z Add werror function to Flavour.hs This function makes it easy to turn on `-Werror` in the correct manner to mimic how CI turns on -Werror. - - - - - eeabeb92 by Vladislav Zavialov at 2019-02-04T03:10:29Z Report multiple errors - - - - - 461c447d by Ben Gamari at 2019-02-04T06:52:02Z testsuite: Skip T15897 in unregisterised way As noted in #16227 this test routinely times out when run in the unregisterised way. See also #15467. - - - - - e0c0bde4 by Ben Gamari at 2019-02-04T06:52:02Z testsuite: Use makefile_test for T16212 - - - - - 626b63b2 by Ben Gamari at 2019-02-04T11:30:47Z testsuite: Mark print037 as broken when GHC is built with LLVM As noted in #16205 this configuration reliably segfaults. - - - - - ef25b59a by Ben Gamari at 2019-02-04T11:30:47Z gitlab-ci: Don't allow x86_64-linux-deb9-llvm to fail - - - - - 406e43af by Zejun Wu at 2019-02-04T16:04:22Z Add `-fplugin-trustworthy` to avoid marking modules as unsafe By default, when a module is compiled with plugins, it will be marked as unsafe. With this flag passed, all plugins are treated as trustworthy and the safety inference will no longer be affected. This fixes Trac #16260. - - - - - ab493423 by Vladislav Zavialov at 2019-02-05T12:23:04Z Refactor splice_exp in Parser.y - - - - - e88e083d by Ryan Scott at 2019-02-06T00:57:29Z Fix #14579 by defining tyConAppNeedsKindSig, and using it - - - - - 9292a183 by Vladislav Zavialov at 2019-02-06T06:15:27Z Add int-index as parser/* codeowner - - - - - c07e7ecb by Ryan Scott at 2019-02-06T10:32:34Z Fix #16287 by checking for more unsaturated synonym arguments Trac #16287 shows that we were checking for unsaturated type synonym arguments (in `:kind`) when the argument was to a type synonym, but _not_ when the argument was to some other form of type constructor, such as a data type. The solution is to use the machinery that rejects unsaturated type synonym arguments (previously confined to `check_syn_tc_app`) to `check_arg_type`, which checks these other forms of arguments. While I was in town, I cleaned up `check_syn_tc_app` a bit to only invoke `check_arg_type` so as to minimize the number of different code paths that that function could go down. - - - - - c32de5f4 by Ben Gamari at 2019-02-07T06:55:42Z gitlab-ci: Add a devel2 build - - - - - 0620e59a by Ben Gamari at 2019-02-07T06:55:42Z gitlab-ci: More aggressive artifact expiration - - - - - 701cfb3e by Matthew Pickering at 2019-02-07T06:55:42Z Revert "gitlab-ci: More aggressive artifact expiration" This reverts commit d87b38a2519212aaf8bad927c65abecc509a7212. - - - - - 606db8c2 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark T11334b as broken in debugged compiler As noted in #16112. - - - - - 7e495b40 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark recomp007 as broken in debugged compiler As noted in #14759, this triggers a warning in ListSetOps. - - - - - 71d5ab07 by Ben Gamari at 2019-02-07T06:55:42Z testsuite: Mark T14740 and tcfail159 as broken in debugged compiler As noted in #16113, these trigger an assertion in isUnliftedRuntimeRep. - - - - - aad05fb3 by Ben Gamari at 2019-02-07T06:55:43Z testsuite: Mark T5515 as broken with debugged compiler As noted in #16251. - - - - - 2b90356d by Richard Eisenberg at 2019-02-08T15:59:28Z Fix #14729 by making the normaliser homogeneous This ports the fix to #12919 to the normaliser. (#12919 was about the flattener.) Because the fix is involved, this is done by moving the critical piece of code to Coercion, and then calling this from both the flattener and the normaliser. The key bit is: simplifying type families in a type is always a *homogeneous* operation. See #12919 for a discussion of why this is the Right Way to simplify type families. Also fixes #15549. test case: dependent/should_compile/T14729{,kind} typecheck/should_compile/T15549[ab] - - - - - 03b7abc1 by klebinger.andreas at gmx.at at 2019-02-08T16:00:15Z Allow resizing the stack for the graph allocator. The graph allocator now dynamically resizes the number of stack slots when running into the limit. This fixes #8657. Also loop membership of basic blocks is now available in the register allocator for cost heuristics. - - - - - 14eb23c1 by Herbert Valerio Riedel at 2019-02-08T16:00:16Z Update hpc submodule - - - - - bac64c32 by Tamar Christina at 2019-02-08T16:00:17Z Hadrian: compile libgmp static on Windows - - - - - d97f0db8 by Sylvain Henry at 2019-02-08T16:00:18Z Fix test for T16180 on Darwin (fix #16128) - - - - - ee522983 by Langston Barrett at 2019-02-08T16:00:19Z TestEquality instance for Compose - - - - - a9bef62b by Langston Barrett at 2019-02-08T16:00:19Z Add a changelog for base 4.14.0.0 - - - - - 41df8e39 by Herbert Valerio Riedel at 2019-02-08T16:00:20Z Update filepath submodule - - - - - be8a803f by Herbert Valerio Riedel at 2019-02-08T16:00:21Z Update directory submodule - - - - - f17a5765 by Neil Mitchell at 2019-02-08T16:00:22Z ImplicitParams does not imply FlexibleContexts or FlexibleInstances, fixes #16248 - - - - - be15f745 by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: more explicit foralls fixup The AnnForall annotations introduced via Phab:D4894 are not always attached to the correct SourceSpan. Closes #16230 - - - - - cbfc9fca by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: AnnAt disconnected for TYPEAPP For the code type family F1 (a :: k) (f :: k -> Type) :: Type where F1 @Peano a f = T @Peano f a the API annotation for the first @ is not attached to a SourceSpan in the ParsedSource Closes #16236 - - - - - 5e9888bd by Alan Zimmerman at 2019-02-08T16:00:22Z API Annotations: parens anns discarded for `(*)` operator The patch from https://phabricator.haskell.org/D4865 introduces go _ (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix = do { warnStarBndr l ; let name = mkOccName tcClsName (if isUni then "★" else "*") ; return (cL l (Unqual name), acc, fix, ann) } which discards the parens annotations belonging to the HsParTy. Updates haddock submodule Closes #16265 - - - - - c1cf2693 by Alan Zimmerman at 2019-02-08T16:00:22Z Lexer: Alternate Layout Rule injects actual not virtual braces When the alternate layout rule is activated via a pragma, it injects tokens for { and } to make sure that the source is parsed properly. But it injects ITocurly and ITccurly, rather than their virtual counterparts ITvocurly and ITvccurly. This causes problems for ghc-exactprint, which tries to print these. Likewise, any injected ITsemi should have a zero-width SrcSpan. Test case (the existing T13087.hs) {-# LANGUAGE AlternativeLayoutRule #-} {-# LANGUAGE LambdaCase #-} isOne :: Int -> Bool isOne = \case 1 -> True _ -> False main = return () Closes #16279 - - - - - 7ff127f9 by Ben Gamari at 2019-02-08T16:00:22Z rts/ProfilerReportJson: Fix format string This was warning on i386. - - - - - ced729f6 by Sylvain Henry at 2019-02-08T16:00:24Z Cleanup in parser/Ctype.hs * GHC now performs constant folding on bit operations like (.|.) so we use them and we remove the misleading comment * we use Word8 instead of Int and we remove the useless conversion to Int32. Hopefully future releases of GHC could transform the big case in `charType` into a value table indexing instead of a jump table. Word8 would make the table smaller. * we use INLINABLE pragma instead of INLINE on `is_ctype`: in my test, the latter *prevents* `is_ctype` to be inlined because `charType` is inlined into `is_ctype` (to call charType`s worker on the unboxed Char directly). - - - - - 071bef18 by Vladislav Zavialov at 2019-02-08T16:00:24Z Fix optSemi type in Parser.y The definition of 'optSemi' claimed it had type ([Located a],Bool) Note that its production actually returns ([Located Token],Bool): : ';' { ([$1],True) } -- $1 :: Located Token Due to an infelicity in the implementation of 'happy -c', it effectively resulted in 'unsafeCoerce :: Token -> a'. See https://github.com/simonmar/happy/pull/134 If any consumer of 'optSemi' tried to instantiate 'a' to something not representationally equal to 'Token', they would experience a segfault. In addition to that, this definition made it impossible to compile Parser.y without the -c flag (as it's reliant on this bug to cast 'Token' to 'forall a. a'). - - - - - 0a4bbb52 by Ömer Sinan Ağacan at 2019-02-08T16:00:26Z Remove a few undefined prel names - breakpointAuto - breakpointJump - breakpointCondJump - breakpointAutoJump These Ids are never defined, but there were definitions about those in PrelNames. Those are now removed. - - - - - 616b2ef5 by Simon Peyton Jones at 2019-02-08T16:00:26Z Comments only - - - - - cefb780e by Simon Peyton Jones at 2019-02-08T16:00:26Z Comments only about the binder-swap in OccurAnal - - - - - 9bb23d5f by Simon Peyton Jones at 2019-02-08T16:00:26Z Minor refactor of CUSK handling Previously, in getFamDeclInitialKind, we were figuring out whether the enclosing class decl had a CUSK very indirectly, via tcTyConIsPoly. This patch just makes the computation much more direct and easy to grok. No change in behaviour. - - - - - fb031b9b by Tamar Christina at 2019-02-09T10:50:23Z Stack: fix name mangling. - - - - - 9170daa8 by klebinger.andreas at gmx.at at 2019-02-09T17:22:13Z Replace a few uses of snocView with last/lastMaybe. These never used the first part of the result from snocView. Hence replacing them with last[Maybe] is both clearer and gives better performance. - - - - - f4d8e907 by klebinger.andreas at gmx.at at 2019-02-09T17:22:13Z Improve snocView implementation. The new implementation isn't tailrecursive and instead builds up the initial part of the list as it goes. This improves allocation numbers as we don't build up an intermediate list just to reverse it later. This is slightly slower for lists of size <= 3. But in benchmarks significantly faster for any list above 5 elements, assuming the majority of the resulting list will be evaluated. - - - - - 9adb7f64 by Neil Mitchell at 2019-02-09T17:22:30Z Simplify the build.stack.bat script to use 'stack run' - - - - - 249b0bab by Neil Mitchell at 2019-02-09T17:22:30Z Upgrade to the latest stack resolver - - - - - 3fcf79a4 by Alec Theriault at 2019-02-10T07:39:06Z Fix inverted position pragma flag in parser API The behviour of `lexTokenStream` around position pragma was accidentally inverted in 469fe6133646df5568c9486de2202124cb734242. This fixes that bug. This also unbreaks #16239. - - - - - e67384f4 by Alec Theriault at 2019-02-10T07:39:06Z Fix invalid doc comment The invalid doc comments were exposed by 24b39ce53eedad4cefc30f6786542d2072d1f9b0. The fix is to properly escaped the `{-` and `-}` in the doc comments. Some other miscallaneous markup issues are also fixed. - - - - - 53a870f4 by Alec Theriault at 2019-02-10T07:39:06Z Make CI via Hadrian build docs - - - - - 027017fb by Sylvain Henry at 2019-02-10T07:39:23Z Remove ghctags (#16274) - - - - - a48753bd by Matthew Pickering at 2019-02-10T13:35:46Z Capture and simplify constraints arising from running typed splices This fixes a regression caused by #15471 where splicing in a trivial program such as `[|| return () ||]` would fail as the dictionary for `return` would never get bound in the module containing the splice. Arguably this is symptomatic of a major problem affecting TTH where we serialise renamed asts and then retype check them. The reference to the dictionary should be fully determined at the quote site so that splicing doesn't have to solve any implicits at all. It's a coincidence this works due to coherence but see #15863 and #15865 for examples where things do go very wrong. Fixes #16195 - - - - - 224fec69 by Ben Gamari at 2019-02-10T13:37:59Z testsuite: Report stdout and stderr in JUnit output This patch makes the JUnit output more useful as now we also report the stdout/stderr in the message which can be used to quickly identify why a test is failing without downloading the log. This also introduces TestResult, previously we were simply passing around tuples, making things the implementation rather difficult to follow and harder to extend. - - - - - f53ef1a7 by Ben Gamari at 2019-02-10T13:40:03Z testsuite: Always skip T15897 See #16193. - - - - - 07f5cbc8 by Peter Trommler at 2019-02-10T13:42:09Z Fix Int overflow on 32 bit platform - - - - - b1662e81 by Alec Theriault at 2019-02-10T14:02:24Z Hadrian: add LLVM flavours This adds a handful of LLVM flavours and the accompanying documentation. These flavours are mostly uninteresting, but exist in the Make system. - - - - - 180c9762 by Matthew Pickering at 2019-02-11T13:25:37Z testsuite: Report unexpected passes in junit output - - - - - 093fa2ff by Herbert Valerio Riedel at 2019-02-12T07:37:52Z Update array submodule - - - - - 6399965d by Matthew Pickering at 2019-02-12T07:43:57Z Add explicit dependencies to cleanup-darwin - - - - - 012257c1 by Ryan Scott at 2019-02-12T07:50:03Z Fix #16293 by cleaning up Proxy# infelicities This bug fixes three problems related to `Proxy#`/`proxy#`: 1. Reifying it with TH claims that the `Proxy#` type constructor has two arguments, but that ought to be one for consistency with TH's treatment for other primitive type constructors like `(->)`. This was fixed by just returning the number of `tyConVisibleTyVars` instead of using `tyConArity` (which includes invisible arguments). 2. The role of `Proxy#`'s visible argument was hard-coded as nominal. Easily fixed by changing it to phantom. 3. The visibility of `proxy#`'s kind argument was specified, which is different from the `Proxy` constructor (which treats it as inferred). Some minor refactoring in `proxyHashId` fixed ths up. Along the way, I had to introduce a `mkSpecForAllTy` function, so I did some related Haddock cleanup in `Type`, where that function lives. - - - - - 4a4ae70f by Richard Eisenberg at 2019-02-12T07:56:09Z Fix #16188 There was an awful lot of zipping going on in canDecomposableTyConAppOK, and one of the lists being zipped was too short, causing the result to be too short. Easily fixed. Also fixes #16204 and #16225 test case: typecheck/should_compile/T16188 typecheck/should_compile/T16204[ab] typecheck/should_fail/T16204c typecheck/should_compile/T16225 - - - - - 8b476d82 by Ryan Scott at 2019-02-12T08:02:14Z Fix #16299 by deleting incorrect code from IfaceSyn GHCi's `:info` command was pretty-printing Haskell98-style data types with explicit return kinds if the return kind wasn't `Type`. This leads to bizarre output like this: ``` λ> :i (##) data (##) :: TYPE ('GHC.Types.TupleRep '[]) = (##) -- Defined in ‘GHC.Prim’ ``` Or, with unlifted newtypes: ``` λ> newtype T = MkT Int# λ> :i T newtype T :: TYPE 'IntRep = MkT Int# -- Defined at <interactive>:5:1 ``` The solution is simple: just delete one part from `IfaceSyn` where GHC mistakenly pretty-prints the return kinds for non-GADTs. - - - - - a08f463b by nineonine at 2019-02-13T00:48:38Z Fix #15849 by checking whether there's a do block - - - - - 28683137 by Ben Gamari at 2019-02-13T00:54:43Z configure: Document CLANG, LLC, and OPT variables - - - - - 6b890d76 by Ömer Sinan Ağacan at 2019-02-13T13:21:18Z Fix checkStackChunk() call in Interepter.c, enable an assertion Fixes #16303 - - - - - 4af0a2d6 by Herbert Valerio Riedel at 2019-02-13T13:27:27Z Update parallel submodule - - - - - e40f00dc by Alexandre Esteves at 2019-02-14T01:07:28Z Fix typos [skip ci] - - - - - 7f26b74e by Alec Theriault at 2019-02-14T01:13:34Z Add `liftedTyped` to `Lift` class Implements GHC proposal 43, adding a `liftTyped` method to the `Lift` typeclass. This also adds some documentation to `TExp`, describing typed splices and their advantages over their untyped counterparts. Resolves #14671. - - - - - 0f1eb88c by Sylvain Henry at 2019-02-14T07:29:54Z Add perf test for #16190 - - - - - 1d9a1d9f by Sylvain Henry at 2019-02-14T07:29:54Z NCG: fast compilation of very large strings (#16190) This patch adds an optimization into the NCG: for large strings (threshold configurable via -fbinary-blob-threshold=NNN flag), instead of printing `.asciz "..."` in the generated ASM source, we print `.incbin "tmpXXX.dat"` and we dump the contents of the string into a temporary "tmpXXX.dat" file. See the note for more details. - - - - - 19626218 by Matthew Pickering at 2019-02-14T07:36:02Z Implement -Wredundant-record-wildcards and -Wunused-record-wildcards -Wredundant-record-wildcards warns when a .. pattern binds no variables. -Wunused-record-wildcards warns when none of the variables bound by a .. pattern are used. These flags are enabled by `-Wall`. - - - - - 68278382 by Simon Peyton Jones at 2019-02-14T08:40:03Z Make a smart mkAppTyM This patch finally delivers on Trac #15952. Specifically * Completely remove Note [The tcType invariant], along with its complicated consequences (IT1-IT6). * Replace Note [The well-kinded type invariant] with: Note [The Purely Kinded Type Invariant (PKTI)] * Instead, establish the (PKTI) in TcHsType.tcInferApps, by using a new function mkAppTyM when building a type application. See Note [mkAppTyM]. * As a result we can remove the delicate mkNakedXX functions entirely. Specifically, mkNakedCastTy retained lots of extremly delicate Refl coercions which just cluttered everything up, and(worse) were very vulnerable to being silently eliminated by (say) substTy. This led to a succession of bug reports. The result is noticeably simpler to explain, simpler to code, and Richard and I are much more confident that it is correct. It does not actually fix any bugs, but it brings us closer. E.g. I hoped it'd fix #15918 and #15799, but it doesn't quite do so. However, it makes it much easier to fix. I also did a raft of other minor refactorings: * Use tcTypeKind consistently in the type checker * Rename tcInstTyBinders to tcInvisibleTyBinders, and refactor it a bit * Refactor tcEqType, pickyEqType, tcEqTypeVis Simpler, probably more efficient. * Make zonkTcType zonk TcTyCons, at least if they have any free unification variables -- see zonk_tc_tycon in TcMType.zonkTcTypeMapper. Not zonking these TcTyCons was actually a bug before. * Simplify try_to_reduce_no_cache in TcFlatten (a lot) * Combine checkExpectedKind and checkExpectedKindX. And then combine the invisible-binder instantation code Much simpler now. * Fix a little bug in TcMType.skolemiseQuantifiedTyVar. I'm not sure how I came across this originally. * Fix a little bug in TyCoRep.isUnliftedRuntimeRep (the ASSERT was over-zealous). Again I'm not certain how I encountered this. * Add a missing solveLocalEqualities in TcHsType.tcHsPartialSigType. I came across this when trying to get level numbers right. - - - - - 5c1f268e by Simon Peyton Jones at 2019-02-14T08:40:03Z Fail fast in solveLocalEqualities This patch makes us fail fast in TcSimplify.solveLocalEqualities, and in TcHsType.tc_hs_sig_type, if there are insoluble constraints. Previously we ploughed on even if there were insoluble constraints, leading to a cascade of hard-to-understand type errors. Failing eagerly is much better; hence a lot of testsuite error message changes. Eg if we have f :: [Maybe] -> blah f xs = e then trying typecheck 'f x = e' with an utterly bogus type is just asking for trouble. I can't quite remember what provoked me to make this change, but I think the error messages are notably improved, by removing confusing clutter and focusing on the real error. - - - - - b31df5ca by Vladislav Zavialov at 2019-02-15T12:23:00Z Hadrian: enable -Wcompat=error in the testsuite - - - - - 887454d8 by Vladislav Zavialov at 2019-02-15T12:29:05Z 'forall' always a keyword, plus the dot type operator - - - - - 173d0cee by Alec Theriault at 2019-02-15T23:35:28Z Properly escape character literals in Haddocks Character literals in Haddock should not be written as plain `'\n'` since single quotes are for linking identifiers. Besides, since we want the character literal to be monospaced, we really should use `@\'\\n\'@`. [skip ci] - - - - - bcaba30a by klebinger.andreas at gmx.at at 2019-02-15T23:41:36Z Don't wrap the entry map for LiveInfo in Maybe. It never really encoded a invariant. * The linear register allocator just did partial pattern matches * The graph allocator just set it to (Just mapEmpty) for Nothing So I changed LiveInfo to directly contain the map. Further natCmmTopToLive which filled in Nothing is no longer exported. Instead we know call cmmTopLiveness which changes the type AND fills in the map. - - - - - 0b92bdc7 by David Eichmann at 2019-02-16T06:07:53Z Fix and Reapply "Performance tests: recover a baseline from ancestor commits and CI results." - - - - - 9b39597b by Matthew Pickering at 2019-02-16T06:14:00Z Fix tests which were made to pass by "Make a smart mkAppTyM" For some reason gitlab is not reporting these as failures in CI. It's not clear to me why as the junit output looks fine. Fixes #16112 and #16113 They were fixed by 682783828275cca5fd8bf5be5b52054c75e0e22c - - - - - 5544f608 by Matthew Pickering at 2019-02-16T06:14:00Z Remove Simon's special number from typecheck/should_fail/all.t - - - - - 7752fa54 by Ömer Sinan Ağacan at 2019-02-16T14:10:23Z Minor documentation fix in GHC.ForeignPtr - - - - - 3cb063c8 by Alec Theriault at 2019-02-16T14:16:32Z Remove `parallel` as a submodule `parallel` is used in exactly one place in the GHC tree: the T2317 test. It seems almost by accident that it is a submodule; libraries needed only for tests should net be included as submodules (see `QuickCheck`, `async`, `haskell98`, `regex-compat`, `utf8-string`, `vector` and more for examples). T2317 will now get run only when `parallel` is installed instead of `parallel` being required for the testsuite to run. - - - - - 69ebf5cb by Matthew Pickering at 2019-02-16T14:22:38Z HIE: Save module name and module exports - - - - - af7b0fdb by Peter Trommler at 2019-02-17T03:49:09Z Cmm: Promote stack arguments to word size Smaller than word size integers must be promoted to word size when passed on the stack. While on little endian systems we can get away with writing a small integer to a word size stack slot and read it as a word ignoring the upper bits, on big endian systems a small integer write ends up in the most significant bits and a word size read that ignores the upper bits delivers a random value. On little endian systems a smaller than word size write to the stack might be more efficient but that decision is system specific and should be done as an optimization in the respective backends. Fixes #16258 - - - - - 4a09d30b by Alec Theriault at 2019-02-17T03:55:16Z Run some of Haddock's tests in the testsuite The 4 main testsuites in Haddock don't have many dependencies, but are regularly broken in small ways by changes to the GHC AST or the GHC API. The main gotcha is that we'll have to make sure that `haddock-test` and the test suite don't add modules without modifying this test. Then again, if that happens, the test will fail and someone will noticed. - - - - - 0fff3ae6 by Tamar Christina at 2019-02-18T00:52:24Z Testsuite: implement use_specs. - - - - - 1f1b9e35 by Simon Peyton Jones at 2019-02-18T00:58:29Z Get rid of tcm_smart from TyCoMapper Following a succession of refactorings of the type checker, culminating in the patch Make a smart mkAppTyM we have got rid of mkNakedAppTy etc. And that in turn meant that the tcm_smart field of the generic TyCoMapper (in Type.hs) was entirely unused. It was always set to True. So this patch just gets rid of it completely. Less code, less complexity, and more efficient because fewer higher-order function calls. Everyone wins. No change in behaviour; this does not cure any bugs! - - - - - 1ffee940 by Vladislav Zavialov at 2019-02-18T01:04:33Z Fix warnings and fatal parsing errors - - - - - 2a431640 by Alec Theriault at 2019-02-18T15:31:18Z Uphold AvailTC Invariant for associated data fams The AvailTC was not be upheld for explicit export module export lists when the module contains associated data families. module A (module A) where class C a where { data T a } instance C () where { data T () = D } Used to (incorrectly) report avails as `[C{C, T;}, T{D;}]`. Note that although `T` is exported, the avail where it is the parent does _not_ list it as its first element. This avail is now correctly listed as `[C{C, T;}, T{T, D;}]`. This was induces a [crash in Haddock][0]. See #16077. [0]: https://github.com/haskell/haddock/issues/979 - - - - - 129a800d by Alexandre Baldé at 2019-02-19T00:17:33Z Fix Haddock comment for Integer datatype Move implementation notes for Integer to Haddock named section Revert documentation named chunk change [skip ci] Haddock's named chunk feature was not used correctly in this case, as it cannot export only parts of a Haddock top level comment. As such, it was removed and replaced by a message informing the end- user to browse the source code for detailed information. - - - - - 9049bfb1 by Krzysztof Gogolewski at 2019-02-19T11:14:04Z Disable binder swap in OccurAnal (Trac #16288) - - - - - b78cc64e by Arnaud Spiwack at 2019-02-19T11:14:04Z Make constructor wrappers inline only during the final phase For case-of-known constructor to continue triggering early, exprIsConApp_maybe is now capable of looking through lets and cases. See #15840 - - - - - 7833cf40 by Krzysztof Gogolewski at 2019-02-19T11:14:04Z Look through newtype wrappers (Trac #16254) exprIsConApp_maybe could detect that I# 10 is a constructor application, but not that Size (I# 10) is, because it was an application with a nontrivial argument. - - - - - 76ac103f by Niklas Hambüchen at 2019-02-19T11:20:13Z base: Document errno behaviour in haddocks. Also add an implementation comment for details. - - - - - 9f5b11fa by Ömer Sinan Ağacan at 2019-02-19T11:26:17Z Remove arc scripts - - - - - 908b4b86 by Ömer Sinan Ağacan at 2019-02-20T14:53:07Z Fix two bugs in stg_ap_0_fast in profiling runtime This includes two bug fixes in profiling version of stg_ap_0_fast: - PAPs allocated by stg_ap_0_fast are now correctly tagged. This invariant is checked in Sanity.c:checkPAP. (This was originally implemented in 2693eb11f5, later reverted with ab55b4ddb7 because it revealed the bug below, but it wasn't clear at the time whether the bug was the one below or something in the commit) - The local variable `untaggedfun` is now marked as a pointer so it survives GC. With this we finally fix all known bugs caught in #15508. `concprog001` now works reliably with prof+threaded and prof runtimes (with and without -debug). - - - - - 1dad4fc2 by Andrey Mokhov at 2019-02-20T14:59:16Z Hadrian: Fix untracked dependencies This is a preparation for #16295: https://ghc.haskell.org/trac/ghc/ticket/16295 This commit mostly focuses on getting rid of untracked dependencies, which prevent Shake's new `--shared` feature from appropriately caching build rules. There are three different solutions to untracked dependencies: * Track them! This is the obvious and the best approach, but in some situations we cannot use it, for example, because a build rule creates files whose names are not known statically and hence cannot be specified as the rule's outputs. * Use Shake's `produces` to record outputs dynamically, within the rule. * Use Shake's `historyDisable` to disable caching for a particular build rule. We currently use this approach only for `ghc-pkg` which mutates the package database and the file `package.cache`. These two tickets are fixed as the result: Ticket #16271: ​https://ghc.haskell.org/trac/ghc/ticket/16271 Ticket #16272: ​https://ghc.haskell.org/trac/ghc/ticket/16272 (this one is fixed only partially: we correctly record the dependency, but we still copy files into the RTS build tree). - - - - - eda456f6 by Matthew Pickering at 2019-02-20T14:59:16Z CI: Run `cabal update` before trying to build Hadrian - - - - - aa79f65c by Ryan Scott at 2019-02-20T15:05:21Z Bump ghc version to 8.9 Along the way, I discovered that `template-haskell.cabal` was hard-coding the GHC version (in the form of its `ghc-boot-th` version bounds), so I decided to make life a little simpler in the future by generating `template-haskell.cabal` with autoconf. - - - - - 2e96ce1f by Dmitry Ivanov at 2019-02-20T15:11:28Z Test bit-manipulating primops under respective arch flags like -msse4.2 - - - - - 2209ea86 by Simon Peyton Jones at 2019-02-20T15:17:34Z Add comments about how zip fusion Alexandre Balde (rockbmb) points out that the fusion technology for foldr2, zip, zipWith, etc is undocumented. This patch adds comments to explain. - - - - - e86606f2 by Simon Peyton Jones at 2019-02-20T15:17:34Z Tiny refactor in isUnliftedRuntimeRep No change in behaviour, slightly more efficient - - - - - 5eeefe4c by Simon Peyton Jones at 2019-02-20T15:17:34Z Improve the very simple optimiser slightly There was a missing case in the very simple optimiser, CoreOpt.simpleOptExpr, which led to Trac #13208 comment:2. In particular, in simple_app, if we find a Let, we should just float it outwards. Otherwise we leave behind some easy-to-reduce beta-redexes. - - - - - 3f73f081 by Simon Peyton Jones at 2019-02-20T15:17:34Z Comments only, in GhcPrelude - - - - - 2a0be146 by Vaibhav Sagar at 2019-02-21T09:14:01Z Text.ParserCombinators.ReadP: use NonEmpty in Final The `Final` constructor needed to maintain the invariant that the list it is provided is always non-empty. Since NonEmpty is in `base` now, I think it would be better to use it for this purpose. - - - - - 32f44ed8 by David Eichmann at 2019-02-21T09:20:09Z Fix test runner crash when not in a git repo Respect `inside_git_repo()` when checking performance stats. - - - - - 2f4af71e by Vladislav Zavialov at 2019-02-21T09:26:15Z Dot/bang operators in export lists (Trac #16339) The dot type operator was handled in the 'tyvarop' parser production, and the bang type operator in 'tyapp'. However, export lists and role annotations use 'oqtycon', so these type operators could not be exported or assigned roles. The fix is to handle them in a lower level production, 'tyconsym'. - - - - - e204431e by Vladislav Zavialov at 2019-02-21T09:26:15Z Handle the (~) type operator in 'tyconsym' By parsing '~' in 'tyconsym' instead of 'oqtycon', we get one less shift/reduce conflict. - - - - - 48aafc24 by Tamar Christina at 2019-02-22T01:52:42Z Testsuite: opt-in to symlinks on Windows - - - - - 9db92cf0 by Tamar Christina at 2019-02-22T01:52:42Z Set builder env - - - - - 0e2d300a by Niklas Hambüchen at 2019-02-22T01:58:47Z compiler: Write .o files atomically. See #14533 This issue was reproduced with, and the fix confirmed with, the `hatrace` tool for syscall-based fault injection: https://github.com/nh2/hatrace The concrete test case for GHC is at https://github.com/nh2/hatrace/blob/e23d35a2d2c79e8bf49e9e2266b3ff7094267f29/test/HatraceSpec.hs#L185 A previous, nondeterministic reproducer for the issue was provided by Alexey Kuleshevich in https://github.com/lehins/exec-kill-loop Signed-off-by: Niklas Hambüchen <niklas at fpcomplete.com> Reviewed-by: Alexey Kuleshevich <alexey at fpcomplete.com> - - - - - e8a08f40 by Niklas Hambüchen at 2019-02-22T01:58:47Z compiler: Refactor: extract `withAtomicRename` - - - - - 473632d7 by klebinger.andreas at gmx.at at 2019-02-22T02:04:55Z Bump nofib submodule. - - - - - a07f46ea by Simon Peyton Jones at 2019-02-22T06:56:08Z Remove tcTyConUserTyVars The tcTyConUserTyVars field of TcTyCon was entirely unused. This patch kills it off entirely. - - - - - 0eb7cf03 by Simon Peyton Jones at 2019-02-22T06:56:08Z Don't do binder-swap for GlobalIds This patch disables the binder-swap transformation in the (relatively rare) case when the scrutinee is a GlobalId. Reason: we are getting Lint errors so that GHC doesn't even validate. Trac #16346. This is NOT the final solution -- it's just a stop-gap to get us running again. The final solution is in Trac #16296 - - - - - c25b135f by Simon Peyton Jones at 2019-02-22T06:56:08Z Fix exprIsConApp_maybe In this commit commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) we made exprIsConApp_maybe quite a bit cleverer. But I had not paid enough attention to keeping exactly the correct substitution and in-scope set, which led to Trac #16348. There were several buglets (like applying the substitution twice in exprIsConApp_maybe, but the proximate source of the bug was that we were calling addNewInScopeIds, which deleted things from the substitution as well as adding them to the in-scope set. That's usually right, but not here! This was quite tricky to track down. But it is nicer now. - - - - - 44ad7215 by Matthew Pickering at 2019-02-22T06:56:08Z Use validate flavour rather than devel2 for DEBUG CI job This also builds stage2 with optimisations and -dcore-lint - - - - - 806cc234 by David Eichmann at 2019-02-23T04:35:18Z Build and copy libffi shared libraries correctly and enable dynamically linking ghc. Test Plan: Ensure build environment does NOT have a system libffi installed (you may want to use a nix environment). Then `hadrian/build.sh -c --flavour=default` Reviewers: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15837 - - - - - 4b752d52 by Oleg Grenrus at 2019-02-23T04:41:25Z Update CI images to GHC-8.4.4 & cabal-install-2.4.1.0 Use official bindists, except for Debian 9/Stretch http://downloads.haskell.org/debian/ is used. (There are no recent GHC/cabal-install for Debian 8/Jessie there) Use v2-update/v2-install to install Haskell tools. Try to unify structure of the different Dockerfiles, incl installing GHC in one step (this will prevent sublayers from existing, making final image slightly smaller) - - - - - e87ae473 by Artem Pyanykh at 2019-02-23T04:47:32Z Drop support for i386 and PowerPC in MachO linker Some code is broken, there are no CI targets (so not obvious how to test), and no one seems to have built GHC for any of the above platforms in years. - - - - - 04b7f4c1 by Ben Gamari at 2019-02-23T04:53:36Z ghc-in-ghci: Fix capitalization of hieFile - - - - - 2e9426df by Tom Sydney Kerckhove at 2019-02-24T02:25:41Z hWaitForInput-accurate-socket test - - - - - ac34e784 by Simon Peyton Jones at 2019-02-24T02:31:47Z Remove bogus assertion Remove a bogus assertion in FamInst.newFamInst (There is a comment to explain.) This fixes Trac #16112. - - - - - 6cce36f8 by Simon Peyton Jones at 2019-02-24T02:31:47Z Add AnonArgFlag to FunTy The big payload of this patch is: Add an AnonArgFlag to the FunTy constructor of Type, so that (FunTy VisArg t1 t2) means (t1 -> t2) (FunTy InvisArg t1 t2) means (t1 => t2) The big payoff is that we have a simple, local test to make when decomposing a type, leading to many fewer calls to isPredTy. To me the code seems a lot tidier, and probably more efficient (isPredTy has to take the kind of the type). See Note [Function types] in TyCoRep. There are lots of consequences * I made FunTy into a record, so that it'll be easier when we add a linearity field, something that is coming down the road. * Lots of code gets touched in a routine way, simply because it pattern matches on FunTy. * I wanted to make a pattern synonym for (FunTy2 arg res), which picks out just the argument and result type from the record. But alas the pattern-match overlap checker has a heart attack, and either reports false positives, or takes too long. In the end I gave up on pattern synonyms. There's some commented-out code in TyCoRep that shows what I wanted to do. * Much more clarity about predicate types, constraint types and (in particular) equality constraints in kinds. See TyCoRep Note [Types for coercions, predicates, and evidence] and Note [Constraints in kinds]. This made me realise that we need an AnonArgFlag on AnonTCB in a TyConBinder, something that was really plain wrong before. See TyCon Note [AnonTCB InivsArg] * When building function types we must know whether we need VisArg (mkVisFunTy) or InvisArg (mkInvisFunTy). This turned out to be pretty easy in practice. * Pretty-printing of types, esp in IfaceType, gets tidier, because we were already recording the (->) vs (=>) distinction in an ad-hoc way. Death to IfaceFunTy. * mkLamType needs to keep track of whether it is building (t1 -> t2) or (t1 => t2). See Type Note [mkLamType: dictionary arguments] Other minor stuff * Some tidy-up in validity checking involving constraints; Trac #16263 - - - - - e61f6e35 by Vladislav Zavialov at 2019-02-24T02:37:52Z Expression/command ambiguity resolution This patch removes 'HsArrApp' and 'HsArrForm' from 'HsExpr' by introducing a new ambiguity resolution system in the parser. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a command: proc x -> do { (stuff) -< x } -- 'stuff' is an expression proc x -> do { (stuff) } -- 'stuff' is a command Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff' as an expression or a command. The old solution was to parse as HsExpr always, and rejig later: checkCommand :: LHsExpr GhcPs -> P (LHsCmd GhcPs) This meant polluting 'HsExpr' with command-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors by panicking. We fix this abstraction leak by parsing into an intermediate representation, 'ExpCmd': data ExpCmdG b where ExpG :: ExpCmdG HsExpr CmdG :: ExpCmdG HsCmd type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs)) checkExp :: ExpCmd -> PV (LHsExpr GhcPs) checkCmd :: ExpCmd -> PV (LHsCmd GhcPs) checkExp f = f ExpG -- interpret as an expression checkCmd f = f CmdG -- interpret as a command See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/command ambiguity. Future work: apply the same principles to the expression/pattern ambiguity. - - - - - ee284b85 by Herbert Valerio Riedel at 2019-02-24T02:43:58Z Fix regression incorrectly advertising TH support `--supported-languages` must only advertise language extensions which are supported by the compiler in order for tooling such as Cabal relying on this signalling not to behave incorrectly. Fixes #16331 - - - - - a990312e by Matthew Pickering at 2019-02-24T02:50:02Z Exit with exit code 1 when tests unexpectedly pass This was causing gitlab to not report from builds as failing. It also highlighted a problem with the LLVM tests where some of the external interpreter tests are failing. - - - - - 1059e234 by Ben Gamari at 2019-02-24T02:56:06Z gitlab-ci: Only build x86_64-deb8 and fedora27 for releases These are largely redundant as they are covered by x86_64-deb9. - - - - - b85068f6 by Sebastian Graf at 2019-02-24T03:02:10Z Include closure header size in StgLamLift's estimations While playing around with late lambda lifting, I realised that StgLamLift.Analysis doesn't consider the removed closure header in its allocation estimations. That's because contrary to what I thought, the total word count returned by `mkVirtHeapOffsets` doesn't include the size of the closure header. We just add the header size manually now. - - - - - 88970187 by Vladislav Zavialov at 2019-02-24T03:08:15Z User's Guide: update info on kind inference We no longer put class variables in front, see "Taming the Kind Inference Monster" (also fix some markup issues) - - - - - ae7d1ff6 by Vladislav Zavialov at 2019-02-24T03:14:19Z User's Guide: forall is a keyword nowadays - - - - - 6ba3421e by Ben Gamari at 2019-02-24T03:20:25Z testsuite: Fix whitespace in hp2ps error message - - - - - 9059343e by Alexandre at 2019-02-24T21:17:06Z base: Allow fusion for zip7 and related Fixes #14037. Metric Decrease: T9872b T9872d Reviewers: bgamari, simonpj, hvr Reviewed By: simonpj Subscribers: AndreasK, simonpj, osa1, dfeuer, rwbarton, carter GHC Trac Issues: #14037 Differential Revision: https://phabricator.haskell.org/D5249 - - - - - 14586f5d by Vladislav Zavialov at 2019-02-24T21:23:11Z Disable fragile test cases: T14697 T5559 T3424 See Trac #15072, Trac #16349, Trac #16350 - - - - - f320f3b2 by Vladislav Zavialov at 2019-02-25T16:19:24Z Fix the ghci063 test on Darwin (Trac #16201) We use "touch -r" to set modification timestamps, which leads to precision loss on Darwin. For example, before: 2019-02-25 01:11:23.807627350 +0300 after: 2019-02-25 01:11:23.807627000 +0300 ^^^ This means we can't trick GHCi into thinking the file hasn't been changed by restoring its old timestamp, as we cannot faithfully restore all digits. The solution is to nullify the insignificant digits before the first :load - - - - - 4dbacba5 by Vladislav Zavialov at 2019-02-26T17:36:42Z Skip T3424 when fast() 14586f5d removed this by accident. - - - - - 5bc195b1 by Vladislav Zavialov at 2019-02-27T14:53:52Z Treat kind/type variables identically, demolish FKTV Implements GHC Proposal #24: .../ghc-proposals/blob/master/proposals/0024-no-kind-vars.rst Fixes Trac #16334, Trac #16315 With this patch, scoping rules for type and kind variables have been unified: kind variables no longer receieve special treatment. This simplifies both the language and the implementation. User-facing changes ------------------- * Kind variables are no longer implicitly quantified when an explicit forall is used: p :: Proxy (a :: k) -- still accepted p :: forall k a. Proxy (a :: k) -- still accepted p :: forall a. Proxy (a :: k) -- no longer accepted In other words, now we adhere to the "forall-or-nothing" rule more strictly. Related function: RnTypes.rnImplicitBndrs * The -Wimplicit-kind-vars warning has been deprecated. * Kind variables are no longer implicitly quantified in constructor declarations: data T a = T1 (S (a :: k) | forall (b::k). T2 (S b) -- no longer accepted data T (a :: k) = T1 (S (a :: k) | forall (b::k). T2 (S b) -- still accepted Related function: RnTypes.extractRdrKindSigVars * Implicitly quantified kind variables are no longer put in front of other variables: f :: Proxy (a :: k) -> Proxy (b :: j) f :: forall k j (a :: k) (b :: j). Proxy a -> Proxy b -- old order f :: forall k (a :: k) j (b :: j). Proxy a -> Proxy b -- new order This is a breaking change for users of TypeApplications. Note that we still respect the dpendency order: 'k' before 'a', 'j' before 'b'. See "Ordering of specified variables" in the User's Guide. Related function: RnTypes.rnImplicitBndrs * In type synonyms and type family equations, free variables on the RHS are no longer implicitly quantified unless used in an outermost kind annotation: type T = Just (Nothing :: Maybe a) -- no longer accepted type T = Just Nothing :: Maybe (Maybe a) -- still accepted The latter form is a workaround due to temporary lack of an explicit quantification method. Ideally, we would write something along these lines: type T @a = Just (Nothing :: Maybe a) Related function: RnTypes.extractHsTyRdrTyVarsKindVars * Named wildcards in kinds are fixed (Trac #16334): x :: (Int :: _t) -- this compiles, infers (_t ~ Type) Related function: RnTypes.partition_nwcs Implementation notes -------------------- * One of the key changes is the removal of FKTV in RnTypes: - data FreeKiTyVars = FKTV { fktv_kis :: [Located RdrName] - , fktv_tys :: [Located RdrName] } + type FreeKiTyVars = [Located RdrName] We used to keep track of type and kind variables separately, but now that they are on equal footing when it comes to scoping, we can put them in the same list. * extract_lty and family are no longer parametrized by TypeOrKind, as we now do not distinguish kind variables from type variables. * PatSynExPE and the related Note [Pattern synonym existentials do not scope] have been removed (Trac #16315). With no implicit kind quantification, we can no longer trigger the error. * reportFloatingKvs and the related Note [Free-floating kind vars] have been removed. With no implicit kind quantification, we can no longer trigger the error. - - - - - 5c084e04 by Peter Trommler at 2019-02-27T14:59:59Z RTS: Add missing memory barrier In the work stealing queue a load-load-barrier is required to ensure that a read of queue data cannot be reordered before a read of the bottom pointer into the queue. The added load-load-barrier ensures that the ordering of writes enforced at the end of `pushWSDeque` is also respected in the order of reads in `stealWSDeque_`. In other words, when reading `q->bottom` we want to make sure that we see the updates to `q->elements`. Fixes #13633 - - - - - 2e8f6649 by Vladislav Zavialov at 2019-02-27T15:06:05Z Fix intermittent hie002 failure hie002 is a performance test that used to fail unpredictably: max_bytes_used Decrease from x86_64-linux-deb9-debug baseline @ HEAD~2: Expected hie002 (normal) max_bytes_used: 1190923992.0 +/-20% Lower bound hie002 (normal) max_bytes_used: 952739193 Upper bound hie002 (normal) max_bytes_used: 1429108791 Actual hie002 (normal) max_bytes_used: 726270784 Deviation hie002 (normal) max_bytes_used: -39.0 % peak_megabytes_allocated Decrease from x86_64-linux-deb9-debug baseline @ HEAD~2: Expected hie002 (normal) peak_megabytes_allocated: 2538.0 +/-20% Lower bound hie002 (normal) peak_megabytes_allocated: 2030 Upper bound hie002 (normal) peak_megabytes_allocated: 3046 Actual hie002 (normal) peak_megabytes_allocated: 1587 Deviation hie002 (normal) peak_megabytes_allocated: -37.5 % *** unexpected stat test failure for hie002(normal) 'max_bytes_used' and 'peak_megabytes_allocated' are too unstable without careful control of the runtime configuration. We fix this by using a more predictable metric, 'bytes allocated'. - - - - - f838809f by Moritz Angermann at 2019-02-28T07:20:05Z Cleanup iserv/iserv-proxy This adds trace messages that include the processes name and as such make debugging and following the communication easier. It also adds a note regarding the fwd*Call proxy-communication logic between the proxy and the slave. The proxy will now also poll for 60s to wait for the remote iserv to come up. (Alternatively you can start the remote process beforehand; and just have iserv-proxy connect to it) - - - - - c26d299d by Ryan Scott at 2019-03-01T21:26:02Z Visible dependent quantification This implements GHC proposal 35 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0035-forall-arrow.rst) by adding the ability to write kinds with visible dependent quantification (VDQ). Most of the work for supporting VDQ was actually done _before_ this patch. That is, GHC has been able to reason about kinds with VDQ for some time, but it lacked the ability to let programmers directly write these kinds in the source syntax. This patch is primarly about exposing this ability, by: * Changing `HsForAllTy` to add an additional field of type `ForallVisFlag` to distinguish between invisible `forall`s (i.e, with dots) and visible `forall`s (i.e., with arrows) * Changing `Parser.y` accordingly The rest of the patch mostly concerns adding validity checking to ensure that VDQ is never used in the type of a term (as permitting this would require full-spectrum dependent types). This is accomplished by: * Adding a `vdqAllowed` predicate to `TcValidity`. * Introducing `splitLHsSigmaTyInvis`, a variant of `splitLHsSigmaTy` that only splits invisible `forall`s. This function is used in certain places (e.g., in instance declarations) to ensure that GHC doesn't try to split visible `forall`s (e.g., if it tried splitting `instance forall a -> Show (Blah a)`, then GHC would mistakenly allow that declaration!) This also updates Template Haskell by introducing a new `ForallVisT` constructor to `Type`. Fixes #16326. Also fixes #15658 by documenting this feature in the users' guide. - - - - - f37efb11 by Alec Theriault at 2019-03-01T21:32:09Z Lexer: turn some fatal errors into non-fatal ones The following previously fatal lexer errors are now non-fatal: * errors about enabling `LambdaCase` * errors about enabling `NumericUnderscores` * errors about having valid characters in primitive strings See #16270 - - - - - 8442103a by Alp Mestanogullari at 2019-03-01T21:38:15Z Hadrian: introduce ways to skip some documentation targets The initial motivation for this is to have a chance to run the binary distribution rules in our Windows CI without having to install sphinx-build and xelatex there, while retaining the ability to generate haddocks. I just ended up extending this idea a little bit so as to have control over whether we build haddocks, (sphinx) HTML manuals, (sphinx) PDF manuals and (sphinx) manpages. - - - - - 9aa27273 by Alp Mestanogullari at 2019-03-01T21:38:15Z use --docs=no-sphinx in both Hadrian CI jobs - - - - - b1c7ffaf by David Eichmann at 2019-03-01T21:44:22Z Fix parsing of expected performance changes for tests with non-alpha characters. Python's split() function is used to split on all white space. - - - - - b90695cd by Ben Gamari at 2019-03-01T22:06:49Z gitlab-ci: Pull docker images from ghc/ci-images registry - - - - - 161f102b by Ben Gamari at 2019-03-01T22:07:28Z Drop Docker images These have been moved to the ghc/ci-images project. - - - - - d298cb9c by Ben Gamari at 2019-03-01T22:07:28Z gitlab-ci: Produce DWARF-enabled binary distribution - - - - - aeefc90c by Ben Gamari at 2019-03-01T22:07:28Z testsuite: Suppress ticks when comparing -ddump-simpl output Otherwise these tests break spuriously when core libraries are compiled with source notes. - - - - - 1bceb643 by Ben Gamari at 2019-03-01T22:07:28Z gitlab-ci: Give deb9-unreg job a distinct cache key - - - - - 1285d6b9 by Ben Gamari at 2019-03-02T23:32:22Z gitlab-ci: A bit of reorganization - - - - - f77229e3 by Alp Mestanogullari at 2019-03-04T00:35:18Z detect 'autoreconf' path during configure, and use it in hadrian - - - - - e2ae52c3 by Alec Theriault at 2019-03-04T15:18:41Z Don't leave .hi files after running Haddock tests RyanGlScott observed in https://github.com/haskell/haddock/issues/1030 that running Haddock tests in GHC's testsuite left some `.hi` files around in `utils/haddock`. This should fix that problem. - - - - - 22c2713b by Alp Mestanogullari at 2019-03-04T15:18:41Z Hadrian: track mingw, ship it in bindists, more robust install script - - - - - e7080bef by Ben Gamari at 2019-03-04T15:18:41Z Revert "compiler: Refactor: extract `withAtomicRename`" This reverts commit e8a08f400744a860d1366c6680c8419d30f7cc2a. - - - - - e6ce1743 by Ben Gamari at 2019-03-04T15:18:41Z Revert "compiler: Write .o files atomically. See #14533" This reverts commit 0e2d300a59b1b5c167d2e7d99a448c8663ba6d7d. - - - - - 80dfcee6 by Simon Peyton Jones at 2019-03-05T08:09:41Z Be more careful when naming TyCon binders This patch fixes two rather gnarly test cases: * Trac #16342 (mutual recursion) See Note [Tricky scoping in generaliseTcTyCon] * Trac #16221 (shadowing) See Note [Unification variables need fresh Names] The main changes are: * Substantial reworking of TcTyClsDecls.generaliseTcTyCon This is the big change, and involves the rather tricky function TcHsSyn.zonkRecTyVarBndrs. See Note [Inferring kinds for type declarations] and Note [Tricky scoping in generaliseTcTyCon] for the details. * bindExplicitTKBndrs_Tv and bindImplicitTKBndrs_Tv both now allocate /freshly-named/ unification variables. Indeed, more generally, unification variables are always fresh; see Note [Unification variables need fresh Names] in TcMType * Clarify the role of tcTyConScopedTyVars. See Note [Scoped tyvars in a TcTyCon] in TyCon As usual, this dragged in some more refactoring: * Renamed TcMType.zonkTyCoVarBndr to zonkAndSkolemise * I renamed checkValidTelescope to checkTyConTelescope; it's only used on TyCons, and indeed takes a TyCon as argument. * I folded the slightly-mysterious reportFloatingKvs into checkTyConTelescope. (Previously all its calls immediately followed a call to checkTyConTelescope.) It makes much more sense there. * I inlined some called-once functions to simplify checkValidTyFamEqn. It's less spaghetti-like now. * This patch also fixes Trac #16251. I'm not quite sure why #16251 went wrong in the first place, nor how this patch fixes it, but hey, it's good, and life is short. - - - - - 6c4e45b0 by David Eichmann at 2019-03-05T08:15:47Z Test Runner: don't show missing baseline warning for performance tests with expected changes on the current commit. Trac #16359 - - - - - 646b6dfb by Krzysztof Gogolewski at 2019-03-05T08:21:53Z Fix map/coerce rule for newtypes with wrappers This addresses Trac #16208 by marking newtype wrapper unfoldings as compulsory. Furthermore, we can remove the special case for newtypes in exprIsConApp_maybe (introduced in 7833cf407d1f). - - - - - 37f257af by Ben Gamari at 2019-03-06T03:22:40Z Rip out object splitting The splitter is an evil Perl script that processes assembler code. Its job can be done better by the linker's --gc-sections flag. GHC passes this flag to the linker whenever -split-sections is passed on the command line. This is based on @DemiMarie's D2768. Fixes Trac #11315 Fixes Trac #9832 Fixes Trac #8964 Fixes Trac #8685 Fixes Trac #8629 - - - - - 23342e1f by Ömer Sinan Ağacan at 2019-03-06T03:28:45Z rts/Printer: Introduce a few more printing utilities These include printLargeAndPinnedObjects, printWeakLists, and printStaticObjects. These are generally useful things to have. - - - - - c19a401d by Ömer Sinan Ağacan at 2019-03-06T03:28:45Z rts/Printer: Print forwarding pointers - - - - - db039a4a by Ryan Scott at 2019-03-06T03:40:54Z Add regression test for #15918 The test case in #15918 no longer triggers an `ASSERT` failure on GHC HEAD, likely due to commit 682783828275cca5fd8bf5be5b52054c75e0e22c (`Make a smart mkAppTyM`). This patch adds a regression test for #15918 to finally put it to rest. - - - - - 2ff77b98 by P.C. Shyamshankar at 2019-03-06T14:17:22Z Handle absolute paths to build roots in Hadrian. Fixes #16187. This patch fixes various path concatenation issues to allow functioning builds with hadrian when the build root location is specified with an absolute path. Remarks: - The path concatenation operator (-/-) now handles absolute second operands appropriately. Its behavior should match that of POSIX (</>) in this regard. - The `getDirectoryFiles*` family of functions only searches for matches under the directory tree rooted by its first argument; all of the results are also relative to this root. If the first argument is the empty string, the current working directory is used. This patch passes the appropriate directory (almost always either `top` or `root`), and subsequently attaches that directory prefix so that the paths refer to the appropriate files. - Windows `tar` does not like colons (':') in paths to archive files, it tries to resolve them as remote paths. The `--force-local` option remedies this, and is applied on windows builds. - - - - - 5aab1d9c by Ömer Sinan Ağacan at 2019-03-06T20:53:32Z rts: Unglobalize dead_weak_ptr_list and resurrected_threads In the concurrent nonmoving collector we will need the ability to call `traverseWeakPtrList` concurrently with minor generation collections. This global state stands in the way of this. However, refactoring it away is straightforward since this list only persists the length of a single GC. - - - - - a4944d8d by Ben Gamari at 2019-03-06T20:53:32Z Fix it - - - - - 78dd04f9 by Ryan Scott at 2019-03-06T21:05:45Z Fix #16385 by appending _maybe to a use of lookupGlobalOcc `instance forall c. c` claimed that `c` was out of scope because the renamer was invoking `lookupGlobalOcc` on `c` (in `RnNames.getLocalNonValBinders`) without binding `c` first. To avoid this, this patch changes GHC to invoke `lookupGlobalOcc_maybe` on `c` instead, and if that returns `Nothing`, then bail out, resulting in a better error message. - - - - - 3caeb443 by Zejun Wu at 2019-03-06T21:11:52Z Move reifyGHCi function into GhciMonad type class This was the suggested change in !176 but missed the batch merge (!263). - - - - - 4ca271d1 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. - - - - - 910185a3 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Mark heapprof001 as fragile on i386 - - - - - a65bcbe7 by Ben Gamari at 2019-03-07T02:48:10Z testsuite: Use fragile modifier for more tests - - - - - f624dc15 by Ben Gamari at 2019-03-07T02:48:10Z gitlab-ci: Don't allow i386-deb9 to fail Also account for testsuite metric drift. Metric Increase: haddock.Cabal haddock.base T14683 - - - - - 07f378ce by Simon Peyton Jones at 2019-03-07T02:54:17Z Add tests for Trac #16221 and #16342 - - - - - 25c3dd39 by Simon Peyton Jones at 2019-03-07T02:54:17Z Test Trac #16263 - - - - - 7a68254a by Phuong Trinh at 2019-03-07T19:01:42Z Fix #16392: revertCAFs in external interpreter when necessary We revert CAFs when loading/adding modules in ghci (presumably to refresh execution states and to allow for object code to be unloaded from the runtime). However, with `-fexternal-interpreter` enabled, we are only doing it in the ghci process instead of the external interpreter process where the cafs are allocated and computed. This makes sure that revertCAFs is done in the appropriate process no matter if that flag is present or not. - - - - - 068b7e98 by Ryan Scott at 2019-03-07T19:07:49Z Fix #16391 by using occCheckExpand in TcValidity The type-variables-escaping-their-scope-via-kinds check in `TcValidity` was failing to properly expand type synonyms, which led to #16391. This is easily fixed by using `occCheckExpand` before performing the validity check. Along the way, I refactored this check out into its own function, and sprinkled references to Notes to better explain all of the moving parts. Many thanks to @simonpj for the suggestions. Bumps the haddock submodule. - - - - - 1675d40a by Sebastian Graf at 2019-03-08T01:44:08Z Always do the worker/wrapper split for NOINLINEs Trac #10069 revealed that small NOINLINE functions didn't get split into worker and wrapper. This was due to `certainlyWillInline` saying that any unfoldings with a guidance of `UnfWhen` inline unconditionally. That isn't the case for NOINLINE functions, so we catch this case earlier now. Nofib results: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux -0.3% 0.0% gg +0.0% +0.1% maillist -0.2% -0.2% minimax 0.0% -0.8% -------------------------------------------------------------------------------- Min -0.3% -0.8% Max +0.0% +0.1% Geometric Mean -0.0% -0.0% Fixes #10069. ------------------------- Metric Increase: T9233 ------------------------- - - - - - 48927a9a by Alp Mestanogullari at 2019-03-08T10:50:26Z Hadrian: various improvements around the 'test' rule - introduce a -k/--keep-test-files flag to prevent cleanup - add -dstg-lint to the options that are always passed to tests - infer library ways from the compiler to be tested instead of getting them from the flavour (like make) - likewise for figuring out whether the compiler to be tested is "debugged" - specify config.exeext - correctly specify config.in_tree_compiler, instead of always passing True - fix formatting of how we pass a few test options - add (potential) extensions to check-* program names - build check-* programs with the compiler to be tested - set TEST_HC_OPTS_INTERACTIVE and PYTHON env vars when running tests - - - - - 5d744143 by Andrey Mokhov at 2019-03-08T10:56:32Z Hadrian: Drop remaining symlink traversal code from build scripts This partly resolves #16325 (https://ghc.haskell.org/trac/ghc/ticket/16325). As previously discussed in https://github.com/snowleopard/hadrian/issues/667, we do not need the symlink traversal code in build scripts. However, it appears we forgot to delete this code from our Stack-based build scripts, which led to placing all build artefacts in an unexpected location when using Hadrian in combination with symlink trees. This commit fixes this. - - - - - 82628254 by Vladislav Zavialov at 2019-03-08T11:02:37Z Testsuite: use 'fragile' instead of 'skip' for T3424, T14697 Also, replace some tabs with spaces to avoid a "mixed indent" warning that vim gives me. - - - - - 5be7ad78 by Simon Peyton Jones at 2019-03-08T11:08:41Z Use captureTopConstraints in TcRnDriver calls Trac #16376 showed the danger of failing to report an error that exists only in the unsolved constraints, if an exception is raised (via failM). Well, the commit 5c1f268e (Fail fast in solveLocalEqualities) did just that -- i.e. it found errors in the constraints, and called failM to avoid a misleading cascade. So we need to be sure to call captureTopConstraints to report those insolubles. This was wrong in TcRnDriver.tcRnExpr and in TcRnDriver.tcRnType. As a result the error messages from test T13466 improved slightly, a happy outcome. - - - - - 224a6b86 by Sylvain Henry at 2019-03-08T19:05:10Z TH: support raw bytes literals (#14741) GHC represents String literals as ByteString internally for efficiency reasons. However, until now it wasn't possible to efficiently create large string literals with TH (e.g. to embed a file in a binary, cf #14741): TH code had to unpack the bytes into a [Word8] that GHC then had to re-pack into a ByteString. This patch adds the possibility to efficiently create a "string" literal from raw bytes. We get the following compile times for different sizes of TH created literals: || Size || Before || After || Gain || || 30K || 2.307s || 2.299 || 0% || || 3M || 3.073s || 2.400s || 21% || || 30M || 8.517s || 3.390s || 60% || Ticket #14741 can be fixed if the original code uses this new TH feature. - - - - - 2762f94d by Roland Senn at 2019-03-08T19:11:19Z Fix #13839: GHCi warnings do not respect the default module header - - - - - 1f5cc9dc by Simon Peyton Jones at 2019-03-09T07:07:53Z Stop inferring over-polymorphic kinds Before this patch GHC was trying to be too clever (Trac #16344); it succeeded in kind-checking this polymorphic-recursive declaration data T ka (a::ka) b = MkT (T Type Int Bool) (T (Type -> Type) Maybe Bool) As Note [No polymorphic recursion] discusses, the "solution" was horribly fragile. So this patch deletes the key lines in TcHsType, and a wodge of supporting stuff in the renamer. There were two regressions, both the same: a closed type family decl like this (T12785b) does not have a CUSK: type family Payload (n :: Peano) (s :: HTree n x) where Payload Z (Point a) = a Payload (S n) (a `Branch` stru) = a To kind-check the equations we need a dependent kind for Payload, and we don't get that any more. Solution: make it a CUSK by giving the result kind -- probably a good thing anyway. The other case (T12442) was very similar: a close type family declaration without a CUSK. - - - - - cfbedf17 by Niklas Hambüchen at 2019-03-09T07:14:13Z compiler: Write .o files atomically. See #14533 This issue was reproduced with, and the fix confirmed with, the `hatrace` tool for syscall-based fault injection: https://github.com/nh2/hatrace The concrete test case for GHC is at https://github.com/nh2/hatrace/blob/e23d35a2d2c79e8bf49e9e2266b3ff7094267f29/test/HatraceSpec.hs#L185 A previous, nondeterministic reproducer for the issue was provided by Alexey Kuleshevich in https://github.com/lehins/exec-kill-loop Signed-off-by: Niklas Hambüchen <niklas at fpcomplete.com> Reviewed-by: Alexey Kuleshevich <alexey at fpcomplete.com> - - - - - 08ad38a9 by Niklas Hambüchen at 2019-03-09T07:14:13Z compiler: Refactor: extract `withAtomicRename` - - - - - e76ee675 by Ben Gamari at 2019-03-09T12:30:17Z rts: Factor out large bitmap walking This will be needed by the mark phase of the non-moving collector so let's factor it out. - - - - - 6e3e537e by Edward Z. Yang at 2019-03-09T12:36:26Z Make bkpcabal01 test compatible with new ordering requirements. Previously, our test did something like this: 1. Typecheck p 2. Typecheck q (which made use of an instantiated p) 3. Build instantiated p 4. Build instantiated q Cabal previously permitted this, under the reasoning that during typechecking there's no harm in using the instantiated p even if we haven't build it yet; we'll just instantiate it on the fly with p. However, this is not true! If q makes use of a Template Haskell splice from p, we absolutely must have built the instantiated p before we typecheck q, since this typechecking will need to run some splices. Cabal now complains that you haven't done it correctly, which we indeed have not! Reordering so that we do this: 1. Typecheck p 3. Build instantiated p 2. Typecheck q (which made use of an instantiated p) 4. Build instantiated q Fixes the problem. If Cabal had managed the ordering itself, it would have gotten it right. Signed-off-by: Edward Z. Yang <ezyang at fb.com> - - - - - 6b2f0991 by Sylvain Henry at 2019-03-09T12:42:34Z NCG: correctly escape path strings on Windows (#16389) GHC native code generator generates .incbin and .file directives. We need to escape those strings correctly on Windows (see #16389). - - - - - b760269c by Ben Gamari at 2019-03-09T12:48:38Z Rip out perl dependency The object splitter was the last major user of perl. There remain a few uses in nofib but we can just rely on the system's perl for this since it's not critical to the build. - - - - - 0cd98957 by Ben Gamari at 2019-03-09T12:48:38Z Drop utils/count_lines This doesn't appear to be used anywhere in the build system and it relies on perl. Drop it. - - - - - bcb6769c by Alec Theriault at 2019-03-11T22:11:59Z Ignore more version numbers in the testsuite Prevents some tests from failing just due to mismatched version numbers. These version numbers shouldn't cause tests to fail, especially since we *expect* them to be regularly incremented. The motivation for this particular set of changes came from the changes that came along with the `base` version bump in 8f19ecc95fbaf2cc977531d721085d8441dc09b7. - - - - - 60b03ade by Krzysztof Gogolewski at 2019-03-11T22:18:06Z Change the warning in substTy back to an assertion We'd like to enforce the substitution invariant (Trac #11371). In a492af06d326453 the assertion was downgraded to a warning; I'm restoring the assertion and making the calls that don't maintain the invariant as unchecked. - - - - - 2f453414 by Krzysztof Gogolewski at 2019-03-11T22:18:06Z Add a test for Trac #13951 It no longer gives a warning. - - - - - b2322310 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Allow passing CABFLAGS into build.cabal.sh Setting `CABFLAGS=args` will pass the additional arguments to cabal when it is invoked. - - - - - 61264556 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make libsuf and distDir stage aware The version suffix needs to be the version of the stage 0 compiler when building shared libraries with the stage 0 compiler. - - - - - 705fa21d by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Make makeRelativeNoSysLink total makeRelativeNoSysLink would previously crash for no reason if the first argument as `./` due to the call to `head`. This refactoring keeps the behaviour the same but doesn't crash in this corner case. - - - - - 4cf2160a by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Fix rpath so shared objects work after being copied After being copied all the shared objects end up in the same directory. Therefore the correct rpath is `$ORIGIN` rather than the computed path which is relative to the directory where it is built. - - - - - 2d7dd028 by Matthew Pickering at 2019-03-12T13:04:52Z Hadrian: Add ./hadrian/ghci.sh script for fast development feedback Running the `./hadrian/ghci` target will load the main compiler into a ghci session. This is intended for fast development feedback, modules are only typechecked so it isn't possible to run any functions in the repl. You can also use this target with `ghcid`. The first time this command is run hadrian will need to compile a few dependencies which will take 1-2 minutes. Loading GHC into GHCi itself takes about 30 seconds. Internally this works by calling a new hadrian target called `tool-args`. This target prints out the package and include flags which are necessary to load files into ghci. The same target is intended to be used by other tooling which uses the GHC API in order to set up the correct GHC API session. For example, using this target it is also possible to use HIE when developing on GHC. - - - - - bb684e65 by Matthew Pickering at 2019-03-12T13:04:52Z Remove training whitespace - - - - - 72c455a4 by Matthew Pickering at 2019-03-12T13:04:52Z CI: Add ghc-in-ghci build job This is a separate build job to the other hadrian jobs as it only takes about 2-3 minutes to run from cold. The CI tests that the `./hadrian/ghci` script loads `ghc/Main.hs` successfully. - - - - - 5165378d by Matthew Pickering at 2019-03-12T13:04:52Z Remove trailing whitespace - - - - - 50249a9f by Simon Peyton Jones at 2019-03-12T13:13:28Z Use transSuperClasses in TcErrors Code in TcErrors was recursively using immSuperClasses, which loops in the presence of UndecidableSuperClasses. Better to use transSuperClasses instead, which has a loop-breaker mechanism built in. Fixes issue #16414. - - - - - 62db9295 by Ömer Sinan Ağacan at 2019-03-12T13:19:29Z Remove duplicate functions in StgCmmUtils, use functions from CgUtils Also remove unused arg from get_Regtable_addr_from_offset - - - - - 4db9bdd9 by Ryan Scott at 2019-03-12T13:25:39Z Add regression test for #16347 Commit 1f5cc9dc8aeeafa439d6d12c3c4565ada524b926 ended up fixing #16347. Let's add a regression test to ensure that it stays fixed. - - - - - 02ddf947 by Matthew Pickering at 2019-03-12T13:42:53Z CI: Update ci-images commit - - - - - a0cab873 by Matthew Pickering at 2019-03-12T13:44:45Z Revert: Update ci-images commit - - - - - 23fc6156 by Ben Gamari at 2019-03-13T19:03:53Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. - - - - - cb17c2da by Alp Mestanogullari at 2019-03-13T19:10:01Z Hadrian: build (and retrieve) binary distributions in CI With all the recent fixes to the binary-dist rule in Hadrian, we can now run that rule in CI and keep the bindists around in gitlab as artifacts, just like we do for the make CI jobs. To get 'autoreconf' to work in the Windows CI, we have to run it through the shell interpreter, so this commit does that along the way. - - - - - 36546a43 by Ryan Scott at 2019-03-13T19:16:08Z Fix #16411 by making dataConCannotMatch aware of (~~) The `dataConCannotMatch` function (which powers the `-Wpartial-fields` warning, among other things) had special reasoning for explicit equality constraints of the form `a ~ b`, but it did not extend that reasoning to `a ~~ b` constraints, leading to #16411. Easily fixed. - - - - - 10a97120 by Ben Gamari at 2019-03-14T16:20:50Z testsuite: Add testcase for #16394 - - - - - 8162eab2 by Ryan Scott at 2019-03-15T13:59:30Z Remove the GHCi debugger's panicking isUnliftedType check The GHCi debugger has never been that robust in the face of higher-rank types, or even types that are _interally_ higher-rank, such as the types of many class methods (e.g., `fmap`). In GHC 8.2, however, things became even worse, as the debugger would start to _panic_ when a user tries passing the name of a higher-rank thing to `:print`. This all ties back to a strange `isUnliftedType` check in `Debugger` that was mysteriously added 11 years ago (in commit 4d71f5ee6dbbfedb4a55767e4375f4c0aadf70bb) with no explanation whatsoever. After some experimentation, no one is quite sure what this `isUnliftedType` check is actually accomplishing. The test suite still passes if it's removed, and I am unable to observe any differences in debugger before even with data types that _do_ have fields of unlifted types (e.g., `data T = MkT Int#`). Given that this is actively causing problems (see #14828), the prudent thing to do seems to be just removing this `isUnliftedType` check, and waiting to see if anyone shouts about it. This patch accomplishes just that. Note that this patch fix the underlying issues behind #14828, as the debugger will still print unhelpful info if you try this: ``` λ> f :: (forall a. a -> a) -> b -> b; f g x = g x λ> :print f f = (_t1::t1) ``` But fixing this will require much more work, so let's start with the simple stuff for now. - - - - - d10e2368 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded imports. - - - - - 4df75772 by David Eichmann at 2019-03-15T14:05:38Z Hadrian: remove unneeded rpaths. Issue #12770 - - - - - afc80730 by David Eichmann at 2019-03-15T14:11:47Z Git ignore .hadrian_ghci (generated by the ./hadrian/ghci.sh) [skip ci] - - - - - 610ec224 by Ryan Scott at 2019-03-15T14:17:54Z Update Trac ticket URLs to point to GitLab This moves all URL references to Trac tickets to their corresponding GitLab counterparts. - - - - - 97032ed9 by Simon Peyton Jones at 2019-03-15T14:24:01Z Report better suggestion for GADT data constructor This addresses issue #16427. An easy fix. - - - - - 83e09d3c by Peter Trommler at 2019-03-15T14:30:08Z PPC NCG: Use liveness information in CmmCall We make liveness information for global registers available on `JMP` and `BCTR`, which were the last instructions missing. With complete liveness information we do not need to reserve global registers in `freeReg` anymore. Moreover we assign R9 and R10 to callee saves registers. Cleanup by removing `Reg_Su`, which was unused, from `freeReg` and removing unused register definitions. The calculation of the number of floating point registers is too conservative. Just follow X86 and specify the constants directly. Overall on PowerPC this results in 0.3 % smaller code size in nofib while runtime is slightly better in some tests. - - - - - 57201beb by Simon Peyton Jones at 2019-03-15T14:36:14Z Add flavours link - - - - - 4927117c by Simon Peyton Jones at 2019-03-16T12:08:25Z Improve error recovery in the typechecker Issue #16418 showed that we were carrying on too eagerly after a bogus type signature was identified (a bad telescope in fact), leading to a subsequent crash. This led me in to a maze of twisty little passages in the typechecker's error recovery, and I ended up doing some refactoring in TcRnMonad. Some specfifics * TcRnMonad.try_m is now called attemptM. * I switched the order of the result pair in tryTc, to make it consistent with other similar functions. * The actual exception used in the Tc monad is irrelevant so, to avoid polluting type signatures, I made tcTryM, a simple wrapper around tryM, and used it. The more important changes are in * TcSimplify.captureTopConstraints, where we should have been calling simplifyTop rather than reportUnsolved, so that levity defaulting takes place properly. * TcUnify.emitResidualTvConstraint, where we need to set the correct status for a new implication constraint. (Previously we ended up with an Insoluble constraint wrapped in an Unsolved implication, which meant that insolubleWC gave the wrong answer. - - - - - 600a1ac3 by Simon Peyton Jones at 2019-03-16T12:08:25Z Add location to the extra-constraints wildcard The extra-constraints wildcard had lost its location (issue #16431). Happily this is easy to fix. Lots of error improvements. - - - - - 1c1b63d6 by Ben Gamari at 2019-03-16T23:13:36Z compiler: Disable atomic renaming on Windows As discussed in #16450, this feature regresses CI on Windows, causing non-deterministic failures due to missing files. - - - - - 6764da43 by Ben Gamari at 2019-03-16T23:16:56Z gitlab-ci: Explicitly set bindist tarball name - - - - - ad79ccd9 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate documentation tarball - - - - - 3f2291e4 by Ben Gamari at 2019-03-16T23:17:46Z gitlab-ci: Generate source tarballs - - - - - cb61371e by Ben Gamari at 2019-03-17T09:05:10Z ghc-heap: Introduce closureSize This function allows the user to compute the (non-transitive) size of a heap object in words. The "closure" in the name is admittedly confusing but we are stuck with this nomenclature at this point. - - - - - c01d5af3 by Michael Sloan at 2019-03-18T02:23:19Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. - - - - - 6113d0d4 by Radosław Rowicki at 2019-03-18T02:29:25Z Update bug tracker link to point to gitlab instead of deprecated trac - - - - - b8326897 by Ben Gamari at 2019-03-18T03:16:12Z gitlab-ci: Always build fedora27 This ends up being much easier to use than Debian 9 under NixOS. - - - - - acf2129d by Ben Gamari at 2019-03-18T03:17:36Z gitlab-ci: Implement head.hackage jobs - - - - - 71648c35 by Ben Gamari at 2019-03-20T03:04:18Z gitlab-ci: Implement support for i386/Windows bindists - - - - - d94ca74f by Tamar Christina at 2019-03-20T03:10:23Z err: clean up error handler - - - - - 398f2cbc by Ben Gamari at 2019-03-20T03:16:32Z Bump Cabal submodule to 3.0 Metric Increase: haddock.Cabal - - - - - 89a201e8 by Takenobu Tani at 2019-03-20T03:22:36Z users-guide: Update Wiki URLs to point to GitLab The user's guide uses the `ghc-wiki` macro, and substitution rules are complicated. So I manually edited `.rst` files without sed. I changed `Commentary/Latedmd` only to a different page. It is more appropriate as an example. [ci skip] - - - - - 98ff1a56 by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Replace nOfThem by replicate - - - - - 6a47414f by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Fix typos - - - - - 1e26e60d by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Simplify monadic code - - - - - c045bd7c by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Remove deprecated reinitializeGlobals - - - - - 6d19ad72 by Ben Gamari at 2019-03-20T03:34:49Z gitlab-ci: Bump docker images To install lndir and un-break the source distribution job. - - - - - c7a84a60 by Matthew Pickering at 2019-03-20T03:34:50Z Update .gitlab-ci.yml - - - - - db136237 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16219 and cabal09 as broken on Windows See #16386. - - - - - 7cd8e330 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Fix expected output on Windows for various ghci tests Broke as -Wimplicit-kind-vars no longer exists. Specifically ghci024, ghci057 and T9293. - - - - - 23b639fd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T5836 as broken on Windows See #16387. - - - - - a1bda08d by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T15904 as broken on Windows It seems to look for some sort of manifest file. See #16388. - - - - - b7f5d552 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16190 as broken on Windows There seems to be some filepath funniness due to TH embedding going on here. See #16389. - - - - - a0c31f78 by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Add multi_cpu_race modifier on Windows A few tests previously failed with various failure modes. For instance, `plugin-recomp-change` fails with: ``` Wrong exit code for plugin-recomp-change()(expected 0 , actual 2 ) Stderr ( plugin-recomp-change ): Simple Plugin Passes Queried Got options: Simple Plugin Pass Run C://GitLabRunner//builds//8fc0e283//0//ghc//ghc//inplace//mingw//bin/ld.exe: cannot find -lHSplugin-recompilation-0.1-CPeObcGoBuvHdwBnpK9jQq collect2.exe: error: ld returned 1 exit status `gcc.exe' failed in phase `Linker'. (Exit code: 1) make[2]: *** [Makefile:112: plugin-recomp-change] Error 1 *** unexpected failure for plugin-recomp-change(normal) ``` It's unclear whether the ghc-pkg concurrency issue mentioned in all.T is the culprit but the set of tests that fail overlaps strongly with the set of tests that lack the `multi_cpu_race` modifier. Let's see if adding it fixes them. - - - - - 88a6e9a4 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T10672 as broken This test, which is only run on Windows, seems to be reliably timing out. See #16390. - - - - - f4d3aaaf by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Increase compile timeout on Windows I think the linker is routinely eating through the timeout, leading to many spurious failures. - - - - - ae382245 by Ben Gamari at 2019-03-20T22:41:32Z rts/RtsSymbols: Drop __mingw_vsnwprintf As described in #16387, this is already defined by mingw and consequently defining it in the RTS as well leads to multiple definition errors from the RTS linker at runtime. - - - - - f79f93e4 by Ben Gamari at 2019-03-20T22:41:32Z Don't mark cabal09 as broken It doesn't fail reliably. - - - - - d98cb763 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Don't mark T5836 as broken I believe removing __mingw_vsnwprintf from RtsSymbols fixed #16387. - - - - - 8c1a2743 by Ben Gamari at 2019-03-20T22:41:32Z Try again - - - - - 3394a7cd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Display observed exit code on failure due to bad exit code - - - - - 36818759 by Artem Pyanykh at 2019-03-20T23:52:39Z Adjust section placement and relocation logic for Mach-O 1. Place each section on a separate page to ensure required alignment (wastes lots ot space, needs to be improved). 2. Unwire relocation logic from macho sections (the most fiddly part is adjusting internal relocations). Other todos: 0. Add a test for section alignment. 1. Investigate 32bit relocations! 2. Fix memory leak in ZEROPAGE section allocation. 3. Fix creating redundant jump islands for GOT. 4. Investigate more compact section placement. - - - - - 78c61acf by Artem Pyanykh at 2019-03-20T23:52:39Z Use segments for section layout - - - - - 7bbfb789 by Artem Pyanykh at 2019-03-20T23:52:39Z Address some todos and fixmes - - - - - 3cdcc0b5 by Artem Pyanykh at 2019-03-20T23:52:39Z Add a linker test re: section alignment - - - - - cb745c84 by Artem Pyanykh at 2019-03-20T23:52:39Z Add missing levels to SegmentProt enum - - - - - d950f11e by Artem Pyanykh at 2019-03-20T23:52:39Z Directly test section alignment, fix internal reloc probing length - - - - - 3fb10fcf by Artem Pyanykh at 2019-03-20T23:52:39Z Gracefully handle error condition in Mach-O relocateSection - - - - - dc713c71 by Ben Gamari at 2019-03-20T23:58:49Z ci: Move validate-x86_64-linux-deb9 to full-build stage The `build` stage is meant to be a minimal smoke test to weed out broken commits. The `validate-x86_64-linux-deb9` build will generally catch a subset of issues caught by `validate-x86_64-linux-deb9-debug` so only the latter should be in `build`. - - - - - 505c5ab2 by Ben Gamari at 2019-03-20T23:58:49Z ci: Add some descriptions of the stages - - - - - 646e3dc2 by Sebastian Graf at 2019-03-21T00:04:49Z Add a bench flavour to Hadrian - - - - - 8d18a873 by Ryan Scott at 2019-03-21T00:10:57Z Reject nested predicates in impredicativity checking When GHC attempts to unify a metavariable with a type containing foralls, it will be rejected as an occurrence of impredicativity. GHC was /not/ extending the same treatment to predicate types, such as in the following (erroneous) example from #11514: ```haskell foo :: forall a. (Show a => a -> a) -> () foo = undefined ``` This will attempt to instantiate `undefined` at `(Show a => a -> a) -> ()`, which is impredicative. This patch catches impredicativity arising from predicates in this fashion. Since GHC is pickier about impredicative instantiations, some test cases needed to be updated to be updated so as not to fall afoul of the new validity check. (There were a surprising number of impredicative uses of `undefined`!) Moreover, the `T14828` test case now has slightly less informative types shown with `:print`. This is due to a a much deeper issue with the GHCi debugger (see #14828). Fixes #11514. - - - - - 7b213b8d by Ömer Sinan Ağacan at 2019-03-21T00:17:05Z Print test suite results ("unexpected failures" etc.) in sorted order Fixes #16425 - - - - - f199a843 by Simon Jakobi at 2019-03-21T00:23:15Z Check.hs: Fix a few typos - - - - - 07d44ed1 by Ben Gamari at 2019-03-21T00:29:20Z base: Depend upon shlwapi on Windows As noted in #16466, `System.Environment.getExecutablePath` depends upon `PathFileExistsW` which is defined by `shlwapi`. Fixes #16466. - - - - - 1382d09e by Ryan Scott at 2019-03-21T00:35:28Z Remove unused XArrApp and XArrForm extension points !301 removed the `HsArrApp` and `HsArrForm` constructors, which renders the corresponding extension points `XArrApp` and `XArrForm` useless. This patch finally rips them out. - - - - - 3423664b by Peter Trommler at 2019-03-21T00:41:35Z Fix specification of load_load_barrier [skip-ci] - - - - - 84c77a67 by Alexandre Esteves at 2019-03-21T21:43:03Z Fix typo [skip ci] - - - - - 7092b2de by Matthew Pickering at 2019-03-22T03:38:58Z Only run check-makefiles.py linter in testsuite dir - - - - - 322239de by Matthew Pickering at 2019-03-22T03:38:58Z Run linters on merge requests It seems that it has failed to execute at all since it was implemented. We now run the linters on merge requests. - - - - - 8f8d532c by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Do full `perf` build when building Windows releases - - - - - 2ef72d3f by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Pass --target explicitly to configure on Windows Otherwise configure fails in the 32-bit case with ``` This GHC (c:/GitLabRunner/builds/8fc0e283/0/ghc/ghc/toolchain/bin/ghc) does not generate code for the build platform GHC target platform : x86_64-unknown-mingw32 Desired build platform : i386-unknown-mingw32 ``` - - - - - 8b14f536 by Ben Gamari at 2019-03-22T03:51:08Z Bump cabal submodule Due to https://github.com/haskell/cabal/issues/5953. - - - - - dbe4557f by Matthew Pickering at 2019-03-22T14:02:32Z CI: Allow failure in packaging step This depends on the windows build which is still allowed to fail. If that job fails then the packaging job will also fail. - - - - - 366f1c68 by Ben Gamari at 2019-03-22T14:08:38Z gitlab: Deploy documentation snapshot via GitLab Pages - - - - - d608d543 by Tamar Christina at 2019-03-22T14:14:45Z Force LF line ending for md5sum [skip-ci] - - - - - cd07086a by Ben Gamari at 2019-03-22T14:34:51Z gitlab-ci: Fix linters - - - - - ab51bee4 by Herbert Valerio Riedel at 2019-03-22T14:34:51Z base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail Coauthored-by: Ben Gamari <ben at well-typed.com> - - - - - 266b49ca by Ben Gamari at 2019-03-22T22:33:20Z gitlab-ci: Clean up linter I'm not sure why these steps were done but they seem counterproductive and unnecessary. - - - - - 44b08ede by Ben Gamari at 2019-03-22T22:38:11Z gitlab-ci: Fix YAML syntax - - - - - 971f4530 by Ben Gamari at 2019-03-22T22:49:34Z gitlab-ci: Compute merge base against remote tracking branch Previously we would use the local branch with the name `$CI_MERGE_REQUEST_TARGET_BRANCH_NAME` to compute the merge base when linting. However, this branch isn't necessarily up-to-date. We should rather use `origin/$CI_MERGE_REQUEST_TARGET_BRANCH_NAME`. - - - - - 8d01b572 by Ben Gamari at 2019-03-23T16:37:56Z gitlab-ci: Explicitly fetch target branch `git fetch`, which we used previously, doesn't update the remote tracking branches. - - - - - cd85f8a7 by Ben Gamari at 2019-03-24T12:46:13Z gitlab-ci: Allow linters to fail for now They are broken and I don't have time to fix them at the moment. - - - - - d763b2e7 by Haskell-mouse at 2019-03-25T18:02:22Z User's Guide: extensions compatibility Adds the mention that extensions "AllowAmbiguousTypes" and "RankNTypes" are not always compatible with each other. Specifies the conditions and causes of failing in resolving of ambiguity. - - - - - 200d65ef by Matthew Pickering at 2019-03-25T18:02:25Z Check hadrian/ghci.sh script output to determine pass/fail ghci always exits with exit code 0 so you have to check the output to see if the modules loaded succesfully. - - - - - 8e07368f by Matthew Pickering at 2019-03-25T18:02:27Z Refactor ./hadrian/ghci.sh for better error messages By separating these two lines, if the first command fails then `ghci` is not loaded. Before it would still load ghci but display lots of errors about not being able to find modules. - - - - - 3769e3a8 by Takenobu Tani at 2019-03-25T18:02:29Z Update Wiki URLs to point to GitLab This moves all URL references to Trac Wiki to their corresponding GitLab counterparts. This substitution is classified as follows: 1. Automated substitution using sed with Ben's mapping rule [1] Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy... New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy... 2. Manual substitution for URLs containing `#` index Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy...#Zzz New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy...#zzz 3. Manual substitution for strings starting with `Commentary` Old: Commentary/XxxYyy... New: commentary/xxx-yyy... See also !539 [1]: https://gitlab.haskell.org/bgamari/gitlab-migration/blob/master/wiki-mapping.json - - - - - b9da2868 by Ryan Scott at 2019-03-25T18:02:33Z Correct duplicate 4.12.0.0 entry in base's changelog See #16490. [ci skip] - - - - - ab41c1b4 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: Bump Shake to 0.17.6 The new release of Shake comes with these relevant features: * use symlinks for --shared * add --compact for a Bazel/Buck style output - - - - - 646f2e79 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: trace the execution of expensive Cabal calls We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information. - - - - - fb12f53c by Alp Mestanogullari at 2019-03-27T11:20:05Z Hadrian: introduce an easy way for users to build with -split-sections Any user can now trivially build any number of Haskell packages with `-split-sections` by using `splitSections`/`splitSectionsIf` on any existing or new flavour: -- build all packages but the ghc library with -split-sections splitSections :: Flavour -> Flavour -- build all packages that satisfy the given predicate -- with --split-sections splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour See the new section in `doc/user-settings.md`. - - - - - 3dec527a by David Eichmann at 2019-03-27T11:20:09Z Hadrian: don't use -zorigin on darwin. - - - - - 5730f863 by Ömer Sinan Ağacan at 2019-03-27T11:20:10Z Minor refactoring in copy array primops: - `emitCopySmallArray` now checks size before generating code and doesn't generate any code when size is 0. `emitCopyArray` already does this so this makes small/large array cases the same in argument checking. - In both `emitCopySmallArray` and `emitCopyArray` read the `dflags` after checking the argument. - - - - - 4acdb769 by Chaitanya Koparkar at 2019-03-27T11:20:11Z Fix a few broken Trac links [skip ci] This patch only attempts to fix links that don't automatically re-direct to the correct URL. - - - - - 97ad5cfb by Artem Pelenitsyn at 2019-03-29T18:18:12Z Add some tips to the Troubleshooting section of README - - - - - 8a20bfc2 by Michael Peyton Jones at 2019-03-29T18:18:14Z Visibility: handle multiple units with the same name Fixes #16228. The included test case is adapted from the reproduction in the issue, and fails without this patch. ------ We compute an initial visilibity mapping for units based on what is present in the package databases. To seed this, we compute a set of all the package configs to add visibilities for. However, this set was keyed off the unit's *package name*. This is correct, since we compare packages across databases by version. However, we would only ever consider a single, most-preferable unit from the database in which it was found. The effect of this was that only one of the libraries in a Cabal package would be added to this initial set. This would cause attempts to use modules from the omitted libraries to fail, claiming that the package was hidden (even though `ghc-pkg` would correctly show it as visible). A solution is to do the selection of the most preferable packages separately, and then be sure to consider exposing all units in the same package in the same package db. We can do this by picking a most-preferable unit for each package name, and then considering exposing all units that are equi-preferable with that unit. ------ Why wasn't this bug apparent to all people trying to use sub-libraries in Cabal? The answer is that Cabal explicitly passes `-package` and `-package-id` flags for all the packages it wants to use, rather than relying on the state of the package database. So this bug only really affects people who are trying to use package databases produced by Cabal outside of Cabal itself. One particular example of this is the way that the Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these are equipped with a package database containing all the needed package dependencies, and the user is not expected to pass `-package` flags explicitly. - - - - - 754b5455 by Artem Pelenitsyn at 2019-03-29T18:18:20Z docs: make nfib compute the Fibonacci sequence [skipci] - - - - - 1a567133 by Ben Gamari at 2019-03-29T18:18:20Z ci: Check that changelogs don't contain "TBA" This ensures that the release dates in the library changelogs are properly set. - - - - - 6e15ca54 by Ben Gamari at 2019-03-29T18:18:22Z Bump transformers to 0.5.6.2 See #16199. - - - - - 6f7115df by Ben Gamari at 2019-03-30T11:42:38Z ci: Ensure index.html is preserved in documentation tarball - - - - - 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - fdbf429d by Yuras Shumovich at 2019-06-07T22:46:29Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 30 changed files: - − .arc-linters/arcanist-external-json-linter - − .arc-linters/check-binaries.py - − .arc-linters/check-cpp.py - − .arc-linters/check-makefiles.py - − .arcconfig - − .arclint - .circleci/config.yml - − .circleci/images/aarch64-linux-deb9/Dockerfile - − .circleci/images/i386-linux-deb8/Dockerfile - − .circleci/images/i386-linux-deb9/Dockerfile - − .circleci/images/linters/Dockerfile - − .circleci/images/update-image - − .circleci/images/x86_64-freebsd/Dockerfile - − .circleci/images/x86_64-freebsd/build-toolchain.sh - − .circleci/images/x86_64-linux-centos7/Dockerfile - − .circleci/images/x86_64-linux-deb8/Dockerfile - − .circleci/images/x86_64-linux-deb9/Dockerfile - − .circleci/images/x86_64-linux-fedora27/Dockerfile - .circleci/prepare-system.sh - .ghcid - + .gitattributes - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - .gitlab/linters/check-makefiles.py - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - + .gitlab/merge_request_templates/merge-request.md - + .gitlab/push-test-metrics.sh The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/076584c11bf536dcc15f56b01dafe2957bcb02d4...fdbf429d575a581e38fdf9e72a4f0e0928f36f57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/076584c11bf536dcc15f56b01dafe2957bcb02d4...fdbf429d575a581e38fdf9e72a4f0e0928f36f57 You're receiving 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 Jun 8 02:15:41 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 22:15:41 -0400 Subject: [Git][ghc/ghc][wip/init-event-types] 124 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5cfb1a4da89f1_6f7e5887441113363@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/init-event-types at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - c6debdbc by Ben Gamari at 2019-06-07T23:22:34Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5f96b939f1c2b5c3b1b569b004062172d62b03a4...c6debdbc5bcc56dba8d29e7d3b3a10c643ac8d80 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5f96b939f1c2b5c3b1b569b004062172d62b03a4...c6debdbc5bcc56dba8d29e7d3b3a10c643ac8d80 You're receiving 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 Jun 8 03:16:57 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 23:16:57 -0400 Subject: [Git][ghc/ghc][wip/closure-size] 385 commits: Extract out use of UnboxedTuples from GHCi.Leak Message-ID: <5cfb28a933e2_6f73fe60402301c111548f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: c01d5af3 by Michael Sloan at 2019-03-18T02:23:19Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. - - - - - 6113d0d4 by Radosław Rowicki at 2019-03-18T02:29:25Z Update bug tracker link to point to gitlab instead of deprecated trac - - - - - b8326897 by Ben Gamari at 2019-03-18T03:16:12Z gitlab-ci: Always build fedora27 This ends up being much easier to use than Debian 9 under NixOS. - - - - - acf2129d by Ben Gamari at 2019-03-18T03:17:36Z gitlab-ci: Implement head.hackage jobs - - - - - 71648c35 by Ben Gamari at 2019-03-20T03:04:18Z gitlab-ci: Implement support for i386/Windows bindists - - - - - d94ca74f by Tamar Christina at 2019-03-20T03:10:23Z err: clean up error handler - - - - - 398f2cbc by Ben Gamari at 2019-03-20T03:16:32Z Bump Cabal submodule to 3.0 Metric Increase: haddock.Cabal - - - - - 89a201e8 by Takenobu Tani at 2019-03-20T03:22:36Z users-guide: Update Wiki URLs to point to GitLab The user's guide uses the `ghc-wiki` macro, and substitution rules are complicated. So I manually edited `.rst` files without sed. I changed `Commentary/Latedmd` only to a different page. It is more appropriate as an example. [ci skip] - - - - - 98ff1a56 by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Replace nOfThem by replicate - - - - - 6a47414f by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Fix typos - - - - - 1e26e60d by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Simplify monadic code - - - - - c045bd7c by Krzysztof Gogolewski at 2019-03-20T03:28:42Z Remove deprecated reinitializeGlobals - - - - - 6d19ad72 by Ben Gamari at 2019-03-20T03:34:49Z gitlab-ci: Bump docker images To install lndir and un-break the source distribution job. - - - - - c7a84a60 by Matthew Pickering at 2019-03-20T03:34:50Z Update .gitlab-ci.yml - - - - - db136237 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16219 and cabal09 as broken on Windows See #16386. - - - - - 7cd8e330 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Fix expected output on Windows for various ghci tests Broke as -Wimplicit-kind-vars no longer exists. Specifically ghci024, ghci057 and T9293. - - - - - 23b639fd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T5836 as broken on Windows See #16387. - - - - - a1bda08d by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T15904 as broken on Windows It seems to look for some sort of manifest file. See #16388. - - - - - b7f5d552 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T16190 as broken on Windows There seems to be some filepath funniness due to TH embedding going on here. See #16389. - - - - - a0c31f78 by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Add multi_cpu_race modifier on Windows A few tests previously failed with various failure modes. For instance, `plugin-recomp-change` fails with: ``` Wrong exit code for plugin-recomp-change()(expected 0 , actual 2 ) Stderr ( plugin-recomp-change ): Simple Plugin Passes Queried Got options: Simple Plugin Pass Run C://GitLabRunner//builds//8fc0e283//0//ghc//ghc//inplace//mingw//bin/ld.exe: cannot find -lHSplugin-recompilation-0.1-CPeObcGoBuvHdwBnpK9jQq collect2.exe: error: ld returned 1 exit status `gcc.exe' failed in phase `Linker'. (Exit code: 1) make[2]: *** [Makefile:112: plugin-recomp-change] Error 1 *** unexpected failure for plugin-recomp-change(normal) ``` It's unclear whether the ghc-pkg concurrency issue mentioned in all.T is the culprit but the set of tests that fail overlaps strongly with the set of tests that lack the `multi_cpu_race` modifier. Let's see if adding it fixes them. - - - - - 88a6e9a4 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Mark T10672 as broken This test, which is only run on Windows, seems to be reliably timing out. See #16390. - - - - - f4d3aaaf by Ben Gamari at 2019-03-20T22:41:32Z testsuite/plugins: Increase compile timeout on Windows I think the linker is routinely eating through the timeout, leading to many spurious failures. - - - - - ae382245 by Ben Gamari at 2019-03-20T22:41:32Z rts/RtsSymbols: Drop __mingw_vsnwprintf As described in #16387, this is already defined by mingw and consequently defining it in the RTS as well leads to multiple definition errors from the RTS linker at runtime. - - - - - f79f93e4 by Ben Gamari at 2019-03-20T22:41:32Z Don't mark cabal09 as broken It doesn't fail reliably. - - - - - d98cb763 by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Don't mark T5836 as broken I believe removing __mingw_vsnwprintf from RtsSymbols fixed #16387. - - - - - 8c1a2743 by Ben Gamari at 2019-03-20T22:41:32Z Try again - - - - - 3394a7cd by Ben Gamari at 2019-03-20T22:41:32Z testsuite: Display observed exit code on failure due to bad exit code - - - - - 36818759 by Artem Pyanykh at 2019-03-20T23:52:39Z Adjust section placement and relocation logic for Mach-O 1. Place each section on a separate page to ensure required alignment (wastes lots ot space, needs to be improved). 2. Unwire relocation logic from macho sections (the most fiddly part is adjusting internal relocations). Other todos: 0. Add a test for section alignment. 1. Investigate 32bit relocations! 2. Fix memory leak in ZEROPAGE section allocation. 3. Fix creating redundant jump islands for GOT. 4. Investigate more compact section placement. - - - - - 78c61acf by Artem Pyanykh at 2019-03-20T23:52:39Z Use segments for section layout - - - - - 7bbfb789 by Artem Pyanykh at 2019-03-20T23:52:39Z Address some todos and fixmes - - - - - 3cdcc0b5 by Artem Pyanykh at 2019-03-20T23:52:39Z Add a linker test re: section alignment - - - - - cb745c84 by Artem Pyanykh at 2019-03-20T23:52:39Z Add missing levels to SegmentProt enum - - - - - d950f11e by Artem Pyanykh at 2019-03-20T23:52:39Z Directly test section alignment, fix internal reloc probing length - - - - - 3fb10fcf by Artem Pyanykh at 2019-03-20T23:52:39Z Gracefully handle error condition in Mach-O relocateSection - - - - - dc713c71 by Ben Gamari at 2019-03-20T23:58:49Z ci: Move validate-x86_64-linux-deb9 to full-build stage The `build` stage is meant to be a minimal smoke test to weed out broken commits. The `validate-x86_64-linux-deb9` build will generally catch a subset of issues caught by `validate-x86_64-linux-deb9-debug` so only the latter should be in `build`. - - - - - 505c5ab2 by Ben Gamari at 2019-03-20T23:58:49Z ci: Add some descriptions of the stages - - - - - 646e3dc2 by Sebastian Graf at 2019-03-21T00:04:49Z Add a bench flavour to Hadrian - - - - - 8d18a873 by Ryan Scott at 2019-03-21T00:10:57Z Reject nested predicates in impredicativity checking When GHC attempts to unify a metavariable with a type containing foralls, it will be rejected as an occurrence of impredicativity. GHC was /not/ extending the same treatment to predicate types, such as in the following (erroneous) example from #11514: ```haskell foo :: forall a. (Show a => a -> a) -> () foo = undefined ``` This will attempt to instantiate `undefined` at `(Show a => a -> a) -> ()`, which is impredicative. This patch catches impredicativity arising from predicates in this fashion. Since GHC is pickier about impredicative instantiations, some test cases needed to be updated to be updated so as not to fall afoul of the new validity check. (There were a surprising number of impredicative uses of `undefined`!) Moreover, the `T14828` test case now has slightly less informative types shown with `:print`. This is due to a a much deeper issue with the GHCi debugger (see #14828). Fixes #11514. - - - - - 7b213b8d by Ömer Sinan Ağacan at 2019-03-21T00:17:05Z Print test suite results ("unexpected failures" etc.) in sorted order Fixes #16425 - - - - - f199a843 by Simon Jakobi at 2019-03-21T00:23:15Z Check.hs: Fix a few typos - - - - - 07d44ed1 by Ben Gamari at 2019-03-21T00:29:20Z base: Depend upon shlwapi on Windows As noted in #16466, `System.Environment.getExecutablePath` depends upon `PathFileExistsW` which is defined by `shlwapi`. Fixes #16466. - - - - - 1382d09e by Ryan Scott at 2019-03-21T00:35:28Z Remove unused XArrApp and XArrForm extension points !301 removed the `HsArrApp` and `HsArrForm` constructors, which renders the corresponding extension points `XArrApp` and `XArrForm` useless. This patch finally rips them out. - - - - - 3423664b by Peter Trommler at 2019-03-21T00:41:35Z Fix specification of load_load_barrier [skip-ci] - - - - - 84c77a67 by Alexandre Esteves at 2019-03-21T21:43:03Z Fix typo [skip ci] - - - - - 7092b2de by Matthew Pickering at 2019-03-22T03:38:58Z Only run check-makefiles.py linter in testsuite dir - - - - - 322239de by Matthew Pickering at 2019-03-22T03:38:58Z Run linters on merge requests It seems that it has failed to execute at all since it was implemented. We now run the linters on merge requests. - - - - - 8f8d532c by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Do full `perf` build when building Windows releases - - - - - 2ef72d3f by Ben Gamari at 2019-03-22T03:45:03Z gitlab-ci: Pass --target explicitly to configure on Windows Otherwise configure fails in the 32-bit case with ``` This GHC (c:/GitLabRunner/builds/8fc0e283/0/ghc/ghc/toolchain/bin/ghc) does not generate code for the build platform GHC target platform : x86_64-unknown-mingw32 Desired build platform : i386-unknown-mingw32 ``` - - - - - 8b14f536 by Ben Gamari at 2019-03-22T03:51:08Z Bump cabal submodule Due to https://github.com/haskell/cabal/issues/5953. - - - - - dbe4557f by Matthew Pickering at 2019-03-22T14:02:32Z CI: Allow failure in packaging step This depends on the windows build which is still allowed to fail. If that job fails then the packaging job will also fail. - - - - - 366f1c68 by Ben Gamari at 2019-03-22T14:08:38Z gitlab: Deploy documentation snapshot via GitLab Pages - - - - - d608d543 by Tamar Christina at 2019-03-22T14:14:45Z Force LF line ending for md5sum [skip-ci] - - - - - cd07086a by Ben Gamari at 2019-03-22T14:34:51Z gitlab-ci: Fix linters - - - - - ab51bee4 by Herbert Valerio Riedel at 2019-03-22T14:34:51Z base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail Coauthored-by: Ben Gamari <ben at well-typed.com> - - - - - 266b49ca by Ben Gamari at 2019-03-22T22:33:20Z gitlab-ci: Clean up linter I'm not sure why these steps were done but they seem counterproductive and unnecessary. - - - - - 44b08ede by Ben Gamari at 2019-03-22T22:38:11Z gitlab-ci: Fix YAML syntax - - - - - 971f4530 by Ben Gamari at 2019-03-22T22:49:34Z gitlab-ci: Compute merge base against remote tracking branch Previously we would use the local branch with the name `$CI_MERGE_REQUEST_TARGET_BRANCH_NAME` to compute the merge base when linting. However, this branch isn't necessarily up-to-date. We should rather use `origin/$CI_MERGE_REQUEST_TARGET_BRANCH_NAME`. - - - - - 8d01b572 by Ben Gamari at 2019-03-23T16:37:56Z gitlab-ci: Explicitly fetch target branch `git fetch`, which we used previously, doesn't update the remote tracking branches. - - - - - cd85f8a7 by Ben Gamari at 2019-03-24T12:46:13Z gitlab-ci: Allow linters to fail for now They are broken and I don't have time to fix them at the moment. - - - - - d763b2e7 by Haskell-mouse at 2019-03-25T18:02:22Z User's Guide: extensions compatibility Adds the mention that extensions "AllowAmbiguousTypes" and "RankNTypes" are not always compatible with each other. Specifies the conditions and causes of failing in resolving of ambiguity. - - - - - 200d65ef by Matthew Pickering at 2019-03-25T18:02:25Z Check hadrian/ghci.sh script output to determine pass/fail ghci always exits with exit code 0 so you have to check the output to see if the modules loaded succesfully. - - - - - 8e07368f by Matthew Pickering at 2019-03-25T18:02:27Z Refactor ./hadrian/ghci.sh for better error messages By separating these two lines, if the first command fails then `ghci` is not loaded. Before it would still load ghci but display lots of errors about not being able to find modules. - - - - - 3769e3a8 by Takenobu Tani at 2019-03-25T18:02:29Z Update Wiki URLs to point to GitLab This moves all URL references to Trac Wiki to their corresponding GitLab counterparts. This substitution is classified as follows: 1. Automated substitution using sed with Ben's mapping rule [1] Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy... New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy... 2. Manual substitution for URLs containing `#` index Old: ghc.haskell.org/trac/ghc/wiki/XxxYyy...#Zzz New: gitlab.haskell.org/ghc/ghc/wikis/xxx-yyy...#zzz 3. Manual substitution for strings starting with `Commentary` Old: Commentary/XxxYyy... New: commentary/xxx-yyy... See also !539 [1]: https://gitlab.haskell.org/bgamari/gitlab-migration/blob/master/wiki-mapping.json - - - - - b9da2868 by Ryan Scott at 2019-03-25T18:02:33Z Correct duplicate 4.12.0.0 entry in base's changelog See #16490. [ci skip] - - - - - ab41c1b4 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: Bump Shake to 0.17.6 The new release of Shake comes with these relevant features: * use symlinks for --shared * add --compact for a Bazel/Buck style output - - - - - 646f2e79 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: trace the execution of expensive Cabal calls We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information. - - - - - fb12f53c by Alp Mestanogullari at 2019-03-27T11:20:05Z Hadrian: introduce an easy way for users to build with -split-sections Any user can now trivially build any number of Haskell packages with `-split-sections` by using `splitSections`/`splitSectionsIf` on any existing or new flavour: -- build all packages but the ghc library with -split-sections splitSections :: Flavour -> Flavour -- build all packages that satisfy the given predicate -- with --split-sections splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour See the new section in `doc/user-settings.md`. - - - - - 3dec527a by David Eichmann at 2019-03-27T11:20:09Z Hadrian: don't use -zorigin on darwin. - - - - - 5730f863 by Ömer Sinan Ağacan at 2019-03-27T11:20:10Z Minor refactoring in copy array primops: - `emitCopySmallArray` now checks size before generating code and doesn't generate any code when size is 0. `emitCopyArray` already does this so this makes small/large array cases the same in argument checking. - In both `emitCopySmallArray` and `emitCopyArray` read the `dflags` after checking the argument. - - - - - 4acdb769 by Chaitanya Koparkar at 2019-03-27T11:20:11Z Fix a few broken Trac links [skip ci] This patch only attempts to fix links that don't automatically re-direct to the correct URL. - - - - - 97ad5cfb by Artem Pelenitsyn at 2019-03-29T18:18:12Z Add some tips to the Troubleshooting section of README - - - - - 8a20bfc2 by Michael Peyton Jones at 2019-03-29T18:18:14Z Visibility: handle multiple units with the same name Fixes #16228. The included test case is adapted from the reproduction in the issue, and fails without this patch. ------ We compute an initial visilibity mapping for units based on what is present in the package databases. To seed this, we compute a set of all the package configs to add visibilities for. However, this set was keyed off the unit's *package name*. This is correct, since we compare packages across databases by version. However, we would only ever consider a single, most-preferable unit from the database in which it was found. The effect of this was that only one of the libraries in a Cabal package would be added to this initial set. This would cause attempts to use modules from the omitted libraries to fail, claiming that the package was hidden (even though `ghc-pkg` would correctly show it as visible). A solution is to do the selection of the most preferable packages separately, and then be sure to consider exposing all units in the same package in the same package db. We can do this by picking a most-preferable unit for each package name, and then considering exposing all units that are equi-preferable with that unit. ------ Why wasn't this bug apparent to all people trying to use sub-libraries in Cabal? The answer is that Cabal explicitly passes `-package` and `-package-id` flags for all the packages it wants to use, rather than relying on the state of the package database. So this bug only really affects people who are trying to use package databases produced by Cabal outside of Cabal itself. One particular example of this is the way that the Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these are equipped with a package database containing all the needed package dependencies, and the user is not expected to pass `-package` flags explicitly. - - - - - 754b5455 by Artem Pelenitsyn at 2019-03-29T18:18:20Z docs: make nfib compute the Fibonacci sequence [skipci] - - - - - 1a567133 by Ben Gamari at 2019-03-29T18:18:20Z ci: Check that changelogs don't contain "TBA" This ensures that the release dates in the library changelogs are properly set. - - - - - 6e15ca54 by Ben Gamari at 2019-03-29T18:18:22Z Bump transformers to 0.5.6.2 See #16199. - - - - - 6f7115df by Ben Gamari at 2019-03-30T11:42:38Z ci: Ensure index.html is preserved in documentation tarball - - - - - 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 3bd01f15 by Ben Gamari at 2019-06-08T03:15:45Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. I tried to extend it to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from Haskell. - - - - - 30 changed files: - .circleci/config.yml - .circleci/prepare-system.sh - .ghcid - + .gitattributes - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - .gitlab/linters/check-makefiles.py - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/merge_request_templates/merge-request.md - + .gitlab/start-head.hackage.sh - .gitlab/win32-init.sh - .mailmap - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - Makefile - README.md - aclocal.m4 - bindisttest/Makefile - bindisttest/ghc.mk - boot - compiler/Makefile - compiler/backpack/DriverBkp.hs - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/Demand.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cb61371e3260e07be724a04b72a935133f66b514...3bd01f151355e3ebc9f33eae6f6806c51f0f98da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cb61371e3260e07be724a04b72a935133f66b514...3bd01f151355e3ebc9f33eae6f6806c51f0f98da You're receiving 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 Jun 8 03:18:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 23:18:14 -0400 Subject: [Git][ghc/ghc][wip/closure-size] testsuite: fix and extend closure_size test Message-ID: <5cfb28f6cf64_6f73fe611ab0cd4111628@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: 99639cee by Ben Gamari at 2019-06-08T03:17:17Z testsuite: fix and extend closure_size test this was previously broken in several ways. this is fixed and it also now tests arrays. unfortunately i was unable to find a way to continue testing pap and fun sizes; these simply depend too much upon the behavior of the simplifier. i tried to extend it to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. fixes #16531. - - - - - 2 changed files: - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs Changes: ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,15 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [ when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,26 +1,69 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} import Control.Monad import Type.Reflection +import GHC.Exts import GHC.Stack +import GHC.IO import GHC.Exts.Heap.Closures -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize {-# NOINLINE assertSize #-} pap :: Int -> Char -> Int pap x _ = x {-# NOINLINE pap #-} +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a + + main :: IO () main = do assertSize 'a' 2 @@ -28,7 +71,32 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + -- These depend too much upon the behavior of the simplifier to + -- test reliably. + --assertSize (id :: Int -> Int) 1 + --assertSize (fst :: (Int,Int) -> Int) 1 + --assertSize (pap 1) 2 + + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99639cee73f9c4ab6019c8dd7e293d4fd27148c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99639cee73f9c4ab6019c8dd7e293d4fd27148c5 You're receiving 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 Jun 8 03:19:09 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 07 Jun 2019 23:19:09 -0400 Subject: [Git][ghc/ghc][wip/closure-size] testsuite: Fix and extend closure_size test Message-ID: <5cfb292d83c68_6f73fe5e11f806811164b0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: 33c815e7 by Ben Gamari at 2019-06-08T03:18:27Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - 2 changed files: - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs Changes: ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,15 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [ when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,26 +1,69 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} import Control.Monad import Type.Reflection +import GHC.Exts import GHC.Stack +import GHC.IO import GHC.Exts.Heap.Closures -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize {-# NOINLINE assertSize #-} pap :: Int -> Char -> Int pap x _ = x {-# NOINLINE pap #-} +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a + + main :: IO () main = do assertSize 'a' 2 @@ -28,7 +71,32 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + -- These depend too much upon the behavior of the simplifier to + -- test reliably. + --assertSize (id :: Int -> Int) 1 + --assertSize (fst :: (Int,Int) -> Int) 1 + --assertSize (pap 1) 2 + + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/33c815e7f5a473f7047fa526279e85f7128803b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/33c815e7f5a473f7047fa526279e85f7128803b2 You're receiving 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 Jun 8 16:33:06 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 08 Jun 2019 12:33:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 48 commits: Remove trailing whitespace Message-ID: <5cfbe342d9863_6f73fe6058b4180125183f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fe9a292a by Matthew Pickering at 2019-06-08T16:32:18Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 21fd6acc by Alexandre Baldé at 2019-06-08T16:32:20Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 140005d0 by chessai at 2019-06-08T16:32:22Z make log1p and expm1 primops - - - - - 595387c2 by chessai at 2019-06-08T16:32:22Z add tests for new log1p/expm1 - - - - - 80b73038 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Add test for #16514 - - - - - b90f06e7 by Ben Gamari at 2019-06-08T16:32:23Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - bd405e67 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 9ac12642 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Make closureSize less sensitive to optimisation - - - - - b7a1f5ae by Ben Gamari at 2019-06-08T16:32:23Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - b45258c2 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 6d04191b by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 81447587 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - fd6671dc by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 2c85d13d by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - adeda566 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - e8bb4f46 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 829a657e by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 1e81e752 by Ben Gamari at 2019-06-08T16:32:23Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 07153df4 by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Fix fragile_for test modifier - - - - - f72a4df6 by Ben Gamari at 2019-06-08T16:32:24Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - dc471c13 by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 317307ef by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 0beb04b7 by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - b392c9d5 by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 096767f2 by Ben Gamari at 2019-06-08T16:32:24Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - cc35336f by Simon Jakobi at 2019-06-08T16:32:26Z Small refactorings in ExtractDocs - - - - - f378f740 by Oleg Grenrus at 2019-06-08T16:32:29Z Add -Winferred-safe-imports warning This commit partly reverts e69619e923e84ae61a6bb4357f06862264daa94b commit by reintroducing Sf_SafeInferred SafeHaskellMode. We preserve whether module was declared or inferred Safe. When declared-Safe module imports inferred-Safe, we warn. This inferred status is volatile, often enough it's a happy coincidence, something which cannot be relied upon. However, explicitly Safe or Trustworthy packages won't accidentally become Unsafe. - - - - - b156d0b3 by Oleg Grenrus at 2019-06-08T16:32:29Z Add -Wmissing-safe-haskell-mode warning - - - - - 059e452b by Alp Mestanogullari at 2019-06-08T16:32:30Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 3eb7c285 by Kevin Buhr at 2019-06-08T16:32:31Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - 959c69ba by Richard Eisenberg at 2019-06-08T16:32:34Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 0a5652f7 by Roland Senn at 2019-06-08T16:32:36Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - b7f93ca6 by nineonine at 2019-06-08T16:32:37Z Do not report error if Name in pragma is unbound - - - - - f0308352 by David Eichmann at 2019-06-08T16:32:39Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - a2cf62b0 by Matthew Pickering at 2019-06-08T16:32:39Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - f918627e by Matthew Pickering at 2019-06-08T16:32:39Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - ce885c93 by Matthew Pickering at 2019-06-08T16:32:39Z Fix two lint failures in rts/linker/MachO.c - - - - - f883959a by Ben Gamari at 2019-06-08T16:32:39Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - d77b9484 by Ben Gamari at 2019-06-08T16:32:39Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - 4794a50c by Ben Gamari at 2019-06-08T16:32:39Z gitlab-ci: A few clarifying comments - - - - - e99e2cdd by Alp Mestanogullari at 2019-06-08T16:32:41Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - d047ce90 by Matthew Pickering at 2019-06-08T16:32:41Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 26556d36 by Richard Eisenberg at 2019-06-08T16:32:43Z Comments only: document tcdDataCusk better. - - - - - 2aecdb93 by Richard Eisenberg at 2019-06-08T16:32:44Z Comments only: document newtypes' DataConWrapId - - - - - 3b153348 by Vladislav Zavialov at 2019-06-08T16:32:45Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 10ca01c3 by Ben Gamari at 2019-06-08T16:32:45Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 9dde476f by John Ericson at 2019-06-08T16:32:47Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 96701da5 by Daniel Gröber at 2019-06-08T16:32:48Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/MkId.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/GHCi.hs - compiler/ghci/Linker.hs - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/66848cbddd5f7aaf1f28c2b517f77df593edea8f...96701da56ec4f5f5f3defc6f409b2c16ad6eef83 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/66848cbddd5f7aaf1f28c2b517f77df593edea8f...96701da56ec4f5f5f3defc6f409b2c16ad6eef83 You're receiving 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 Jun 8 16:45:24 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 12:45:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/riscv Message-ID: <5cfbe624c863a_6f73fe60402301c128865a@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/riscv at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/riscv You're receiving 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 Jun 8 17:15:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:15:03 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Add missing memory barrier Message-ID: <5cfbed174a1c2_6f73fe5e15af1201294314@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 8c20ee41 by Ben Gamari at 2019-06-08T17:14:58Z Add missing memory barrier - - - - - 1 changed file: - includes/Cmm.h Changes: ===================================== includes/Cmm.h ===================================== @@ -309,6 +309,8 @@ again: \ W_ info; \ LOAD_INFO(ret,x) \ + /* See Note [Heap memory barriers] in SMP.h */ \ + prim_read_barrier(); \ switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ case \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c20ee414efc23e1b80669521fa229ee39c05e1a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c20ee414efc23e1b80669521fa229ee39c05e1a You're receiving 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 Jun 8 17:15:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:15:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dynamic-by-default Message-ID: <5cfbed31265db_6f73fe6148eaca8129601e@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/dynamic-by-default at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/dynamic-by-default You're receiving 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 Jun 8 17:16:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:16:03 -0400 Subject: [Git][ghc/ghc][wip/dynamic-by-default] Reenable DYNAMIC_BY_DEFAULT Message-ID: <5cfbed5346722_6f79a8acc412962a4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dynamic-by-default at Glasgow Haskell Compiler / GHC Commits: eda8ff34 by Ben Gamari at 2019-06-08T17:15:40Z Reenable DYNAMIC_BY_DEFAULT Nearly 7 years ago Ian unconditionally disabled DYNAMIC_BY_DEFAULT in the build system due to concerns of lacking cabal-install support. I believe these concerns are no longer warranted; we should reenable this. Fixes #16782. - - - - - 1 changed file: - mk/config.mk.in Changes: ===================================== mk/config.mk.in ===================================== @@ -140,10 +140,6 @@ else DYNAMIC_BY_DEFAULT = YES endif -# For now, we unconditionally disable dynamic-by-default, as the -# cabal-install's that are in the wild don't handle it properly. -DYNAMIC_BY_DEFAULT = NO - # If building both v and dyn ways, then use -dynamic-too to build them. # This makes the build faster. DYNAMIC_TOO = YES View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/eda8ff3460e45f2d49b5cacb9127ab71505c4984 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/eda8ff3460e45f2d49b5cacb9127ab71505c4984 You're receiving 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 Jun 8 17:19:46 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:19:46 -0400 Subject: [Git][ghc/ghc][wip/init-event-types] rts: Separate population of eventTypes from initial event generation Message-ID: <5cfbee32bfcaf_6f73fe6058b418012977cc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/init-event-types at Glasgow Haskell Compiler / GHC Commits: 6a52c83f by Ben Gamari at 2019-06-08T17:19:39Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - 1 changed file: - rts/eventlog/EventLog.c Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -267,15 +267,9 @@ flushEventLog(void) } static void -postHeaderEvents(void) +init_event_types(void) { - // Write in buffer: the header begin marker. - postInt32(&eventBuf, EVENT_HEADER_BEGIN); - - // Mark beginning of event types in the header. - postInt32(&eventBuf, EVENT_HET_BEGIN); for (int t = 0; t < NUM_GHC_EVENT_TAGS; ++t) { - eventTypes[t].etNum = t; eventTypes[t].desc = EventDesc[t]; @@ -450,9 +444,22 @@ postHeaderEvents(void) default: continue; /* ignore deprecated events */ } + } +} + +static void +postHeaderEvents(void) +{ + // Write in buffer: the header begin marker. + postInt32(&eventBuf, EVENT_HEADER_BEGIN); + // Mark beginning of event types in the header. + postInt32(&eventBuf, EVENT_HET_BEGIN); + + for (int t = 0; t < NUM_GHC_EVENT_TAGS; ++t) { // Write in buffer: the start event type. - postEventType(&eventBuf, &eventTypes[t]); + if (eventTypes[t].desc) + postEventType(&eventBuf, &eventTypes[t]); } // Mark end of event types in the header. @@ -470,6 +477,8 @@ initEventLogging(const EventLogWriter *ev_writer) { uint32_t n_caps; + init_event_types(); + event_log_writer = ev_writer; initEventLogWriter(); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6a52c83f7be44c7ff01b3180bb2dba20fc2b987e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6a52c83f7be44c7ff01b3180bb2dba20fc2b987e You're receiving 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 Jun 8 17:31:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:31:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16779 Message-ID: <5cfbf0e2ed1b6_6f7cf584101300826@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16779 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16779 You're receiving 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 Jun 8 17:34:20 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:34:20 -0400 Subject: [Git][ghc/ghc][wip/fix-linters] 23 commits: gitlab-ci: Disable darwin hadrian job Message-ID: <5cfbf19c8891f_6f7d01d7881305433@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-linters at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/main/DriverPipeline.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/ListSetOps.hs - docs/users_guide/eventlog-formats.rst - ghc/GHCi/UI.hs - hadrian/src/Hadrian/Utilities.hs - includes/rts/EventLogFormat.h - libraries/base/Data/Traversable.hs - libraries/base/GHC/ForeignPtr.hs - libraries/base/GHC/Natural.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/isValidNatural.hs - + libraries/base/tests/isValidNatural.stdout - + libraries/ghc-boot/GHC/BaseDir.hs - libraries/ghc-boot/ghc-boot.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8ec83227c4b6b1c8d5c5e66fae601650a5f22837...c392f987de174ae04c6c7c47145dfe5db6427615 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8ec83227c4b6b1c8d5c5e66fae601650a5f22837...c392f987de174ae04c6c7c47145dfe5db6427615 You're receiving 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 Jun 8 17:37:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:37:14 -0400 Subject: [Git][ghc/ghc][master] 6 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfbf24adfb46_6f7cf5841013061c8@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 2 changed files: - .gitlab-ci.yml - rts/linker/MachO.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -49,13 +49,18 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + # Note [Unshallow clone for linting] + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # GitLab creates a shallow clone which means that we may not have the base + # commit of the MR being tested (e.g. if the MR is quite old), causing `git + # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that + # we have the entire history. + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Merge base $base" + - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) - validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA) - .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA @@ -75,6 +80,10 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + # See Note [Unshallow clone for linting] + - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" + - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -97,10 +106,15 @@ lint-submods-marge: lint-submods-mr: extends: .lint-submods + # Allow failure since any necessary submodule patches may not be upstreamed + # yet. allow_failure: true only: refs: - merge_requests + except: + variables: + - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ .lint-changelogs: stage: lint @@ -117,6 +131,7 @@ lint-submods-mr: lint-changelogs: extends: .lint-changelogs + # Allow failure since this isn't a final release. allow_failure: true only: refs: ===================================== rts/linker/MachO.c ===================================== @@ -1220,7 +1220,7 @@ ocGetNames_MachO(ObjectCode* oc) IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", oc->n_sections)); -#if defined (ios_HOST_OS) +#if defined(ios_HOST_OS) for(int i=0; i < oc->n_sections; i++) { MachOSection * section = &oc->info->macho_sections[i]; @@ -1645,7 +1645,7 @@ ocResolve_MachO(ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); -#if defined aarch64_HOST_ARCH +#if defined(aarch64_HOST_ARCH) if (!relocateSectionAarch64(oc, &oc->sections[i])) return 0; #else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1afb499583f741a95cceb3207c5455c8ec6f5b87...c392f987de174ae04c6c7c47145dfe5db6427615 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1afb499583f741a95cceb3207c5455c8ec6f5b87...c392f987de174ae04c6c7c47145dfe5db6427615 You're receiving 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 Jun 8 17:38:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:38:17 -0400 Subject: [Git][ghc/ghc][wip/remove-whitespace] 24 commits: gitlab-ci: Disable darwin hadrian job Message-ID: <5cfbf289f374_6f73fe6148eaca8130752c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/remove-whitespace at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmForeign.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/ListSetOps.hs - docs/users_guide/eventlog-formats.rst - ghc/GHCi/UI.hs - hadrian/src/Hadrian/Utilities.hs - includes/rts/EventLogFormat.h - libraries/base/Data/Traversable.hs - libraries/base/GHC/ForeignPtr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/36cab4e723020519a4e185a12ec75b3c81868d0c...709290b01c3c63137d863d6fdd97dabdfe47eb29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/36cab4e723020519a4e185a12ec75b3c81868d0c...709290b01c3c63137d863d6fdd97dabdfe47eb29 You're receiving 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 Jun 8 17:40:44 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 08 Jun 2019 13:40:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 48 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfbf31cd2537_6f7ecf7a0c13098bb@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - af730a86 by Alexandre Baldé at 2019-06-08T17:39:56Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - c3f063ff by chessai at 2019-06-08T17:39:58Z make log1p and expm1 primops - - - - - b19594f3 by chessai at 2019-06-08T17:39:58Z add tests for new log1p/expm1 - - - - - 8d33ffe7 by Ben Gamari at 2019-06-08T17:39:59Z testsuite: Add test for #16514 - - - - - 9b0889b4 by Ben Gamari at 2019-06-08T17:39:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - b7b89858 by Ben Gamari at 2019-06-08T17:39:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - e482f0d2 by Ben Gamari at 2019-06-08T17:39:59Z testsuite: Make closureSize less sensitive to optimisation - - - - - 897ae8ed by Ben Gamari at 2019-06-08T17:39:59Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 790c0405 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - ee482417 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - e0ec212a by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 030ac995 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 6e13c30b by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 9dedea1c by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 62c0a3d2 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 36a3db54 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 675977bd by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 7973c26e by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Fix fragile_for test modifier - - - - - 38e17c3b by Ben Gamari at 2019-06-08T17:40:00Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - c653a0ab by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 9e739df6 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 114c47cc by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 54973271 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - c81f7563 by Ben Gamari at 2019-06-08T17:40:00Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 4ee43517 by Simon Jakobi at 2019-06-08T17:40:03Z Small refactorings in ExtractDocs - - - - - 90edc52e by Oleg Grenrus at 2019-06-08T17:40:06Z Add -Winferred-safe-imports warning This commit partly reverts e69619e923e84ae61a6bb4357f06862264daa94b commit by reintroducing Sf_SafeInferred SafeHaskellMode. We preserve whether module was declared or inferred Safe. When declared-Safe module imports inferred-Safe, we warn. This inferred status is volatile, often enough it's a happy coincidence, something which cannot be relied upon. However, explicitly Safe or Trustworthy packages won't accidentally become Unsafe. - - - - - 59b788b1 by Oleg Grenrus at 2019-06-08T17:40:06Z Add -Wmissing-safe-haskell-mode warning - - - - - 266bfbf8 by Alp Mestanogullari at 2019-06-08T17:40:08Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 0d099a42 by Kevin Buhr at 2019-06-08T17:40:09Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - 223371e9 by Richard Eisenberg at 2019-06-08T17:40:12Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 8cbb00d0 by Roland Senn at 2019-06-08T17:40:14Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 61115979 by nineonine at 2019-06-08T17:40:16Z Do not report error if Name in pragma is unbound - - - - - aeed1b21 by David Eichmann at 2019-06-08T17:40:20Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - a1b49e37 by Alp Mestanogullari at 2019-06-08T17:40:22Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 96377caf by Matthew Pickering at 2019-06-08T17:40:23Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 60d29a8f by Richard Eisenberg at 2019-06-08T17:40:25Z Comments only: document tcdDataCusk better. - - - - - cdc2cd6e by Richard Eisenberg at 2019-06-08T17:40:26Z Comments only: document newtypes' DataConWrapId - - - - - be58e69b by Vladislav Zavialov at 2019-06-08T17:40:27Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 15f250fd by Ben Gamari at 2019-06-08T17:40:28Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 9acbae65 by John Ericson at 2019-06-08T17:40:30Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - bb8bb1cf by Daniel Gröber at 2019-06-08T17:40:31Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/MkId.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghc.cabal.in - compiler/ghci/GHCi.hs - compiler/ghci/Linker.hs - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96701da56ec4f5f5f3defc6f409b2c16ad6eef83...bb8bb1cf61a1eb10b7bfda3e9a8f37929c8d3df6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/96701da56ec4f5f5f3defc6f409b2c16ad6eef83...bb8bb1cf61a1eb10b7bfda3e9a8f37929c8d3df6 You're receiving 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 Jun 8 17:41:53 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Sat, 08 Jun 2019 13:41:53 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/remove-whitespace Message-ID: <5cfbf361945ca_6f7ecf7a0c131851b@gitlab.haskell.org.mail> Matthew Pickering deleted branch wip/remove-whitespace 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 Jun 8 17:41:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:41:55 -0400 Subject: [Git][ghc/ghc][master] Remove trailing whitespace Message-ID: <5cfbf3635c8be_6f73fe605385a4c1319093@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 7 changed files: - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmForeign.hs - compiler/ghci/LinkerTypes.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs Changes: ===================================== compiler/cmm/MkGraph.hs ===================================== @@ -335,8 +335,8 @@ copyIn dflags conv area formals extra_stk local = CmmLocal reg width = cmmRegWidth dflags local expr = CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [stack_slot] - in CmmAssign local expr - + in CmmAssign local expr + | otherwise = CmmAssign (CmmLocal reg) (CmmLoad (CmmStackSlot area off) ty) where ty = localRegType reg ===================================== compiler/codeGen/StgCmmForeign.hs ===================================== @@ -526,7 +526,7 @@ closureField dflags off = off + fixedHdrSize dflags -- demonstrated that this leads to bad behavior in the presence -- of unsafeCoerce#. Returning to the above example, suppose the -- Haskell call looked like --- foo (unsafeCoerce# p) +-- foo (unsafeCoerce# p) -- where the types of expressions comprising the arguments are -- p :: (Any :: TYPE 'UnliftedRep) -- i :: Int# @@ -591,7 +591,7 @@ add_shim dflags ty expr = case ty of -- the offset of each argument when used as a C FFI argument. -- See Note [Unlifted boxed arguments to foreign calls] collectStgFArgTypes :: Type -> [StgFArgType] -collectStgFArgTypes = go [] +collectStgFArgTypes = go [] where -- Skip foralls go bs (ForAllTy _ res) = go bs res ===================================== compiler/ghci/LinkerTypes.hs ===================================== @@ -28,7 +28,7 @@ import NameEnv ( NameEnv ) import Name ( Name ) import GHCi.RemoteTypes ( ForeignHValue ) -type ClosureEnv = NameEnv (Name, ForeignHValue) +type ClosureEnv = NameEnv (Name, ForeignHValue) newtype DynLinker = DynLinker { dl_mpls :: MVar (Maybe PersistentLinkerState) } ===================================== compiler/main/HscTypes.hs ===================================== @@ -443,7 +443,7 @@ data HscEnv -- time it is needed. , hsc_dynLinker :: DynLinker - -- ^ dynamic linker. + -- ^ dynamic linker. } ===================================== compiler/main/Packages.hs ===================================== @@ -1470,8 +1470,8 @@ mkPackageState dflags dbs preload0 = do _ -> unit' addIfMorePreferable m unit = addToUDFM_C preferLater m (fsPackageName unit) unit -- This is the set of maximally preferable packages. In fact, it is a set of - -- most preferable *units* keyed by package name, which act as stand-ins in - -- for "a package in a database". We use units here because we don't have + -- most preferable *units* keyed by package name, which act as stand-ins in + -- for "a package in a database". We use units here because we don't have -- "a package in a database" as a type currently. mostPreferablePackageReps = if gopt Opt_HideAllPackages dflags then emptyUDFM @@ -1481,7 +1481,7 @@ mkPackageState dflags dbs preload0 = do -- with the most preferable unit for package. Being equi-preferable means that -- they must be in the same database, with the same version, and the same pacakge name. -- - -- We must take care to consider all these units and not just the most + -- We must take care to consider all these units and not just the most -- preferable one, otherwise we can end up with problems like #16228. mostPreferable u = case lookupUDFM mostPreferablePackageReps (fsPackageName u) of ===================================== compiler/specialise/Specialise.hs ===================================== @@ -938,7 +938,7 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn | otherwise = return () where allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - doWarn reason = + doWarn reason = warnMsg reason (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) ===================================== compiler/stgSyn/StgSyn.hs ===================================== @@ -686,7 +686,7 @@ data StgOp | StgPrimCallOp PrimCall - | StgFCallOp ForeignCall Type Unique + | StgFCallOp ForeignCall Type Unique -- The Unique is occasionally needed by the C pretty-printer -- (which lacks a unique supply), notably when generating a -- typedef for foreign-export-dynamic. The Type, which is View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/709290b01c3c63137d863d6fdd97dabdfe47eb29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/709290b01c3c63137d863d6fdd97dabdfe47eb29 You're receiving 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 Jun 8 17:42:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:42:17 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 51 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cfbf3793fb59_6f73fe60e5c9d681339523@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 61596adb by Ben Gamari at 2019-06-08T17:42:13Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - f8d03fc2 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - df851114 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Make closureSize less sensitive to optimisation - - - - - 186614e1 by Ben Gamari at 2019-06-08T17:42:13Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 2e54b505 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - dc5a85d7 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - ee3c34ff by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - a0f02157 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 1e08c40e by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 86264099 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 9573f2c3 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 764ec2c8 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 89298e9a by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - b989b4e1 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Fix fragile_for test modifier - - - - - 0a563f5c by Ben Gamari at 2019-06-08T17:42:13Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - e84e67ea by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - ee8fba70 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - f3882fa4 by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 70d1f0ca by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - dd9b918c by Ben Gamari at 2019-06-08T17:42:13Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3028f75c0462b13fbcf7900dd615ac44a9395730...dd9b918c5098b6d886213bf3f98424dc1c6d1016 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3028f75c0462b13fbcf7900dd615ac44a9395730...dd9b918c5098b6d886213bf3f98424dc1c6d1016 You're receiving 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 Jun 8 17:42:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:42:21 -0400 Subject: [Git][ghc/ghc][wip/T16514] 302 commits: Fix formatting issue in ghc-prim's changelog [skip ci] Message-ID: <5cfbf37dcce9f_6f73fe60e5c9d681340136@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16514 at Glasgow Haskell Compiler / GHC Commits: 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 5372ed22 by Ben Gamari at 2019-06-08T17:42:16Z testsuite: Add test for #16514 - - - - - 30 changed files: - .circleci/prepare-system.sh - .ghcid - .gitignore - .gitlab-ci.yml - .gitlab/issue_templates/bug.md - .gitlab/issue_templates/feature_request.md - + .gitlab/linters/check-version-number.sh - .gitlab/win32-init.sh - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - boot - compiler/backpack/DriverBkp.hs - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmCallConv.hs - compiler/cmm/CmmExpr.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/MkGraph.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4bbf665d98b65c1ac44ff42a6a9f75be93533eff...5372ed22c18e514f7e7893a900f1b29dc602cc24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4bbf665d98b65c1ac44ff42a6a9f75be93533eff...5372ed22c18e514f7e7893a900f1b29dc602cc24 You're receiving 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 Jun 8 17:42:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:42:31 -0400 Subject: [Git][ghc/ghc][wip/update-autoconf] 196 commits: Introduce MonadP, make PV a newtype Message-ID: <5cfbf38795665_6f7d01d788134283@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/update-autoconf at Glasgow Haskell Compiler / GHC Commits: 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitignore - .gitlab-ci.yml - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CorePrep.hs - compiler/coreSyn/CoreUnfold.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51ec383c0f93f5237fce947ce46d9a51dca80f1d...709290b01c3c63137d863d6fdd97dabdfe47eb29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51ec383c0f93f5237fce947ce46d9a51dca80f1d...709290b01c3c63137d863d6fdd97dabdfe47eb29 You're receiving 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 Jun 8 17:42:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:42:42 -0400 Subject: [Git][ghc/ghc][wip/T16360] 155 commits: Fix #16603 by documenting some important changes in changelogs Message-ID: <5cfbf392e00cc_6f73fe60e5c9d6813478e5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16360 at Glasgow Haskell Compiler / GHC Commits: 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 92bd7f1a by Kevin Buhr at 2019-06-08T17:42:40Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CorePrep.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37be0713e482b5aeccfe5896fe205cfaa6f5d0a7...92bd7f1a8be80857fb679daf99e3d6cf7d9b63cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37be0713e482b5aeccfe5896fe205cfaa6f5d0a7...92bd7f1a8be80857fb679daf99e3d6cf7d9b63cd You're receiving 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 Jun 8 17:45:08 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:45:08 -0400 Subject: [Git][ghc/ghc][wip/T16738] 25 commits: gitlab-ci: Disable darwin hadrian job Message-ID: <5cfbf424a1d0c_6f73fe5e15af1201359642@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 68bae167 by Ben Gamari at 2019-06-08T17:45:06Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/basicTypes/NameEnv.hs - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmForeign.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Linker.hs - compiler/ghci/LinkerTypes.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/BaseDir.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e8133fd75077dbd80f53cb7a9c881bee42399cf...68bae167ed7ab34f4294cca51a3d59d979fd4ebc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4e8133fd75077dbd80f53cb7a9c881bee42399cf...68bae167ed7ab34f4294cca51a3d59d979fd4ebc You're receiving 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 Jun 8 17:45:12 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 13:45:12 -0400 Subject: [Git][ghc/ghc][wip/16718] 36 commits: Add `-haddock` option under ci condition to fix #16415 Message-ID: <5cfbf42872e03_6f78b1076c1360025@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/16718 at Glasgow Haskell Compiler / GHC Commits: 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - 88b2ef1e by Vladislav Zavialov at 2019-06-08T17:45:07Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp - compiler/specialise/Specialise.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnDriver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0fff215da8bd8804ae6d044a0a6be3764125899...88b2ef1e299f26d30901df5ecbb23fd49f2513ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d0fff215da8bd8804ae6d044a0a6be3764125899...88b2ef1e299f26d30901df5ecbb23fd49f2513ba You're receiving 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 Jun 8 18:08:16 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:08:16 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Disable shallow clones Message-ID: <5cfbf99038bd8_6f787081d813664b8@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,6 +8,9 @@ variables: # .gitlab/win32-init.sh. WINDOWS_TOOLCHAIN_VERSION: 1 + # Disable shallow clones; they break our linting rules + GIT_DEPTH: 0 + before_script: - python3 .gitlab/fix-submodules.py - git submodule sync --recursive @@ -52,13 +55,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # Note [Unshallow clone for linting] - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # GitLab creates a shallow clone which means that we may not have the base - # commit of the MR being tested (e.g. if the MR is quite old), causing `git - # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that - # we have the entire history. - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) @@ -80,8 +77,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # See Note [Unshallow clone for linting] - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b2f106f5544e4c71bb07df4acb9d2b5ed184a7e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b2f106f5544e4c71bb07df4acb9d2b5ed184a7e3 You're receiving 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 Jun 8 18:15:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:15:50 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 21 commits: gitlab-ci: Disable shallow clones Message-ID: <5cfbfb5690d2d_6f7d01d7881368311@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 608e1af6 by Ben Gamari at 2019-06-08T18:15:45Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - c9641703 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 4cfbef6c by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Make closureSize less sensitive to optimisation - - - - - c56b2c1a by Ben Gamari at 2019-06-08T18:15:45Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 999ba652 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - f1214829 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 8da062a8 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 48fb8dba by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 5256f023 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 2d530d3e by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - d8ec93f2 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - eed762a6 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 614fb91b by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - f2e47f71 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Fix fragile_for test modifier - - - - - 816aa700 by Ben Gamari at 2019-06-08T18:15:45Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - d437a98c by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - ef82fe55 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - a0778f41 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 716c2095 by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 3d0857da by Ben Gamari at 2019-06-08T18:15:45Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 20 changed files: - .gitlab-ci.yml - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - libraries/process - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/rts/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,6 +8,9 @@ variables: # .gitlab/win32-init.sh. WINDOWS_TOOLCHAIN_VERSION: 1 + # Disable shallow clones; they break our linting rules + GIT_DEPTH: 0 + before_script: - python3 .gitlab/fix-submodules.py - git submodule sync --recursive @@ -52,13 +55,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # Note [Unshallow clone for linting] - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # GitLab creates a shallow clone which means that we may not have the base - # commit of the MR being tested (e.g. if the MR is quite old), causing `git - # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that - # we have the entire history. - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) @@ -80,8 +77,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # See Note [Unshallow clone for linting] - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) @@ -464,6 +460,7 @@ validate-x86_64-linux-deb9-debug: stage: build variables: BUILD_FLAVOUR: validate + TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" validate-x86_64-linux-deb9-llvm: ===================================== libraries/base/tests/all.T ===================================== @@ -203,7 +203,7 @@ test('T8089', compile_and_run, ['']) test('hWaitForInput-accurate-socket', reqlib('unix'), compile_and_run, ['']) test('T8684', expect_broken(8684), compile_and_run, ['']) -test('hWaitForInput-accurate-stdin', normal, compile_and_run, ['']) +test('hWaitForInput-accurate-stdin', [expect_broken_for(16535, ['threaded1', 'threaded2']), omit_ways(['ghci'])], compile_and_run, ['']) test('hWaitForInput-accurate-pipe', reqlib('unix'), compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', @@ -234,6 +234,6 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) test('T16111', exit_code(1), compile_and_run, ['']) ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -7,5 +7,5 @@ test('heap_all', ], compile_and_run, ['']) test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [omit_ways(['ghci', 'hpc', 'prof']), expect_broken_for(16544, ['dyn', 'optasm', 'threaded2'])], compile_and_run, ['']) ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} import Control.Monad import Type.Reflection @@ -17,12 +18,17 @@ assertSize !x expected = do putStrLn $ prettyCallStack callStack {-# NOINLINE assertSize #-} -pap :: Int -> Char -> Int +pap :: Int -> Maybe Char -> Int pap x _ = x {-# NOINLINE pap #-} main :: IO () main = do + -- Ensure that GHC can't turn PAP into a FUN (see #16531) + let x :: Int + x = 42 + {-# NOINLINE x #-} + assertSize 'a' 2 assertSize (Just ()) 2 assertSize (Nothing :: Maybe ()) 2 @@ -30,5 +36,5 @@ main = do assertSize ((1,2,3) :: (Int,Int,Int)) 4 assertSize (id :: Int -> Int) 1 assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + assertSize (pap x) 2 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 5c81524694ceaf8523a1846718a7a7c3f402124f ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit a67b5e9e70a2a0c438d4f186fda9f38409ff1435 ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,8 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + assert ways.__class__ is list + opts.omit_ways += ways # ----- @@ -1432,7 +1433,6 @@ def simple_run(name, way, prog, extra_run_opts): return failBecause('bad stderr') if not (opts.ignore_stdout or stdout_ok(name, way)): return failBecause('bad stdout') - check_hp = '-h' in my_rts_flags and opts.check_hp check_prof = '-p' in my_rts_flags ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,4 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -88,7 +88,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) @@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, ['']) # omit threaded2, the behaviour of this test is non-deterministic with more # than one CPU. -test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) +test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -40,7 +40,7 @@ test('T12742', normal, compile, ['']) # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T13910', omit_ways(['profasm']), compile, ['']) +test('T13910', [expect_broken_for(16537, ['optasm']), omit_ways(['profasm'])], compile, ['']) test('T13938', [extra_files(['T13938a.hs'])], makefile_test, ['T13938']) test('T14556', normal, compile, ['']) test('T14720', normal, compile, ['']) ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -35,7 +35,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -207,4 +207,4 @@ test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c' test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) -test('T493', [], compile_and_run, ['T493_c.c']) +test('T493', [omit_ways(['ghci'])], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -1,8 +1,8 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples -test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) -test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, ['']) +test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, ['']) +test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) ===================================== testsuite/tests/programs/barton-mangler-bug/test.T ===================================== @@ -8,7 +8,7 @@ test('barton-mangler-bug', 'Plot.hi', 'Plot.o', 'PlotExample.hi', 'PlotExample.o', 'TypesettingTricks.hi', 'TypesettingTricks.o']), - omit_ways('debug') # Fails for debug way due to annotation linting timeout + omit_ways(['debug']) # Fails for debug way due to annotation linting timeout ], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -73,7 +73,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 test('T2783', [ omit_ways(['ghci']), exit_code(1) - , expect_broken_for(2783, ['threaded1']) + , fragile_for(2783, ['threaded1']) ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in @@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']), # run this test with very small stack chunks to exercise the stack # overflow/underflow machinery. -test('stack003', [ omit_ways('ghci'), # uses unboxed tuples +test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) @@ -214,7 +214,8 @@ test('T7815', [ multi_cpu_race, test('ffishutdown', [ignore_stderr, only_ways(['threaded1','threaded2'])], compile_and_run, ['']) -test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run, +# Times out in ghci way +test('T7919', [when(fast(), skip), omit_ways(['ghci'] + prof_ways)], compile_and_run, [config.ghc_th_way_flags]) test('T8035', normal, compile_and_run, ['']) ===================================== testsuite/tests/th/all.T ===================================== @@ -13,7 +13,7 @@ if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) setTestOpts(only_ways(['normal','ghci','ext-interp'])) -broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] +broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T16180","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] # ext-interp, integer-gmp and llvm is broken see #16087 def broken_ext_interp(name, opts): if name in broken_tests and config.ghc_built_by_llvm: @@ -467,7 +467,10 @@ test('T15437', expect_broken(15437), multimod_compile, test('T15985', normal, compile, ['']) test('T16133', normal, compile_fail, ['']) test('T15471', normal, multimod_compile, ['T15471.hs', '-v0']) -test('T16180', normal, compile_and_run, ['']) +test('T16180', + [when(llvm_build(), expect_broken_for(16541, ['ext-interp'])), + expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-package ghc']) test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -659,7 +659,7 @@ test('T15586', normal, compile, ['']) test('T15368', normal, compile, ['-fdefer-type-errors']) test('T15645', normal, compile, ['-Wwarn=missing-monadfail-instances']) test('T15778', normal, compile, ['']) -test('T14761c', normal, compile, ['']) +test('T14761c', expect_broken_for(16540, ['hpc', 'optasm']), compile, ['']) test('T16008', normal, compile, ['']) test('T16033', normal, compile, ['']) test('T16141', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -35,7 +35,7 @@ test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) test('tcrun021', normal, compile_and_run, ['-package containers']) -test('tcrun022', omit_ways(['ghci']), compile_and_run, ['-O']) +test('tcrun022', omit_ways(['hpc', 'ghci']), compile_and_run, ['-O']) test('tcrun023', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O']) test('tcrun024', normal, compile_and_run, ['-O']) @@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, ['']) +test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcTypeSymbolSimpleRun', normal, compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) ===================================== testsuite/tests/utils/should_run/all.T ===================================== @@ -1,6 +1,6 @@ test('T14854', [only_ways(threaded_ways), - omit_ways('ghci'), + omit_ways(['ghci']), reqlib('random'), ignore_stderr], compile_and_run, ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -26,4 +26,4 @@ test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T1655 test('StarBinder', normal, compile, ['']) -test('Overflow', normal, compile, ['']) +test('Overflow', expect_broken_for(16543, ['hpc']), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dd9b918c5098b6d886213bf3f98424dc1c6d1016...3d0857da0d6114f881b8f9ca8eefc153bf523556 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dd9b918c5098b6d886213bf3f98424dc1c6d1016...3d0857da0d6114f881b8f9ca8eefc153bf523556 You're receiving 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 Jun 8 18:16:57 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:16:57 -0400 Subject: [Git][ghc/ghc][wip/T16738] 2 commits: gitlab-ci: Disable shallow clones Message-ID: <5cfbfb9992a09_6f7d01d788137388e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 0f4169ae by Ben Gamari at 2019-06-08T18:16:54Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 14 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,6 +8,9 @@ variables: # .gitlab/win32-init.sh. WINDOWS_TOOLCHAIN_VERSION: 1 + # Disable shallow clones; they break our linting rules + GIT_DEPTH: 0 + before_script: - python3 .gitlab/fix-submodules.py - git submodule sync --recursive @@ -52,13 +55,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # Note [Unshallow clone for linting] - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # GitLab creates a shallow clone which means that we may not have the base - # commit of the MR being tested (e.g. if the MR is quite old), causing `git - # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that - # we have the entire history. - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) @@ -80,8 +77,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # See Note [Unshallow clone for linting] - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) ===================================== aclocal.m4 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) + let all_paths = let paths = takeDirectory (pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/DynFlags.hs ===================================== @@ -1420,7 +1420,7 @@ pgm_P :: DynFlags -> (String,[Option]) pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags -pgm_c :: DynFlags -> (String,[Option]) +pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags @@ -3048,7 +3048,7 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" $ hasArg $ \f -> alterToolSettings $ \s -> s - { toolSettings_pgm_c = (f,[]) + { toolSettings_pgm_c = f , -- Don't pass -no-pie with -pgmc -- (see #15319) toolSettings_ccSupportsNoPie = False ===================================== compiler/main/Settings.hs ===================================== @@ -119,7 +119,7 @@ sPgm_P :: Settings -> (String, [Option]) sPgm_P = toolSettings_pgm_P . sToolSettings sPgm_F :: Settings -> String sPgm_F = toolSettings_pgm_F . sToolSettings -sPgm_c :: Settings -> (String, [Option]) +sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = words cc_args_str ++ unreg_cc_args + cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = map Option cc_args + ld_prog = cc_prog + ld_args = map Option (cc_args ++ words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Info.hs ===================================== @@ -219,7 +219,7 @@ getCompilerInfo dflags = do -- See Note [Run-time linker info]. getCompilerInfo' :: DynFlags -> IO CompilerInfo getCompilerInfo' dflags = do - let (pgm,_) = pgm_c dflags + let pgm = pgm_c dflags -- Try to grab the info from the process output. parseCompilerInfo _stdo stde _exitc -- Regular GCC ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,9 +62,9 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts - args2 = args0 ++ languageOptions ++ args ++ args1 + args2 = languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the -- user can override flags passed by GHC. See #14452. mb_env <- getGccEnv args2 @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx @@ -333,7 +337,8 @@ runMkDLL dflags args = do runWindres :: DynFlags -> [Option] -> IO () runWindres dflags args = do - let (gcc, gcc_args) = pgm_c dflags + let cc = pgm_c dflags + cc_args = map Option (sOpt_c (settings dflags)) windres = pgm_windres dflags opts = map Option (getOpts dflags opt_windres) quote x = "\"" ++ x ++ "\"" @@ -341,8 +346,7 @@ runWindres dflags args = do -- spaces then windres fails to run gcc. We therefore need -- to tell it what command to use... Option ("--preprocessor=" ++ - unwords (map quote (gcc : - map showOpt gcc_args ++ + unwords (map quote (cc : map showOpt opts ++ ["-E", "-xc", "-DRC_INVOKED"]))) -- ...but if we do that then if windres calls popen then @@ -351,7 +355,7 @@ runWindres dflags args = do -- See #1828. : Option "--use-temp-file" : args - mb_env <- getGccEnv gcc_args + mb_env <- getGccEnv cc_args runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env touch :: DynFlags -> String -> String -> IO () ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/68bae167ed7ab34f4294cca51a3d59d979fd4ebc...0f4169ae350ebd5514855c3756f55d574fef2a6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/68bae167ed7ab34f4294cca51a3d59d979fd4ebc...0f4169ae350ebd5514855c3756f55d574fef2a6b You're receiving 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 Jun 8 18:19:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:19:31 -0400 Subject: [Git][ghc/ghc][wip/T16779] rts/linker: Only mprotect GOT after it is filled Message-ID: <5cfbfc33d7ed2_6f7d01d7881377349@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16779 at Glasgow Haskell Compiler / GHC Commits: 47b6011e by Ben Gamari at 2019-06-08T18:19:21Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1 changed file: - rts/linker/elf_got.c Changes: ===================================== rts/linker/elf_got.c ===================================== @@ -64,8 +64,6 @@ makeGot(ObjectCode * oc) { symTab->symbols[i].got_addr = (uint8_t *)oc->info->got_start + (slot++ * sizeof(void*)); - if(mprotect(mem, oc->info->got_size, PROT_READ) != 0) { - sysErrorBelch("unable to protect memory"); } } return EXIT_SUCCESS; @@ -115,6 +113,11 @@ fillGot(ObjectCode * oc) { } } } + + // We are done initializing the GOT; freeze it. + if(mprotect(of->info->got_start, oc->info->got_size, PROT_READ) != 0) { + sysErrorBelch("unable to protect memory"); + } return EXIT_SUCCESS; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/47b6011e65e63c65743b8500eca8321034d91fc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/47b6011e65e63c65743b8500eca8321034d91fc2 You're receiving 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 Jun 8 18:27:47 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:27:47 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cfbfe23393f1_6f73fe60402301c13783f8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 6114f7bd by Ben Gamari at 2019-06-08T18:26:59Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. Specifically, ticks appearing in two places to defeat the rule: b. Surrounding the fold function a. Surrounding the inner application of `unpackFoldrCString#` The former caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,22 +1368,28 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , cheapEqExpr' tickishFloatable c1 c2 + , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1 + , c2Ticks <- stripTicksTopT tickishFloatable c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` mkTicks (c1Ticks ++ c2Ticks) c1' + `App` n -match_append_lit _ _ _ _ = Nothing +match_append_lit _ _ _ e = Nothing --------------------------------------------------- -- The rule is this: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6114f7bd638142136383f8fd47a346a4604033e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6114f7bd638142136383f8fd47a346a4604033e5 You're receiving 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 Jun 8 18:41:04 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 14:41:04 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Fix submodule linting of commits Message-ID: <5cfc01401ebe9_6f7ecf7a0c137884e@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -79,19 +79,12 @@ ghc-linters: script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Linting changes between $base..$CI_COMMIT_SHA" + - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint -lint-submods: - extends: .lint-submods - only: - refs: - - master - - /ghc-[0-9]+\.[0-9]+/ - lint-submods-marge: extends: .lint-submods only: @@ -112,6 +105,16 @@ lint-submods-mr: variables: - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ +lint-submods-branch: + extends: .lint-submods + script: + - "echo Linting submodule changes for $CI_COMMIT_SHA" + - submodchecker .git $CI_COMMIT_SHA + only: + refs: + - master + - /ghc-[0-9]+\.[0-9]+/ + .lint-changelogs: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a72259d6dcc350d37a50064c18ffcafd03233be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a72259d6dcc350d37a50064c18ffcafd03233be You're receiving 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 Jun 8 19:04:09 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 15:04:09 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Add missing memory barrier Message-ID: <5cfc06a937890_6f73fe6147ded641381591@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: a1454012 by Ben Gamari at 2019-06-08T19:03:51Z Add missing memory barrier - - - - - 1 changed file: - includes/Cmm.h Changes: ===================================== includes/Cmm.h ===================================== @@ -309,6 +309,8 @@ again: \ W_ info; \ LOAD_INFO(ret,x) \ + /* See Note [Heap memory barriers] in SMP.h */ \ + prim_read_barrier; \ switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ case \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a1454012ca9258418e28e0ebf0d90629f58ae425 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a1454012ca9258418e28e0ebf0d90629f58ae425 You're receiving 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 Jun 8 19:37:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 15:37:53 -0400 Subject: [Git][ghc/ghc][wip/T16779] rts/linker: Only mprotect GOT after it is filled Message-ID: <5cfc0e91a92e1_6f787081d81383887@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16779 at Glasgow Haskell Compiler / GHC Commits: e04f6328 by Ben Gamari at 2019-06-08T19:37:45Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1 changed file: - rts/linker/elf_got.c Changes: ===================================== rts/linker/elf_got.c ===================================== @@ -64,8 +64,6 @@ makeGot(ObjectCode * oc) { symTab->symbols[i].got_addr = (uint8_t *)oc->info->got_start + (slot++ * sizeof(void*)); - if(mprotect(mem, oc->info->got_size, PROT_READ) != 0) { - sysErrorBelch("unable to protect memory"); } } return EXIT_SUCCESS; @@ -115,6 +113,11 @@ fillGot(ObjectCode * oc) { } } } + + // We are done initializing the GOT; freeze it. + if(mprotect(oc->info->got_start, oc->info->got_size, PROT_READ) != 0) { + sysErrorBelch("unable to protect memory"); + } return EXIT_SUCCESS; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e04f6328a66361592a60003b8a2e3ea1a6659579 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e04f6328a66361592a60003b8a2e3ea1a6659579 You're receiving 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 Jun 8 19:47:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 15:47:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16784 Message-ID: <5cfc10d4e5cc4_6f73fe6147ded64138806d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16784 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16784 You're receiving 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 Jun 8 20:24:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 16:24:53 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Fix weaks Message-ID: <5cfc1995606c3_6f73fe5e15af1201397033@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 37fb6754 by Ben Gamari at 2019-06-08T20:23:55Z Fix weaks - - - - - 1 changed file: - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/MarkWeak.c ===================================== @@ -234,7 +234,7 @@ static bool tidyWeakList(generation *gen) last_w = &gen->old_weak_ptr_list; for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) { - info = get_itbl((StgClosure *)w); + info = w->header.info; load_load_barrier(); /* There might be a DEAD_WEAK on the list if finalizeWeak# was @@ -246,6 +246,7 @@ static bool tidyWeakList(generation *gen) continue; } + info = INFO_PTR_TO_STRUCT(info); switch (info->type) { case WEAK: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/37fb6754b2d9bbe752114f02f942cf8be990ef1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/37fb6754b2d9bbe752114f02f942cf8be990ef1f You're receiving 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 Jun 8 20:26:11 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 16:26:11 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 3 commits: Threads: Shuffle barrier Message-ID: <5cfc19e3b302f_6f73fe59634593413987fc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 42cf1ff8 by Ben Gamari at 2019-06-08T20:25:17Z Threads: Shuffle barrier It seems clearer if it's closer to its use site - - - - - c9f87556 by Ben Gamari at 2019-06-08T20:25:44Z Evac: Drop redundant barrier in serial path - - - - - 088044ba by Ben Gamari at 2019-06-08T20:26:05Z Merge branch 'wip/memory-barriers' of gitlab.haskell.org:ghc/ghc into wip/memory-barriers - - - - - 2 changed files: - rts/Threads.c - rts/sm/Evac.c Changes: ===================================== rts/Threads.c ===================================== @@ -765,8 +765,6 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value) q = mvar->head; loop: - qinfo = q->header.info; - load_load_barrier(); if (q == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) { /* No further takes, the MVar is now full. */ if (info == &stg_MVAR_CLEAN_info) { @@ -777,6 +775,9 @@ loop: unlockClosure((StgClosure*)mvar, &stg_MVAR_DIRTY_info); return true; } + + qinfo = q->header.info; + load_load_barrier(); if (qinfo == &stg_IND_info || qinfo == &stg_MSG_NULL_info) { q = (StgMVarTSOQueue*)((StgInd*)q)->indirectee; ===================================== rts/sm/Evac.c ===================================== @@ -130,12 +130,9 @@ copy_tag(StgClosure **p, const StgInfoTable *info, } } #else - // if somebody else reads the forwarding pointer, we better make - // sure there's a closure at the end of it. - write_barrier(); - *p = TAG_CLOSURE(tag,(StgClosure*)to); src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to); -#endif + *p = TAG_CLOSURE(tag,(StgClosure*)to); +#endif /* defined(PARALLEL_GC) */ #if defined(PROFILING) // We store the size of the just evacuated object in the LDV word so that View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37fb6754b2d9bbe752114f02f942cf8be990ef1f...088044baf5965f72331cee8fbd813e63f38905c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37fb6754b2d9bbe752114f02f942cf8be990ef1f...088044baf5965f72331cee8fbd813e63f38905c6 You're receiving 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 Jun 8 20:47:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 08 Jun 2019 16:47:02 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Ensure that all commits on a branch are submodule-linted Message-ID: <5cfc1ec68f15e_6f73fe5f42f35b81403326@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -108,8 +108,8 @@ lint-submods-mr: lint-submods-branch: extends: .lint-submods script: - - "echo Linting submodule changes for $CI_COMMIT_SHA" - - submodchecker .git $CI_COMMIT_SHA + - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) only: refs: - master View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8754002973dcde8709458044e541ddc8f4fcf6bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8754002973dcde8709458044e541ddc8f4fcf6bb You're receiving 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 Jun 8 22:58:16 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 08 Jun 2019 18:58:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: gitlab-ci: Disable shallow clones Message-ID: <5cfc3d881d30c_6f7ef6262014500be@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 6817c640 by Alexandre Baldé at 2019-06-08T22:58:12Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 943662c5 by Matthew Pickering at 2019-06-08T22:58:12Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 97ba5bf5 by Ben Gamari at 2019-06-08T22:58:12Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - 4 changed files: - .gitlab-ci.yml - hadrian/src/Settings/Default.hs - libraries/base/GHC/Base.hs - testsuite/tests/simplCore/should_compile/Makefile Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,6 +8,9 @@ variables: # .gitlab/win32-init.sh. WINDOWS_TOOLCHAIN_VERSION: 1 + # Disable shallow clones; they break our linting rules + GIT_DEPTH: 0 + before_script: - python3 .gitlab/fix-submodules.py - git submodule sync --recursive @@ -52,13 +55,7 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # Note [Unshallow clone for linting] - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # GitLab creates a shallow clone which means that we may not have the base - # commit of the MR being tested (e.g. if the MR is quite old), causing `git - # merge-base` to fail. Passing `--unshallow` to `git fetch` ensures that - # we have the entire history. - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) @@ -80,22 +77,14 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - # See Note [Unshallow clone for linting] - - git fetch --unshallow "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Linting changes between $base..$CI_COMMIT_SHA" + - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint -lint-submods: - extends: .lint-submods - only: - refs: - - master - - /ghc-[0-9]+\.[0-9]+/ - lint-submods-marge: extends: .lint-submods only: @@ -116,6 +105,16 @@ lint-submods-mr: variables: - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ +lint-submods-branch: + extends: .lint-submods + script: + - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) + only: + refs: + - master + - /ghc-[0-9]+\.[0-9]+/ + .lint-changelogs: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -179,7 +179,10 @@ sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault , getContextData hcOpts - , libraryPackage ? hsLibrary + -- `compiler` is also a library but the specific arguments that we want + -- to apply to that are given by the hsCompiler option. `ghc` is an + -- executable so we don't have to exclude that. + , libraryPackage ? notM (packageOneOf [compiler]) ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] ===================================== libraries/base/GHC/Base.hs ===================================== @@ -271,6 +271,9 @@ class Semigroup a => Monoid a where -- -- __NOTE__: This method is redundant and has the default -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. + -- Should it be implemented manually, since 'mappend' is a synonym for + -- ('<>'), it is expected that the two functions are defined the same + -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. mappend :: a -> a -> a mappend = (<>) {-# INLINE mappend #-} ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -106,11 +106,13 @@ T4903: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903a.hs -dcore-lint '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903.hs -dcore-lint +# N.B. Suppress ticks to ensure that the test result doesn't change if `base` +# is compiled with -g. See #16741. T4918: $(RM) -f T4918.hi T4918.o T4918a.hi T4918a.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918.hs - '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4918.hi | grep 'C#' + '$(TEST_HC)' $(TEST_HC_OPTS) -dsuppress-ticks --show-iface T4918.hi | grep 'C#' EvalTest: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O EvalTest.hs -ddump-simpl -dsuppress-uniques | grep 'rght.*Dmd' | sed 's/^ *//' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bb8bb1cf61a1eb10b7bfda3e9a8f37929c8d3df6...97ba5bf55882e2a6ca22cbae1c6526b3fdf9800b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bb8bb1cf61a1eb10b7bfda3e9a8f37929c8d3df6...97ba5bf55882e2a6ca22cbae1c6526b3fdf9800b You're receiving 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 Jun 9 11:33:49 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 09 Jun 2019 07:33:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/derive-functor Message-ID: <5cfcee9d4988b_6f73fe5f42f35b814830a6@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/derive-functor at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/derive-functor You're receiving 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 Jun 9 12:35:59 2019 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 09 Jun 2019 08:35:59 -0400 Subject: [Git][ghc/ghc][wip/derive-functor] Use DeriveFunctor throughout the codebase (#15654) Message-ID: <5cfcfd2f3e1fb_6f778b09781490799@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/derive-functor at Glasgow Haskell Compiler / GHC Commits: 4c44e323 by Krzysztof Gogolewski at 2019-06-09T12:35:50Z Use DeriveFunctor throughout the codebase (#15654) - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/prelude/PrelRules.hs - compiler/rename/RnPat.hs - compiler/simplCore/CoreMonad.hs - compiler/simplCore/SimplMonad.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgLint.hs - compiler/typecheck/TcCanonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c44e323e8ac0e28e87e93ab53cbf7eb21ac9c25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c44e323e8ac0e28e87e93ab53cbf7eb21ac9c25 You're receiving 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 Jun 9 13:34:36 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 09:34:36 -0400 Subject: [Git][ghc/ghc][wip/slowtest] testsuite: Mark T16737 as broken in ghci way due to #16541 Message-ID: <5cfd0aec108a2_6f73fe5f42f35b8150538f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 5c28e942 by Ben Gamari at 2019-06-09T13:34:18Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 1 changed file: - testsuite/tests/driver/all.T Changes: ===================================== testsuite/tests/driver/all.T ===================================== @@ -270,4 +270,6 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) -test('T16737', [extra_files(['T16737include/'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) +test('T16737', + [extra_files(['T16737include/']), expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-optP=-isystem -optP=T16737include']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5c28e942e76313ed16a09e48abc600996d740af9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5c28e942e76313ed16a09e48abc600996d740af9 You're receiving 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 Jun 9 13:40:20 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 09:40:20 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 2 commits: testsuite: Fix typo in flags of T7130 Message-ID: <5cfd0c44571a2_6f73fe5e15af12015067ea@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 0d771570 by Ben Gamari at 2019-06-09T13:38:10Z testsuite: Fix typo in flags of T7130 - - - - - 5ab3af39 by Ben Gamari at 2019-06-09T13:39:55Z testsuite: Rework T9963 to pass linter - - - - - 1 changed file: - testsuite/tests/driver/all.T Changes: ===================================== testsuite/tests/driver/all.T ===================================== @@ -170,7 +170,7 @@ test( 'T4114d', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_r test('T5584', [], makefile_test, []) test('T5198', [], makefile_test, []) test('T7060', [], makefile_test, []) -test('T7130', normal, compile_fail, ['-fflul-laziness']) +test('T7130', normal, compile_fail, ['-ffull-laziness']) test('T7563', when(unregisterised(), skip), makefile_test, []) test('T6037', # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X @@ -207,7 +207,7 @@ test('T9938', [], makefile_test, []) test('T9938B', [], makefile_test, []) test('T9963', exit_code(1), run_command, - ['{compiler} --interactive -ignore-dot-ghci --print-libdir']) + ['{compiler} --print-libdir']) test('T10219', normal, run_command, # `-x hspp` in make mode should work. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5c28e942e76313ed16a09e48abc600996d740af9...5ab3af39ae975b6482a3a0c518d51ebd1a53c18e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5c28e942e76313ed16a09e48abc600996d740af9...5ab3af39ae975b6482a3a0c518d51ebd1a53c18e You're receiving 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 Jun 9 14:06:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:06:44 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cfd127446acd_6f73fe5f442ec5c15155ae@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 48588385 by Ben Gamari at 2019-06-09T14:06:37Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the precence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. Specifically, ticks appearing in two places to defeat the rule: b. Surrounding the fold function a. Surrounding the inner application of `unpackFoldrCString#` The former caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,26 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , cheapEqExpr' tickishFloatable c1 c2 + , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1 + , c2Ticks <- stripTicksTopT tickishFloatable c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` mkTicks (c1Ticks ++ c2Ticks) c1' + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4858838591b5bd5d05663e001aadff4a6713e9e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4858838591b5bd5d05663e001aadff4a6713e9e8 You're receiving 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 Jun 9 14:08:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:08:32 -0400 Subject: [Git][ghc/ghc][wip/T16738] 5 commits: gitlab-ci: Fix submodule linting of commits Message-ID: <5cfd12e0bc16f_6f73fe6125954d815202a4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 54a61a85 by Ben Gamari at 2019-06-09T14:08:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 988c1c1f by Ben Gamari at 2019-06-09T14:08:25Z testsuite: Mark T16180 as broken in ghci way addForeignSource is currently not supported in GHCi. - - - - - e13091de by Ben Gamari at 2019-06-09T14:08:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 6 changed files: - .gitlab-ci.yml - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/th/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -79,19 +79,12 @@ ghc-linters: script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Linting changes between $base..$CI_COMMIT_SHA" + - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint -lint-submods: - extends: .lint-submods - only: - refs: - - master - - /ghc-[0-9]+\.[0-9]+/ - lint-submods-marge: extends: .lint-submods only: @@ -112,6 +105,16 @@ lint-submods-mr: variables: - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ +lint-submods-branch: + extends: .lint-submods + script: + - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) + only: + refs: + - master + - /ghc-[0-9]+\.[0-9]+/ + .lint-changelogs: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)") , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)") , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)") , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)") , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@) @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@) @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@) @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -35,7 +35,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/th/all.T ===================================== @@ -467,7 +467,7 @@ test('T15437', expect_broken(15437), multimod_compile, test('T15985', normal, compile, ['']) test('T16133', normal, compile_fail, ['']) test('T15471', normal, multimod_compile, ['T15471.hs', '-v0']) -test('T16180', normal, compile_and_run, ['']) +test('T16180', expect_broken_for(16743, ['ghci']), compile_and_run, ['']) test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0f4169ae350ebd5514855c3756f55d574fef2a6b...e13091deaff093461d18e049c8eb2e87fc804436 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/0f4169ae350ebd5514855c3756f55d574fef2a6b...e13091deaff093461d18e049c8eb2e87fc804436 You're receiving 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 Jun 9 14:15:58 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:15:58 -0400 Subject: [Git][ghc/ghc][wip/T16738] Maintain separate flags for C++ compiler invocations Message-ID: <5cfd149eeca00_6f73fe608404484152141f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16738 at Glasgow Haskell Compiler / GHC Commits: f233d568 by Ben Gamari at 2019-06-09T14:05:58Z Maintain separate flags for C++ compiler invocations Previously we would pass flags intended for the C compiler to the C++ compiler (see #16738). This would cause, for instance, `-std=gnu99` to be passed to the C++ compiler, causing spurious test failures. Fix this by maintaining a separate set of flags for C++ compilation invocations. - - - - - 13 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Info.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - 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 ===================================== @@ -511,6 +511,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand="$(basename $CC)" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" @@ -564,6 +565,7 @@ AC_DEFUN([FP_SETTINGS], SettingsOptCommand="$OptCmd" fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" @@ -571,6 +573,7 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP. - let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) + let all_paths = let paths = takeDirectory (pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ] ===================================== compiler/main/DynFlags.hs ===================================== @@ -1420,7 +1420,7 @@ pgm_P :: DynFlags -> (String,[Option]) pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags pgm_F :: DynFlags -> String pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags -pgm_c :: DynFlags -> (String,[Option]) +pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags @@ -3048,7 +3048,7 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f } , make_ord_flag defFlag "pgmc" $ hasArg $ \f -> alterToolSettings $ \s -> s - { toolSettings_pgm_c = (f,[]) + { toolSettings_pgm_c = f , -- Don't pass -no-pie with -pgmc -- (see #15319) toolSettings_ccSupportsNoPie = False ===================================== compiler/main/Settings.hs ===================================== @@ -119,7 +119,7 @@ sPgm_P :: Settings -> (String, [Option]) sPgm_P = toolSettings_pgm_P . sToolSettings sPgm_F :: Settings -> String sPgm_F = toolSettings_pgm_F . sToolSettings -sPgm_c :: Settings -> (String, [Option]) +sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings ===================================== compiler/main/SysTools.hs ===================================== @@ -194,17 +194,18 @@ initSysTools top_dir -- It would perhaps be nice to be able to override this -- with the settings file, but it would be a little fiddly -- to make that possible, so for now you can't. - gcc_prog <- getToolSetting "C compiler command" - gcc_args_str <- getSetting "C compiler flags" + cc_prog <- getToolSetting "C compiler command" + cc_args_str <- getSetting "C compiler flags" + cxx_args_str <- getSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" cpp_prog <- getToolSetting "Haskell CPP command" cpp_args_str <- getSetting "Haskell CPP flags" - let unreg_gcc_args = if targetUnregisterised - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cpp_args= map Option (words cpp_args_str) - gcc_args = map Option (words gcc_args_str - ++ unreg_gcc_args) + let unreg_cc_args = if targetUnregisterised + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cpp_args = map Option (words cpp_args_str) + cc_args = words cc_args_str ++ unreg_cc_args + cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" @@ -236,11 +237,11 @@ initSysTools top_dir -- Other things being equal, as and ld are simply gcc - gcc_link_args_str <- getSetting "C compiler link flags" - let as_prog = gcc_prog - as_args = gcc_args - ld_prog = gcc_prog - ld_args = gcc_args ++ map Option (words gcc_link_args_str) + cc_link_args_str <- getSetting "C compiler link flags" + let as_prog = cc_prog + as_args = map Option cc_args + ld_prog = cc_prog + ld_args = map Option (cc_args ++ words cc_link_args_str) -- We just assume on command line lc_prog <- getSetting "LLVM llc command" @@ -308,7 +309,7 @@ initSysTools top_dir , toolSettings_pgm_L = unlit_path , toolSettings_pgm_P = (cpp_prog, cpp_args) , toolSettings_pgm_F = "" - , toolSettings_pgm_c = (gcc_prog, gcc_args) + , toolSettings_pgm_c = cc_prog , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) @@ -325,8 +326,8 @@ initSysTools top_dir , toolSettings_opt_P = [] , toolSettings_opt_P_fingerprint = fingerprint0 , toolSettings_opt_F = [] - , toolSettings_opt_c = [] - , toolSettings_opt_cxx = [] + , toolSettings_opt_c = cc_args + , toolSettings_opt_cxx = cxx_args , toolSettings_opt_a = [] , toolSettings_opt_l = [] , toolSettings_opt_windres = [] ===================================== compiler/main/SysTools/Info.hs ===================================== @@ -219,7 +219,7 @@ getCompilerInfo dflags = do -- See Note [Run-time linker info]. getCompilerInfo' :: DynFlags -> IO CompilerInfo getCompilerInfo' dflags = do - let (pgm,_) = pgm_c dflags + let pgm = pgm_c dflags -- Try to grab the info from the process output. parseCompilerInfo _stdo stde _exitc -- Regular GCC ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -62,9 +62,9 @@ runPp dflags args = do -- | Run compiler of C-like languages and raw objects (such as gcc or clang). runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO () runCc mLanguage dflags args = do - let (p,args0) = pgm_c dflags + let p = pgm_c dflags args1 = map Option userOpts - args2 = args0 ++ languageOptions ++ args ++ args1 + args2 = languageOptions ++ args ++ args1 -- We take care to pass -optc flags in args1 last to ensure that the -- user can override flags passed by GHC. See #14452. mb_env <- getGccEnv args2 @@ -126,12 +126,16 @@ runCc mLanguage dflags args = do -- -x c option. (languageOptions, userOpts) = case mLanguage of Nothing -> ([], userOpts_c) - Just language -> ([Option "-x", Option languageName], opts) where - (languageName, opts) = case language of - LangCxx -> ("c++", userOpts_cxx) - LangObjc -> ("objective-c", userOpts_c) - LangObjcxx -> ("objective-c++", userOpts_cxx) - _ -> ("c", userOpts_c) + Just language -> ([Option "-x", Option languageName], opts) + where + s = settings dflags + (languageName, opts) = case language of + LangC -> ("c", sOpt_c s ++ userOpts_c) + LangCxx -> ("c++", sOpt_cxx s ++ userOpts_cxx) + LangObjc -> ("objective-c", userOpts_c) + LangObjcxx -> ("objective-c++", userOpts_cxx) + LangAsm -> ("assembler", []) + RawObject -> ("c", []) -- claim C for lack of a better idea userOpts_c = getOpts dflags opt_c userOpts_cxx = getOpts dflags opt_cxx @@ -333,7 +337,8 @@ runMkDLL dflags args = do runWindres :: DynFlags -> [Option] -> IO () runWindres dflags args = do - let (gcc, gcc_args) = pgm_c dflags + let cc = pgm_c dflags + cc_args = map Option (sOpt_c (settings dflags)) windres = pgm_windres dflags opts = map Option (getOpts dflags opt_windres) quote x = "\"" ++ x ++ "\"" @@ -341,8 +346,7 @@ runWindres dflags args = do -- spaces then windres fails to run gcc. We therefore need -- to tell it what command to use... Option ("--preprocessor=" ++ - unwords (map quote (gcc : - map showOpt gcc_args ++ + unwords (map quote (cc : map showOpt opts ++ ["-E", "-xc", "-DRC_INVOKED"]))) -- ...but if we do that then if windres calls popen then @@ -351,7 +355,7 @@ runWindres dflags args = do -- See #1828. : Option "--use-temp-file" : args - mb_env <- getGccEnv gcc_args + mb_env <- getGccEnv cc_args runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env touch :: DynFlags -> String -> String -> IO () ===================================== compiler/main/ToolSettings.hs ===================================== @@ -22,7 +22,7 @@ data ToolSettings = ToolSettings , toolSettings_pgm_L :: String , toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: (String, [Option]) + , toolSettings_pgm_c :: String , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_dll :: (String, [Option]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -126,6 +126,7 @@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ +settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ settings-ld-command = @SettingsLdCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -88,6 +88,7 @@ data SettingsFileSetting | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags + | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie | SettingsFileSetting_LdCommand @@ -162,6 +163,7 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" + SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" SettingsFileSetting_LdCommand -> "settings-ld-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -277,6 +277,7 @@ generateSettings = do [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts") , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) + , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) ===================================== includes/ghc.mk ===================================== @@ -179,6 +179,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ + @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -510,6 +510,7 @@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ SettingsLdCommand = @SettingsLdCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f233d56809e941d282840b65552d1719844dca0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f233d56809e941d282840b65552d1719844dca0d You're receiving 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 Jun 9 14:17:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:17:38 -0400 Subject: [Git][ghc/ghc][wip/slowtest] Fix uses of #ifdef/#ifndef Message-ID: <5cfd15023278_6f73fe5e018a4d8152249@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 852c0671 by Ben Gamari at 2019-06-09T14:17:30Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 3 changed files: - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk Changes: ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)") , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)") , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)") , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)") , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@) @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@) @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@) @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/852c0671308c4acafc5fff43d2e898296609af36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/852c0671308c4acafc5fff43d2e898296609af36 You're receiving 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 Jun 9 14:17:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:17:53 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 26 commits: gitlab-ci: Fix submodule linting of commits Message-ID: <5cfd1511e378b_6f73fe5e079754c15230a7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 01bc6337 by Ben Gamari at 2019-06-09T14:17:45Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 2176f158 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 8cbf267d by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Make closureSize less sensitive to optimisation - - - - - a6d479c7 by Ben Gamari at 2019-06-09T14:17:45Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 58883944 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - aa5d6cbf by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - dbbb6eb5 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - a7887679 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 33dd75c9 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 00d4cd4e by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 9a55a06d by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 9207e92d by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 009d1f62 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - d7e29363 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Fix fragile_for test modifier - - - - - b112a914 by Ben Gamari at 2019-06-09T14:17:45Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 192357de by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - a203e0ba by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - f1fd85c6 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 4b01f803 by Ben Gamari at 2019-06-09T14:17:45Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 13f84463 by Ben Gamari at 2019-06-09T14:17:46Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 043f1019 by Ben Gamari at 2019-06-09T14:17:46Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 0f26ae4b by Ben Gamari at 2019-06-09T14:17:46Z testsuite: Fix typo in flags of T7130 - - - - - 18db063d by Ben Gamari at 2019-06-09T14:17:46Z testsuite: Rework T9963 to pass linter - - - - - e1976c17 by Ben Gamari at 2019-06-09T14:17:46Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 24 changed files: - .gitlab-ci.yml - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - libraries/process - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/rts/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -79,19 +79,12 @@ ghc-linters: script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Linting changes between $base..$CI_COMMIT_SHA" + - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint -lint-submods: - extends: .lint-submods - only: - refs: - - master - - /ghc-[0-9]+\.[0-9]+/ - lint-submods-marge: extends: .lint-submods only: @@ -112,6 +105,16 @@ lint-submods-mr: variables: - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ +lint-submods-branch: + extends: .lint-submods + script: + - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) + only: + refs: + - master + - /ghc-[0-9]+\.[0-9]+/ + .lint-changelogs: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" @@ -460,6 +463,7 @@ validate-x86_64-linux-deb9-debug: stage: build variables: BUILD_FLAVOUR: validate + TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" validate-x86_64-linux-deb9-llvm: ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)") , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)") , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)") , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)") , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@) @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@) @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@) @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ ===================================== libraries/base/tests/all.T ===================================== @@ -203,7 +203,7 @@ test('T8089', compile_and_run, ['']) test('hWaitForInput-accurate-socket', reqlib('unix'), compile_and_run, ['']) test('T8684', expect_broken(8684), compile_and_run, ['']) -test('hWaitForInput-accurate-stdin', normal, compile_and_run, ['']) +test('hWaitForInput-accurate-stdin', [expect_broken_for(16535, ['threaded1', 'threaded2']), omit_ways(['ghci'])], compile_and_run, ['']) test('hWaitForInput-accurate-pipe', reqlib('unix'), compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', @@ -234,6 +234,6 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) test('T16111', exit_code(1), compile_and_run, ['']) ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -7,5 +7,5 @@ test('heap_all', ], compile_and_run, ['']) test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [omit_ways(['ghci', 'hpc', 'prof']), expect_broken_for(16544, ['dyn', 'optasm', 'threaded2'])], compile_and_run, ['']) ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} import Control.Monad import Type.Reflection @@ -17,12 +18,17 @@ assertSize !x expected = do putStrLn $ prettyCallStack callStack {-# NOINLINE assertSize #-} -pap :: Int -> Char -> Int +pap :: Int -> Maybe Char -> Int pap x _ = x {-# NOINLINE pap #-} main :: IO () main = do + -- Ensure that GHC can't turn PAP into a FUN (see #16531) + let x :: Int + x = 42 + {-# NOINLINE x #-} + assertSize 'a' 2 assertSize (Just ()) 2 assertSize (Nothing :: Maybe ()) 2 @@ -30,5 +36,5 @@ main = do assertSize ((1,2,3) :: (Int,Int,Int)) 4 assertSize (id :: Int -> Int) 1 assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + assertSize (pap x) 2 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 5c81524694ceaf8523a1846718a7a7c3f402124f ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit a67b5e9e70a2a0c438d4f186fda9f38409ff1435 ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,8 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + assert ways.__class__ is list + opts.omit_ways += ways # ----- @@ -1432,7 +1433,6 @@ def simple_run(name, way, prog, extra_run_opts): return failBecause('bad stderr') if not (opts.ignore_stdout or stdout_ok(name, way)): return failBecause('bad stdout') - check_hp = '-h' in my_rts_flags and opts.check_hp check_prof = '-p' in my_rts_flags ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,4 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -88,7 +88,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) @@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, ['']) # omit threaded2, the behaviour of this test is non-deterministic with more # than one CPU. -test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) +test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -40,7 +40,7 @@ test('T12742', normal, compile, ['']) # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T13910', omit_ways(['profasm']), compile, ['']) +test('T13910', [expect_broken_for(16537, ['optasm']), omit_ways(['profasm'])], compile, ['']) test('T13938', [extra_files(['T13938a.hs'])], makefile_test, ['T13938']) test('T14556', normal, compile, ['']) test('T14720', normal, compile, ['']) ===================================== testsuite/tests/driver/all.T ===================================== @@ -170,7 +170,7 @@ test( 'T4114d', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_r test('T5584', [], makefile_test, []) test('T5198', [], makefile_test, []) test('T7060', [], makefile_test, []) -test('T7130', normal, compile_fail, ['-fflul-laziness']) +test('T7130', normal, compile_fail, ['-ffull-laziness']) test('T7563', when(unregisterised(), skip), makefile_test, []) test('T6037', # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X @@ -207,7 +207,7 @@ test('T9938', [], makefile_test, []) test('T9938B', [], makefile_test, []) test('T9963', exit_code(1), run_command, - ['{compiler} --interactive -ignore-dot-ghci --print-libdir']) + ['{compiler} --print-libdir']) test('T10219', normal, run_command, # `-x hspp` in make mode should work. @@ -270,4 +270,6 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) -test('T16737', [extra_files(['T16737include/'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) +test('T16737', + [extra_files(['T16737include/']), expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-optP=-isystem -optP=T16737include']) ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -35,7 +35,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -207,4 +207,4 @@ test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c' test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) -test('T493', [], compile_and_run, ['T493_c.c']) +test('T493', [omit_ways(['ghci'])], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -1,8 +1,8 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples -test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) -test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, ['']) +test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, ['']) +test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) ===================================== testsuite/tests/programs/barton-mangler-bug/test.T ===================================== @@ -8,7 +8,7 @@ test('barton-mangler-bug', 'Plot.hi', 'Plot.o', 'PlotExample.hi', 'PlotExample.o', 'TypesettingTricks.hi', 'TypesettingTricks.o']), - omit_ways('debug') # Fails for debug way due to annotation linting timeout + omit_ways(['debug']) # Fails for debug way due to annotation linting timeout ], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -73,7 +73,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 test('T2783', [ omit_ways(['ghci']), exit_code(1) - , expect_broken_for(2783, ['threaded1']) + , fragile_for(2783, ['threaded1']) ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in @@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']), # run this test with very small stack chunks to exercise the stack # overflow/underflow machinery. -test('stack003', [ omit_ways('ghci'), # uses unboxed tuples +test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) @@ -214,7 +214,8 @@ test('T7815', [ multi_cpu_race, test('ffishutdown', [ignore_stderr, only_ways(['threaded1','threaded2'])], compile_and_run, ['']) -test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run, +# Times out in ghci way +test('T7919', [when(fast(), skip), omit_ways(['ghci'] + prof_ways)], compile_and_run, [config.ghc_th_way_flags]) test('T8035', normal, compile_and_run, ['']) ===================================== testsuite/tests/th/all.T ===================================== @@ -13,7 +13,7 @@ if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) setTestOpts(only_ways(['normal','ghci','ext-interp'])) -broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] +broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T16180","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] # ext-interp, integer-gmp and llvm is broken see #16087 def broken_ext_interp(name, opts): if name in broken_tests and config.ghc_built_by_llvm: @@ -467,7 +467,10 @@ test('T15437', expect_broken(15437), multimod_compile, test('T15985', normal, compile, ['']) test('T16133', normal, compile_fail, ['']) test('T15471', normal, multimod_compile, ['T15471.hs', '-v0']) -test('T16180', normal, compile_and_run, ['']) +test('T16180', + [when(llvm_build(), expect_broken_for(16541, ['ext-interp'])), + expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-package ghc']) test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -659,7 +659,7 @@ test('T15586', normal, compile, ['']) test('T15368', normal, compile, ['-fdefer-type-errors']) test('T15645', normal, compile, ['-Wwarn=missing-monadfail-instances']) test('T15778', normal, compile, ['']) -test('T14761c', normal, compile, ['']) +test('T14761c', expect_broken_for(16540, ['hpc', 'optasm']), compile, ['']) test('T16008', normal, compile, ['']) test('T16033', normal, compile, ['']) test('T16141', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -35,7 +35,7 @@ test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) test('tcrun021', normal, compile_and_run, ['-package containers']) -test('tcrun022', omit_ways(['ghci']), compile_and_run, ['-O']) +test('tcrun022', omit_ways(['hpc', 'ghci']), compile_and_run, ['-O']) test('tcrun023', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O']) test('tcrun024', normal, compile_and_run, ['-O']) @@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, ['']) +test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcTypeSymbolSimpleRun', normal, compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) ===================================== testsuite/tests/utils/should_run/all.T ===================================== @@ -1,6 +1,6 @@ test('T14854', [only_ways(threaded_ways), - omit_ways('ghci'), + omit_ways(['ghci']), reqlib('random'), ignore_stderr], compile_and_run, ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -26,4 +26,4 @@ test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T1655 test('StarBinder', normal, compile, ['']) -test('Overflow', normal, compile, ['']) +test('Overflow', expect_broken_for(16543, ['hpc']), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/852c0671308c4acafc5fff43d2e898296609af36...e1976c17127a1bb39b58cacad4593ddaa0c02a0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/852c0671308c4acafc5fff43d2e898296609af36...e1976c17127a1bb39b58cacad4593ddaa0c02a0d You're receiving 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 Jun 9 14:38:18 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:38:18 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 2 commits: Fix uses of #ifdef/#ifndef Message-ID: <5cfd19da67f6f_6f73fe5f442ec5c152846b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 158377d0 by Ben Gamari at 2019-06-09T14:38:11Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - dc663608 by Ben Gamari at 2019-06-09T14:38:11Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 5 changed files: - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk Changes: ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,7 +12,8 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.", + path_filter = lambda path: path == 'Makefile') ] if __name__ == '__main__': ===================================== .gitlab/linters/linter.py ===================================== @@ -73,13 +73,14 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex, message, path_filter=lambda path: True): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message + self.path_filter = path_filter def lint_line(self, path, line_no, line): - if self.re.search(line): + if self.path_filter(path) and self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)") , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)") , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)") , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)") , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@) @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@) @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@) @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1976c17127a1bb39b58cacad4593ddaa0c02a0d...dc663608d5ae43036a4bfbcfe30eab65c307dad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1976c17127a1bb39b58cacad4593ddaa0c02a0d...dc663608d5ae43036a4bfbcfe30eab65c307dad7 You're receiving 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 Jun 9 14:44:00 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:44:00 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 10 commits: Bump unix submodule Message-ID: <5cfd1b30da357_6f73fe60840448415312a8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 6a22056e by Ben Gamari at 2019-06-09T14:43:52Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - aab7517d by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - b967b91b by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 03b03fe9 by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 27448d82 by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 3cd9488e by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 2ce39c58 by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - f48ca831 by Ben Gamari at 2019-06-09T14:43:52Z testsuite: Fix typo in flags of T7130 - - - - - 8a65b80e by Ben Gamari at 2019-06-09T14:43:52Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0d999cbb by Ben Gamari at 2019-06-09T14:43:52Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 17 changed files: - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/rts/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T Changes: ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,7 +12,8 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.", + path_filter = lambda path: path == 'Makefile') ] if __name__ == '__main__': ===================================== .gitlab/linters/linter.py ===================================== @@ -73,13 +73,14 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex, message, path_filter=lambda path: True): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message + self.path_filter = path_filter def lint_line(self, path, line_no, line): - if self.re.search(line): + if self.path_filter(path) and self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)") , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)") , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)") , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)") , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@) @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@) @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@) @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit 167d9ae32ed82ab2b54b4aeaf0cae564015635da ===================================== testsuite/driver/testlib.py ===================================== @@ -274,6 +274,7 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): + assert ways.__class__ is list opts.omit_ways += ways # ----- ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -195,4 +195,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -88,7 +88,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) @@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, ['']) # omit threaded2, the behaviour of this test is non-deterministic with more # than one CPU. -test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) +test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), ===================================== testsuite/tests/driver/all.T ===================================== @@ -170,7 +170,7 @@ test( 'T4114d', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_r test('T5584', [], makefile_test, []) test('T5198', [], makefile_test, []) test('T7060', [], makefile_test, []) -test('T7130', normal, compile_fail, ['-fflul-laziness']) +test('T7130', normal, compile_fail, ['-ffull-laziness']) test('T7563', when(unregisterised(), skip), makefile_test, []) test('T6037', # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X @@ -270,4 +270,6 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) -test('T16737', [extra_files(['T16737include/'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) +test('T16737', + [extra_files(['T16737include/']), expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-optP=-isystem -optP=T16737include']) ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -35,7 +35,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -207,4 +207,4 @@ test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c' test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) -test('T493', [], compile_and_run, ['T493_c.c']) +test('T493', [omit_ways(['ghci'])], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -1,8 +1,8 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples -test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) -test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, ['']) +test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, ['']) +test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) ===================================== testsuite/tests/programs/barton-mangler-bug/test.T ===================================== @@ -8,7 +8,7 @@ test('barton-mangler-bug', 'Plot.hi', 'Plot.o', 'PlotExample.hi', 'PlotExample.o', 'TypesettingTricks.hi', 'TypesettingTricks.o']), - omit_ways('debug') # Fails for debug way due to annotation linting timeout + omit_ways(['debug']) # Fails for debug way due to annotation linting timeout ], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']), # run this test with very small stack chunks to exercise the stack # overflow/underflow machinery. -test('stack003', [ omit_ways('ghci'), # uses unboxed tuples +test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, ['']) +test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcTypeSymbolSimpleRun', normal, compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) ===================================== testsuite/tests/utils/should_run/all.T ===================================== @@ -1,6 +1,6 @@ test('T14854', [only_ways(threaded_ways), - omit_ways('ghci'), + omit_ways(['ghci']), reqlib('random'), ignore_stderr], compile_and_run, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc663608d5ae43036a4bfbcfe30eab65c307dad7...0d999cbbf6276542c9d76010a85dda5a1459be0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dc663608d5ae43036a4bfbcfe30eab65c307dad7...0d999cbbf6276542c9d76010a85dda5a1459be0c You're receiving 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 Jun 9 14:49:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:49:44 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] 15 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfd1c8857944_6f778b0978153206b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - d882c74f by Ben Gamari at 2019-06-09T14:49:14Z testsuite: Skip dynamicToo006 when dynamic linking is not available This was previously failling on Windows. - - - - - 1eb57514 by Ben Gamari at 2019-06-09T14:49:33Z testsuite: Mark T3372 as fragile on Windows On Windows we must lock package databases even when opening for read-only access. This means that concurrent GHC sessions are very likely to fail with file lock contention. See #16773. - - - - - 2a8c28c9 by Ben Gamari at 2019-06-09T14:49:36Z testsuite: Add stderr output for UnsafeInfered02 on Windows This test uses TemplateHaskell causing GHC to build dynamic objects on platforms where dynamic linking is available. However, Windows doesn't support dynamic linking. Consequently the test would fail on Windows with: ```patch --- safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.stderr.normalised 2019-06-04 15:10:10.521594200 +0000 +++ safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.comp.stderr.normalised 2019-06-04 15:10:10.523546200 +0000 @@ -1,5 +1,5 @@ -[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o, UnsafeInfered02_A.dyn_o ) -[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o, UnsafeInfered02.dyn_o ) +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) UnsafeInfered02.hs:4:1: UnsafeInfered02_A: Can't be safely imported! ``` The other approach I considered for this issue is to pass `-v0` to GHC. However, I felt we should probably do this consistently for all of the tests in this directory and this would take more time than I currently have. - - - - - fa6a0a05 by Ben Gamari at 2019-06-09T14:49:36Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 51226024 by Ben Gamari at 2019-06-09T14:49:36Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - 14 changed files: - .gitlab-ci.yml - compiler/cmm/MkGraph.hs - compiler/codeGen/StgCmmForeign.hs - compiler/ghci/LinkerTypes.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs - libraries/ghc-boot/GHC/PackageDb.hs - rts/linker/MachO.c - testsuite/tests/driver/dynamicToo/dynamicToo006/all.T - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/ghci/linking/dyn/all.T - + testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr-mingw32 Changes: ===================================== .gitlab-ci.yml ===================================== @@ -8,6 +8,9 @@ variables: # .gitlab/win32-init.sh. WINDOWS_TOOLCHAIN_VERSION: 1 + # Disable shallow clones; they break our linting rules + GIT_DEPTH: 0 + before_script: - python3 .gitlab/fix-submodules.py - git submodule sync --recursive @@ -49,13 +52,12 @@ stages: ############################################################ ghc-linters: - allow_failure: true stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - - "echo Merge base $base" + - "echo Linting changes between $base..$CI_COMMIT_SHA" # - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA) - validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA) - .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA @@ -75,18 +77,14 @@ ghc-linters: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: + - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" + - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint -lint-submods: - extends: .lint-submods - only: - refs: - - master - - /ghc-[0-9]+\.[0-9]+/ - lint-submods-marge: extends: .lint-submods only: @@ -97,10 +95,25 @@ lint-submods-marge: lint-submods-mr: extends: .lint-submods + # Allow failure since any necessary submodule patches may not be upstreamed + # yet. allow_failure: true only: refs: - merge_requests + except: + variables: + - $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/ + +lint-submods-branch: + extends: .lint-submods + script: + - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) + only: + refs: + - master + - /ghc-[0-9]+\.[0-9]+/ .lint-changelogs: stage: lint @@ -117,6 +130,7 @@ lint-submods-mr: lint-changelogs: extends: .lint-changelogs + # Allow failure since this isn't a final release. allow_failure: true only: refs: @@ -640,8 +654,6 @@ nightly-i386-windows-hadrian: .build-windows-make: extends: .build-windows stage: full-build - # due to #16084 - allow_failure: true variables: BUILD_FLAVOUR: "quick" GHC_VERSION: "8.6.5" ===================================== compiler/cmm/MkGraph.hs ===================================== @@ -335,8 +335,8 @@ copyIn dflags conv area formals extra_stk local = CmmLocal reg width = cmmRegWidth dflags local expr = CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [stack_slot] - in CmmAssign local expr - + in CmmAssign local expr + | otherwise = CmmAssign (CmmLocal reg) (CmmLoad (CmmStackSlot area off) ty) where ty = localRegType reg ===================================== compiler/codeGen/StgCmmForeign.hs ===================================== @@ -526,7 +526,7 @@ closureField dflags off = off + fixedHdrSize dflags -- demonstrated that this leads to bad behavior in the presence -- of unsafeCoerce#. Returning to the above example, suppose the -- Haskell call looked like --- foo (unsafeCoerce# p) +-- foo (unsafeCoerce# p) -- where the types of expressions comprising the arguments are -- p :: (Any :: TYPE 'UnliftedRep) -- i :: Int# @@ -591,7 +591,7 @@ add_shim dflags ty expr = case ty of -- the offset of each argument when used as a C FFI argument. -- See Note [Unlifted boxed arguments to foreign calls] collectStgFArgTypes :: Type -> [StgFArgType] -collectStgFArgTypes = go [] +collectStgFArgTypes = go [] where -- Skip foralls go bs (ForAllTy _ res) = go bs res ===================================== compiler/ghci/LinkerTypes.hs ===================================== @@ -28,7 +28,7 @@ import NameEnv ( NameEnv ) import Name ( Name ) import GHCi.RemoteTypes ( ForeignHValue ) -type ClosureEnv = NameEnv (Name, ForeignHValue) +type ClosureEnv = NameEnv (Name, ForeignHValue) newtype DynLinker = DynLinker { dl_mpls :: MVar (Maybe PersistentLinkerState) } ===================================== compiler/main/HscTypes.hs ===================================== @@ -443,7 +443,7 @@ data HscEnv -- time it is needed. , hsc_dynLinker :: DynLinker - -- ^ dynamic linker. + -- ^ dynamic linker. } ===================================== compiler/main/Packages.hs ===================================== @@ -1470,8 +1470,8 @@ mkPackageState dflags dbs preload0 = do _ -> unit' addIfMorePreferable m unit = addToUDFM_C preferLater m (fsPackageName unit) unit -- This is the set of maximally preferable packages. In fact, it is a set of - -- most preferable *units* keyed by package name, which act as stand-ins in - -- for "a package in a database". We use units here because we don't have + -- most preferable *units* keyed by package name, which act as stand-ins in + -- for "a package in a database". We use units here because we don't have -- "a package in a database" as a type currently. mostPreferablePackageReps = if gopt Opt_HideAllPackages dflags then emptyUDFM @@ -1481,7 +1481,7 @@ mkPackageState dflags dbs preload0 = do -- with the most preferable unit for package. Being equi-preferable means that -- they must be in the same database, with the same version, and the same pacakge name. -- - -- We must take care to consider all these units and not just the most + -- We must take care to consider all these units and not just the most -- preferable one, otherwise we can end up with problems like #16228. mostPreferable u = case lookupUDFM mostPreferablePackageReps (fsPackageName u) of ===================================== compiler/specialise/Specialise.hs ===================================== @@ -938,7 +938,7 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn | otherwise = return () where allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - doWarn reason = + doWarn reason = warnMsg reason (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) ===================================== compiler/stgSyn/StgSyn.hs ===================================== @@ -686,7 +686,7 @@ data StgOp | StgPrimCallOp PrimCall - | StgFCallOp ForeignCall Type Unique + | StgFCallOp ForeignCall Type Unique -- The Unique is occasionally needed by the C pretty-printer -- (which lacks a unique supply), notably when generating a -- typedef for foreign-export-dynamic. The Type, which is ===================================== libraries/ghc-boot/GHC/PackageDb.hs ===================================== @@ -387,6 +387,8 @@ decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock) decodeFromFile file mode decoder = case mode of DbOpenReadOnly -> do + -- Note [Locking package database on Windows] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- When we open the package db in read only mode, there is no need to acquire -- shared lock on non-Windows platform because we update the database with an -- atomic rename, so readers will always see the database in a consistent ===================================== rts/linker/MachO.c ===================================== @@ -1220,7 +1220,7 @@ ocGetNames_MachO(ObjectCode* oc) IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", oc->n_sections)); -#if defined (ios_HOST_OS) +#if defined(ios_HOST_OS) for(int i=0; i < oc->n_sections; i++) { MachOSection * section = &oc->info->macho_sections[i]; @@ -1645,7 +1645,7 @@ ocResolve_MachO(ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); -#if defined aarch64_HOST_ARCH +#if defined(aarch64_HOST_ARCH) if (!relocateSectionAarch64(oc, &oc->sections[i])) return 0; #else ===================================== testsuite/tests/driver/dynamicToo/dynamicToo006/all.T ===================================== @@ -1,2 +1,3 @@ -test('dynamicToo006', [normalise_slashes, extra_files(['Main.hs'])], +test('dynamicToo006', + [normalise_slashes, extra_files(['Main.hs']), unless(have_dynamic(), skip)], run_command, ['$MAKE -s main --no-print-director']) ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -9,6 +9,7 @@ test('PartialDownsweep', test('OldModLocation', [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('mingw32'), expect_broken(16772)) ], compile_and_run, ['-package ghc']) ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -45,5 +45,11 @@ test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['big-obj']) -test('T3372', [unless(doing_ghci, skip), extra_run_opts('"' + config.libdir + '"')], +test('T3372', + [unless(doing_ghci, skip), + extra_run_opts('"' + config.libdir + '"'), + # Concurrent GHC sessions is fragile on Windows since we must lock the + # package database even for read-only access. + # See Note [Locking package database on Windows] in GHC.PackageDb + when(opsys('mingw32'), fragile(16773))], compile_and_run, ['-package ghc']) ===================================== testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr-mingw32 ===================================== @@ -0,0 +1,7 @@ +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) + +UnsafeInfered02.hs:4:1: error: + UnsafeInfered02_A: Can't be safely imported! + The module itself isn't safe. + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dbf6998290783650558623cd30370807aa3dce94...51226024b2004304f4eac921e2aef72eaa501114 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/dbf6998290783650558623cd30370807aa3dce94...51226024b2004304f4eac921e2aef72eaa501114 You're receiving 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 Jun 9 14:57:49 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 10:57:49 -0400 Subject: [Git][ghc/ghc][wip/closure-size] ghc-heap: Add closure_size_noopt test Message-ID: <5cfd1e6ddb143_6f73fe5e018a4d81533134@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: 8f9f6874 by Ben Gamari at 2019-06-09T14:56:32Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4 changed files: - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs Changes: ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,34 @@ +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import GHC.Exts.Heap.Closures + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -5,11 +5,22 @@ test('heap_all', omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - [ when(have_profiling(), extra_ways(['prof'])), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['hpc']) ], compile_and_run, ['']) +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], + compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -12,42 +12,7 @@ import Type.Reflection import GHC.Exts import GHC.Stack import GHC.IO - -import GHC.Exts.Heap.Closures - -assertSize - :: forall a. (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSize x = - assertSizeBox (asBox x) (typeRep @a) - -assertSizeUnlifted - :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSizeUnlifted x = - assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) - -assertSizeBox - :: forall a. (HasCallStack) - => Box -- ^ closure - -> TypeRep a - -> Int -- ^ expected size in words - -> IO () -assertSizeBox x ty expected = do - let !size = closureSize x - when (size /= expected') $ do - putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' - putStrLn $ prettyCallStack callStack - where expected' = expected + profHeaderSize -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} +import ClosureSizeUtils profHeaderSize :: Int #if PROFILING @@ -72,12 +37,6 @@ main = do assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - -- These depend too much upon the behavior of the simplifier to - -- test reliably. - --assertSize (id :: Int -> Int) 1 - --assertSize (fst :: (Int,Int) -> Int) 1 - --assertSize (pap 1) 2 - MA ma <- IO $ \s -> case newArray# 0# 0 s of (# s1, x #) -> (# s1, MA x #) ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8f9f687497c39179bf4c88f2e41433d25adb482f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8f9f687497c39179bf4c88f2e41433d25adb482f You're receiving 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 Jun 9 15:48:36 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 11:48:36 -0400 Subject: [Git][ghc/ghc][master] Explain that 'mappend' and '(<>)' should be the same [skip ci] Message-ID: <5cfd2a544f0a6_6f73fe5e15af1201542891@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 1 changed file: - libraries/base/GHC/Base.hs Changes: ===================================== libraries/base/GHC/Base.hs ===================================== @@ -271,6 +271,9 @@ class Semigroup a => Monoid a where -- -- __NOTE__: This method is redundant and has the default -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. + -- Should it be implemented manually, since 'mappend' is a synonym for + -- ('<>'), it is expected that the two functions are defined the same + -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. mappend :: a -> a -> a mappend = (<>) {-# INLINE mappend #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0462b0e02d8759983484eb09d0ba1be134ec592e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0462b0e02d8759983484eb09d0ba1be134ec592e You're receiving 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 Jun 9 15:49:13 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 11:49:13 -0400 Subject: [Git][ghc/ghc][master] hadrian: Properly partition options in sourceArgs Message-ID: <5cfd2a798495d_6f73fe5e079754c1547550@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - 1 changed file: - hadrian/src/Settings/Default.hs Changes: ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -179,7 +179,10 @@ sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault , getContextData hcOpts - , libraryPackage ? hsLibrary + -- `compiler` is also a library but the specific arguments that we want + -- to apply to that are given by the hsCompiler option. `ghc` is an + -- executable so we don't have to exclude that. + , libraryPackage ? notM (packageOneOf [compiler]) ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/970e480230bc8422d9bd9a6f1011def86befc34a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/970e480230bc8422d9bd9a6f1011def86befc34a You're receiving 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 Jun 9 15:49:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 11:49:47 -0400 Subject: [Git][ghc/ghc][master] testsuite: Suppress ticks in T4918 output Message-ID: <5cfd2a9bdecc2_6f73fe60e7a46b0155062f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - 1 changed file: - testsuite/tests/simplCore/should_compile/Makefile Changes: ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -106,11 +106,13 @@ T4903: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903a.hs -dcore-lint '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4903.hs -dcore-lint +# N.B. Suppress ticks to ensure that the test result doesn't change if `base` +# is compiled with -g. See #16741. T4918: $(RM) -f T4918.hi T4918.o T4918a.hi T4918a.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4918.hs - '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4918.hi | grep 'C#' + '$(TEST_HC)' $(TEST_HC_OPTS) -dsuppress-ticks --show-iface T4918.hi | grep 'C#' EvalTest: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O EvalTest.hs -ddump-simpl -dsuppress-uniques | grep 'rght.*Dmd' | sed 's/^ *//' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a018c3a84c88f6208e7bd5587af1cdf40c2ae991 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a018c3a84c88f6208e7bd5587af1cdf40c2ae991 You're receiving 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 Jun 9 16:20:59 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 12:20:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Explain that 'mappend' and '(<>)' should be the same [skip ci] Message-ID: <5cfd31ebe73ea_6f73fe5e1c12ecc1558868@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - 3ad26224 by chessai at 2019-06-09T16:20:35Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 065defc3 by Ben Gamari at 2019-06-09T16:20:35Z testsuite: Add test for #16514 - - - - - 7edef8e2 by Simon Jakobi at 2019-06-09T16:20:37Z Small refactorings in ExtractDocs - - - - - a7b98985 by Kevin Buhr at 2019-06-09T16:20:38Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - 7bd36cb8 by Richard Eisenberg at 2019-06-09T16:20:40Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 787fd005 by Roland Senn at 2019-06-09T16:20:42Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 51b98db7 by Ben Gamari at 2019-06-09T16:20:42Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - 9d711120 by nineonine at 2019-06-09T16:20:44Z Do not report error if Name in pragma is unbound - - - - - 9ecf320f by Ben Gamari at 2019-06-09T16:20:44Z testsuite: Add test for #16509 - - - - - 7389d40f by David Eichmann at 2019-06-09T16:20:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 63189a18 by Richard Eisenberg at 2019-06-09T16:20:48Z Comments only: document tcdDataCusk better. - - - - - 2fe929b2 by John Ericson at 2019-06-09T16:20:49Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - c7c09507 by Daniel Gröber at 2019-06-09T16:20:51Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 30 changed files: - compiler/cmm/CmmMachOp.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - libraries/base/GHC/Base.hs - libraries/base/GHC/Float.hs - rts/RetainerProfile.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/97ba5bf55882e2a6ca22cbae1c6526b3fdf9800b...c7c095075e1396941c6a1d19318469fcd49661a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/97ba5bf55882e2a6ca22cbae1c6526b3fdf9800b...c7c095075e1396941c6a1d19318469fcd49661a4 You're receiving 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 Jun 9 16:32:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 12:32:31 -0400 Subject: [Git][ghc/ghc][wip/slowtest] gitlab-ci: Fetch submodules before running submodule linter Message-ID: <5cfd349fd9283_6f73fe60e7a46b015792e6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 46d2176b by Ben Gamari at 2019-06-09T16:31:32Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,6 +80,7 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" + - git submodule forall git remote update - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -109,6 +110,7 @@ lint-submods-branch: extends: .lint-submods script: - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - git submodule forall git remote update - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) only: refs: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/46d2176b2addcc68db227013af6ef0add162286b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/46d2176b2addcc68db227013af6ef0add162286b You're receiving 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 Jun 9 16:35:20 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 12:35:20 -0400 Subject: [Git][ghc/ghc][wip/slowtest] gitlab-ci: Fetch submodules before running submodule linter Message-ID: <5cfd3548c4029_6f7603cb081582244@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 2b87243e by Ben Gamari at 2019-06-09T16:35:15Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,6 +80,7 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -109,6 +110,7 @@ lint-submods-branch: extends: .lint-submods script: - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) only: refs: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2b87243ee07a77bf10f4a165c087ec7390818793 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2b87243ee07a77bf10f4a165c087ec7390818793 You're receiving 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 Jun 9 17:54:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 13:54:33 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] 2 commits: Bump Cabal submodule Message-ID: <5cfd47d999edd_6f7db3f67015952bd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: ff438786 by Ben Gamari at 2019-06-09T17:54:25Z Bump Cabal submodule - - - - - 983ada70 by Ben Gamari at 2019-06-09T17:54:25Z Bump binary to 0.8.7.0 - - - - - 10 changed files: - hadrian/hadrian.cabal - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - libraries/Cabal - libraries/binary - testsuite/tests/driver/T4437.hs - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/Main.hs - utils/ghc-cabal/ghc-cabal.cabal - utils/ghctags/ghctags.cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -116,7 +116,7 @@ executable hadrian other-extensions: MultiParamTypeClasses , TypeFamilies build-depends: base >= 4.8 && < 5 - , Cabal >= 2.5 && < 2.6 + , Cabal >= 3.0 && < 3.1 , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , extra >= 1.4.7 ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal.Parse @@ -17,6 +16,7 @@ module Hadrian.Haskell.Cabal.Parse ( import Data.Bifunctor import Data.List.Extra import Development.Shake +import qualified Distribution.Compat.Graph as Graph import qualified Distribution.ModuleName as C import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C @@ -30,6 +30,7 @@ import qualified Distribution.Simple.Utils as C import qualified Distribution.Simple.Program.Types as C import qualified Distribution.Simple.Configure as C (getPersistBuildConfig) import qualified Distribution.Simple.Build as C +import qualified Distribution.Types.ComponentLocalBuildInfo as C import qualified Distribution.Types.ComponentRequestedSpec as C import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as C @@ -215,7 +216,7 @@ resolveContextData context at Context {..} = do -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 - let extDeps = C.externalPackageDeps lbi' + let extDeps = externalPackageDeps lbi' deps = map (C.display . snd) extDeps depDirect = map (fromMaybe (error "resolveContextData: depDirect failed") . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps @@ -288,7 +289,20 @@ resolveContextData context at Context {..} = do getHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo getHookedBuildInfo [] = return C.emptyHookedBuildInfo getHookedBuildInfo (baseDir:baseDirs) = do - maybeInfoFile <- C.findHookedPackageDesc baseDir + maybeInfoFile <- C.findHookedPackageDesc C.normal baseDir case maybeInfoFile of Nothing -> getHookedBuildInfo baseDirs Just infoFile -> C.readHookedBuildInfo C.silent infoFile + +externalPackageDeps :: C.LocalBuildInfo -> [(C.UnitId, C.MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (C.componentGraph lbi) + , (ipkgid, pkgid) <- C.componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . C.componentUnitId) (Graph.toList (C.componentGraph lbi)) + ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 27fc0fe9608ba502ef62647629a6d4ebe01fa33d +Subproject commit f697d3209990c3314efe840be54fb7c5a967e6ff ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit fcd9d3cb2a942c54347d28bcb80a1b46d2d7d673 ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,9 +38,8 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", - "AlternativeLayoutRuleTransitional", - "EmptyDataDeriving", - "GeneralisedNewtypeDeriving"] + "AlternativeLayoutRuleTransitional" + ] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", ===================================== utils/check-api-annotations/check-api-annotations.cabal ===================================== @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, ghc ===================================== utils/check-ppr/check-ppr.cabal ===================================== @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory, filepath, ghc ===================================== utils/ghc-cabal/Main.hs ===================================== @@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register +import qualified Distribution.Compat.Graph as Graph import Distribution.Text import Distribution.Types.MungedPackageId +import Distribution.Types.LocalBuildInfo import Distribution.Verbosity import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex @@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } +externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (componentGraph lbi) + , (ipkgid, pkgid) <- componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) + generate :: FilePath -> FilePath -> [String] -> IO () generate directory distdir config_args = withCurrentDirectory directory @@ -274,8 +288,8 @@ generate directory distdir config_args -- cabal 2.2+ will expect it, but fallback to the old default -- location if we don't find any. This is the case of the -- bindist, which doesn't ship the $dist/build folder. - maybe_infoFile <- findHookedPackageDesc (cwd distdir "build") - <|> defaultHookedPackageDesc + maybe_infoFile <- findHookedPackageDesc verbosity (cwd distdir "build") + <|> fmap Just (defaultPackageDesc verbosity) case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -307,8 +321,9 @@ generate directory distdir config_args let comp = compiler lbi - libBiModules lib = (libBuildInfo lib, libModules lib) + libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName)) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) + biModuless :: [(BuildInfo, [ModuleName.ModuleName])] biModuless = (map libBiModules . maybeToList $ library pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.5 && < 2.6, + Cabal >= 3.0 && < 3.1, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 ===================================== utils/ghctags/ghctags.cabal ===================================== @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.5 && <2.6, + Cabal >= 3.0 && <3.1, ghc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d37edd155084161af69741af887be8075234b9d1...983ada70a013c7642a751f6e41587ff95b57d0f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d37edd155084161af69741af887be8075234b9d1...983ada70a013c7642a751f6e41587ff95b57d0f8 You're receiving 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 Jun 9 18:35:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 14:35:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/freebsd-ci Message-ID: <5cfd517b45112_6f7db3f6701606920@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/freebsd-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 Sun Jun 9 18:36:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 14:36:33 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 2 commits: gitlab-ci: Bump ci-images Message-ID: <5cfd51b1b0866_6f73fe6045cf2f41608424@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 81c00a36 by Ben Gamari at 2019-06-09T18:36:28Z gitlab-ci: Bump ci-images - - - - - c7a32d1a by Ben Gamari at 2019-06-09T18:36:28Z gitlab-ci: Try enabling FreeBSD CI - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 08328a0dfe9a565f10c1360f9d1c76ff44a98e7d # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -574,6 +574,24 @@ validate-x86_64-linux-fedora27: when: always expire_in: 2 week +################################# +# x86_64-freebsd10 +################################# + +validate-x86_64-freebsd10: + extends: .validate-linux + stage: full-build + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-freebsd10:$DOCKER_REV" + variables: + CONFIGURE_ARGS: "--target=x86_64-unknown-freebsd10" + TARGET: "FreeBSD" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-freebsd10-linux.tar.xz" + cache: + key: linux-x86_64-freebsd10 + artifacts: + when: always + expire_in: 2 week + ############################################################ # Validation via Pipelines (Windows) ############################################################ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/783d4abd3265117c1c1ee95f071dc34926e70750...c7a32d1a197839380fd8fdb0567ce765135b7ac4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/783d4abd3265117c1c1ee95f071dc34926e70750...c7a32d1a197839380fd8fdb0567ce765135b7ac4 You're receiving 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 Jun 9 18:40:43 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 14:40:43 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 3 commits: linters/check-makefiles: Limit lint to Makefiles Message-ID: <5cfd52abcb01c_6f7d0297041609088@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 9a9f6357 by Ben Gamari at 2019-06-09T18:40:22Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 15f851a0 by Ben Gamari at 2019-06-09T18:40:22Z gitlab-ci: Fetch submodules before running submodule linter - - - - - f10a9a3b by Ben Gamari at 2019-06-09T18:40:22Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 6 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,6 +80,7 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -109,6 +110,7 @@ lint-submods-branch: extends: .lint-submods script: - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) only: refs: ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,7 +12,8 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.", + path_filter = lambda path: path == 'Makefile') ] if __name__ == '__main__': ===================================== .gitlab/linters/linter.py ===================================== @@ -73,13 +73,14 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex, message, path_filter=lambda path: True): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message + self.path_filter = path_filter def lint_line(self, path, line_no, line): - if self.re.search(line): + if self.path_filter(path) and self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)" , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)" , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)" , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)" , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@ @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@ @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@ @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2b87243ee07a77bf10f4a165c087ec7390818793...f10a9a3ba65f22a53369456a242c10ba30ef9c63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2b87243ee07a77bf10f4a165c087ec7390818793...f10a9a3ba65f22a53369456a242c10ba30ef9c63 You're receiving 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 Jun 9 22:41:09 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:41:09 -0400 Subject: [Git][ghc/ghc][master] Introduce log1p and expm1 primops Message-ID: <5cfd8b05a8a2_6f73fe608470f441628581@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 12 changed files: - compiler/cmm/CmmMachOp.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmPrim.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - libraries/base/GHC/Float.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/codeGen/should_run/cgrun078.hs - + testsuite/tests/codeGen/should_run/cgrun078.stdout Changes: ===================================== compiler/cmm/CmmMachOp.hs ===================================== @@ -556,7 +556,9 @@ data CallishMachOp | MO_F64_Acosh | MO_F64_Atanh | MO_F64_Log + | MO_F64_Log1P | MO_F64_Exp + | MO_F64_ExpM1 | MO_F64_Fabs | MO_F64_Sqrt | MO_F32_Pwr @@ -573,7 +575,9 @@ data CallishMachOp | MO_F32_Acosh | MO_F32_Atanh | MO_F32_Log + | MO_F32_Log1P | MO_F32_Exp + | MO_F32_ExpM1 | MO_F32_Fabs | MO_F32_Sqrt ===================================== compiler/cmm/PprC.hs ===================================== @@ -788,7 +788,9 @@ pprCallishMachOp_for_C mop MO_F64_Acosh -> text "acosh" MO_F64_Atan -> text "atan" MO_F64_Log -> text "log" + MO_F64_Log1P -> text "log1p" MO_F64_Exp -> text "exp" + MO_F64_ExpM1 -> text "expm1" MO_F64_Sqrt -> text "sqrt" MO_F64_Fabs -> text "fabs" MO_F32_Pwr -> text "powf" @@ -805,7 +807,9 @@ pprCallishMachOp_for_C mop MO_F32_Acosh -> text "acoshf" MO_F32_Atanh -> text "atanhf" MO_F32_Log -> text "logf" + MO_F32_Log1P -> text "log1pf" MO_F32_Exp -> text "expf" + MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" MO_WriteBarrier -> text "write_barrier" ===================================== compiler/codeGen/StgCmmPrim.hs ===================================== @@ -1513,7 +1513,9 @@ callishOp DoubleAsinhOp = Just MO_F64_Asinh callishOp DoubleAcoshOp = Just MO_F64_Acosh callishOp DoubleAtanhOp = Just MO_F64_Atanh callishOp DoubleLogOp = Just MO_F64_Log +callishOp DoubleLog1POp = Just MO_F64_Log1P callishOp DoubleExpOp = Just MO_F64_Exp +callishOp DoubleExpM1Op = Just MO_F64_ExpM1 callishOp DoubleSqrtOp = Just MO_F64_Sqrt callishOp FloatPowerOp = Just MO_F32_Pwr @@ -1530,7 +1532,9 @@ callishOp FloatAsinhOp = Just MO_F32_Asinh callishOp FloatAcoshOp = Just MO_F32_Acosh callishOp FloatAtanhOp = Just MO_F32_Atanh callishOp FloatLogOp = Just MO_F32_Log +callishOp FloatLog1POp = Just MO_F32_Log1P callishOp FloatExpOp = Just MO_F32_Exp +callishOp FloatExpM1Op = Just MO_F32_ExpM1 callishOp FloatSqrtOp = Just MO_F32_Sqrt callishOp _ = Nothing ===================================== compiler/llvmGen/LlvmCodeGen/CodeGen.hs ===================================== @@ -745,7 +745,9 @@ cmmPrimOpFunctions mop = do return $ case mop of MO_F32_Exp -> fsLit "expf" + MO_F32_ExpM1 -> fsLit "expm1f" MO_F32_Log -> fsLit "logf" + MO_F32_Log1P -> fsLit "log1pf" MO_F32_Sqrt -> fsLit "llvm.sqrt.f32" MO_F32_Fabs -> fsLit "llvm.fabs.f32" MO_F32_Pwr -> fsLit "llvm.pow.f32" @@ -767,7 +769,9 @@ cmmPrimOpFunctions mop = do MO_F32_Atanh -> fsLit "atanhf" MO_F64_Exp -> fsLit "exp" + MO_F64_ExpM1 -> fsLit "expm1" MO_F64_Log -> fsLit "log" + MO_F64_Log1P -> fsLit "log1p" MO_F64_Sqrt -> fsLit "llvm.sqrt.f64" MO_F64_Fabs -> fsLit "llvm.fabs.f64" MO_F64_Pwr -> fsLit "llvm.pow.f64" ===================================== compiler/nativeGen/PPC/CodeGen.hs ===================================== @@ -1955,7 +1955,9 @@ genCCall' dflags gcp target dest_regs args where (functionName, reduce) = case mop of MO_F32_Exp -> (fsLit "exp", True) + MO_F32_ExpM1 -> (fsLit "expm1", True) MO_F32_Log -> (fsLit "log", True) + MO_F32_Log1P -> (fsLit "log1p", True) MO_F32_Sqrt -> (fsLit "sqrt", True) MO_F32_Fabs -> unsupported @@ -1977,7 +1979,9 @@ genCCall' dflags gcp target dest_regs args MO_F32_Atanh -> (fsLit "atanh", True) MO_F64_Exp -> (fsLit "exp", False) + MO_F64_ExpM1 -> (fsLit "expm1", False) MO_F64_Log -> (fsLit "log", False) + MO_F64_Log1P -> (fsLit "log1p", False) MO_F64_Sqrt -> (fsLit "sqrt", False) MO_F64_Fabs -> unsupported ===================================== compiler/nativeGen/SPARC/CodeGen.hs ===================================== @@ -616,7 +616,9 @@ outOfLineMachOp_table outOfLineMachOp_table mop = case mop of MO_F32_Exp -> fsLit "expf" + MO_F32_ExpM1 -> fsLit "expm1f" MO_F32_Log -> fsLit "logf" + MO_F32_Log1P -> fsLit "log1pf" MO_F32_Sqrt -> fsLit "sqrtf" MO_F32_Fabs -> unsupported MO_F32_Pwr -> fsLit "powf" @@ -638,7 +640,9 @@ outOfLineMachOp_table mop MO_F32_Atanh -> fsLit "atanhf" MO_F64_Exp -> fsLit "exp" + MO_F64_ExpM1 -> fsLit "expm1" MO_F64_Log -> fsLit "log" + MO_F64_Log1P -> fsLit "log1p" MO_F64_Sqrt -> fsLit "sqrt" MO_F64_Fabs -> unsupported MO_F64_Pwr -> fsLit "pow" ===================================== compiler/nativeGen/X86/CodeGen.hs ===================================== @@ -2875,7 +2875,9 @@ outOfLineCmmOp bid mop res args MO_F32_Cos -> fsLit "cosf" MO_F32_Tan -> fsLit "tanf" MO_F32_Exp -> fsLit "expf" + MO_F32_ExpM1 -> fsLit "expm1f" MO_F32_Log -> fsLit "logf" + MO_F32_Log1P -> fsLit "log1pf" MO_F32_Asin -> fsLit "asinf" MO_F32_Acos -> fsLit "acosf" @@ -2896,7 +2898,9 @@ outOfLineCmmOp bid mop res args MO_F64_Cos -> fsLit "cos" MO_F64_Tan -> fsLit "tan" MO_F64_Exp -> fsLit "exp" + MO_F64_ExpM1 -> fsLit "expm1" MO_F64_Log -> fsLit "log" + MO_F64_Log1P -> fsLit "log1p" MO_F64_Asin -> fsLit "asin" MO_F64_Acos -> fsLit "acos" ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -763,12 +763,23 @@ primop DoubleExpOp "expDouble#" Monadic with code_size = { primOpCodeSizeForeignCall } +primop DoubleExpM1Op "expm1Double#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + primop DoubleLogOp "logDouble#" Monadic Double# -> Double# with code_size = { primOpCodeSizeForeignCall } can_fail = True +primop DoubleLog1POp "log1pDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + primop DoubleSqrtOp "sqrtDouble#" Monadic Double# -> Double# with @@ -904,12 +915,23 @@ primop FloatExpOp "expFloat#" Monadic with code_size = { primOpCodeSizeForeignCall } +primop FloatExpM1Op "expm1Float#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + primop FloatLogOp "logFloat#" Monadic Float# -> Float# with code_size = { primOpCodeSizeForeignCall } can_fail = True +primop FloatLog1POp "log1pFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + primop FloatSqrtOp "sqrtFloat#" Monadic Float# -> Float# with ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1140,13 +1140,16 @@ geFloat (F# x) (F# y) = isTrue# (geFloat# x y) ltFloat (F# x) (F# y) = isTrue# (ltFloat# x y) leFloat (F# x) (F# y) = isTrue# (leFloat# x y) -expFloat, logFloat, sqrtFloat, fabsFloat :: Float -> Float +expFloat, expm1Float :: Float -> Float +logFloat, log1pFloat, sqrtFloat, fabsFloat :: Float -> Float sinFloat, cosFloat, tanFloat :: Float -> Float asinFloat, acosFloat, atanFloat :: Float -> Float sinhFloat, coshFloat, tanhFloat :: Float -> Float asinhFloat, acoshFloat, atanhFloat :: Float -> Float expFloat (F# x) = F# (expFloat# x) +expm1Float (F# x) = F# (expm1Float# x) logFloat (F# x) = F# (logFloat# x) +log1pFloat (F# x) = F# (log1pFloat# x) sqrtFloat (F# x) = F# (sqrtFloat# x) fabsFloat (F# x) = F# (fabsFloat# x) sinFloat (F# x) = F# (sinFloat# x) @@ -1189,13 +1192,16 @@ double2Float (D# x) = F# (double2Float# x) float2Double :: Float -> Double float2Double (F# x) = D# (float2Double# x) -expDouble, logDouble, sqrtDouble, fabsDouble :: Double -> Double +expDouble, expm1Double :: Double -> Double +logDouble, log1pDouble, sqrtDouble, fabsDouble :: Double -> Double sinDouble, cosDouble, tanDouble :: Double -> Double asinDouble, acosDouble, atanDouble :: Double -> Double sinhDouble, coshDouble, tanhDouble :: Double -> Double asinhDouble, acoshDouble, atanhDouble :: Double -> Double expDouble (D# x) = D# (expDouble# x) +expm1Double (D# x) = D# (expm1Double# x) logDouble (D# x) = D# (logDouble# x) +log1pDouble (D# x) = D# (log1pDouble# x) sqrtDouble (D# x) = D# (sqrtDouble# x) fabsDouble (D# x) = D# (fabsDouble# x) sinDouble (D# x) = D# (sinDouble# x) @@ -1226,16 +1232,6 @@ foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Doubl foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int - ------------------------------------------------------------------------- --- libm imports for extended floating ------------------------------------------------------------------------- -foreign import capi unsafe "math.h log1p" log1pDouble :: Double -> Double -foreign import capi unsafe "math.h expm1" expm1Double :: Double -> Double -foreign import capi unsafe "math.h log1pf" log1pFloat :: Float -> Float -foreign import capi unsafe "math.h expm1f" expm1Float :: Float -> Float - - ------------------------------------------------------------------------ -- Coercion rules ------------------------------------------------------------------------ @@ -1324,7 +1320,7 @@ clamp bd k = max (-bd) (min bd k) Note [Casting from integral to floating point types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To implement something like `reinterpret_cast` from C++ to go from a -floating-point type to an integral type one might niavely think that the +floating-point type to an integral type one might naively think that the following should work: cast :: Float -> Word32 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -83,6 +83,7 @@ test('cgrun072', normal, compile_and_run, ['']) test('cgrun075', normal, compile_and_run, ['']) test('cgrun076', normal, compile_and_run, ['']) test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], compile_and_run, ['']) +test('cgrun078', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/cgrun078.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE CApiFFI + , CPP + , GHCForeignImportPrim + , MagicHash + #-} + +-- | Check that libm foreign import log1p/expm1 +-- are equivalent to that of the primops +-- for float/double +module Main ( main ) where + +import GHC.Float (Floating(..)) + +main :: IO () +main = do + print $ oldEqualsNewDouble log1pDoubleOld log1pDoubleNew randomDouble + print $ oldEqualsNewDouble expm1DoubleOld expm1DoubleNew randomDouble + print $ oldEqualsNewFloat log1pFloatOld log1pFloatNew randomFloat + print $ oldEqualsNewFloat expm1FloatOld expm1FloatNew randomFloat + +foreign import capi unsafe "math.h log1p" log1pDoubleOld :: Double -> Double +foreign import capi unsafe "math.h expm1" expm1DoubleOld :: Double -> Double +foreign import capi unsafe "math.h log1pf" log1pFloatOld :: Float -> Float +foreign import capi unsafe "math.h expm1f" expm1FloatOld :: Float -> Float + +oldEqualsNewDouble :: (Double -> Double) -> (Double -> Double) -> Double -> Bool +oldEqualsNewDouble f g x = f x == g x + +oldEqualsNewFloat :: (Float -> Float) -> (Float -> Float) -> Float -> Bool +oldEqualsNewFloat f g x = f x == g x + +log1pDoubleNew, expm1DoubleNew :: Double -> Double +log1pDoubleNew = log1p +expm1DoubleNew = expm1 + +log1pFloatNew, expm1FloatNew :: Float -> Float +log1pFloatNew = log1p +expm1FloatNew = expm1 + +randomFloat :: Float +randomFloat = 53213 + +randomDouble :: Double +randomDouble = 41901526 ===================================== testsuite/tests/codeGen/should_run/cgrun078.stdout ===================================== @@ -0,0 +1,4 @@ +True +True +True +True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f737033329817335bc01ab16a385b4b5ec5b3b5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f737033329817335bc01ab16a385b4b5ec5b3b5d You're receiving 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 Jun 9 22:41:45 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:41:45 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add test for #16514 Message-ID: <5cfd8b29b8822_6f73fe5e11ca52816317f1@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - 4 changed files: - + testsuite/tests/rts/T16514.hs - + testsuite/tests/rts/T16514.stdout - + testsuite/tests/rts/T16514_c.cpp - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T16514.hs ===================================== @@ -0,0 +1,18 @@ +-- ensure that the XMM register values are properly preserved across STG +-- exit/entry. Note that this is very sensitive to code generation. + +module Main where + +import Control.Monad (when) +import System.Exit (exitWith, ExitCode(..)) + +foreign export ccall fn_hs :: IO () + +fn_hs :: IO () +fn_hs = return () + +foreign import ccall test :: IO Int + +main :: IO () +main = do res <- test + when (res /= 0) (exitWith $ ExitFailure res) ===================================== testsuite/tests/rts/T16514.stdout ===================================== @@ -0,0 +1,4 @@ +1.414210 1.732050 2.236070 2.828430 3.605550 4.582580 +1.414210 1.732050 2.236070 2.828430 3.605550 4.582580 +1.414210 1.732050 2.236070 2.828430 3.605550 4.582580 + ===================================== testsuite/tests/rts/T16514_c.cpp ===================================== @@ -0,0 +1,45 @@ +#include +#include + +extern "C" { + +void fn_hs(); +void fn() { + fn_hs(); +} + +void check(double sqrt2, double sqrt3, double sqrt5, + double sqrt8, double sqrt13, double sqrt21) { + std::cout << std::fixed << sqrt2 << " " << sqrt3 << " " << sqrt5 << " " + << sqrt8 << " " << sqrt13 << " " << sqrt21 << std::endl; + if (sqrt2 != 1.41421 || sqrt3 != 1.73205 || sqrt5 != 2.23607 || + sqrt8 != 2.82843 || sqrt13 != 3.60555 || sqrt21 != 4.58258) { + throw std::runtime_error("xmm registers have been scratched"); + } +} + +int test() { + try { + double sqrt2 = 1.41421; + double sqrt3 = 1.73205; + double sqrt5 = 2.23607; + double sqrt8 = 2.82843; + double sqrt13 = 3.60555; + double sqrt21 = 4.58258; + check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21); + fn(); + check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21); + try { + fn(); + } catch (const std::exception &) { + } + check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21); + } catch (const std::exception &e) { + std::cerr << e.what() << std::endl; + return 1; + } + return 0; +} + +} // extern "C" + ===================================== testsuite/tests/rts/all.T ===================================== @@ -390,3 +390,4 @@ test('keep-cafs', ], makefile_test, ['KeepCafs']) +test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp -lstdc++']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/41bf4045c5a85651db8ceb631a1b67edec0c1216 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/41bf4045c5a85651db8ceb631a1b67edec0c1216 You're receiving 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 Jun 9 22:42:27 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:42:27 -0400 Subject: [Git][ghc/ghc][master] Small refactorings in ExtractDocs Message-ID: <5cfd8b537c10_6f73fe5e040f3ac1635131@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 1 changed file: - compiler/deSugar/ExtractDocs.hs Changes: ===================================== compiler/deSugar/ExtractDocs.hs ===================================== @@ -20,6 +20,7 @@ import SrcLoc import TcRnTypes import Control.Applicative +import Data.Bifunctor (first) import Data.List import Data.Map (Map) import qualified Data.Map as M @@ -214,9 +215,10 @@ conArgDocs con = case getConArgs con of InfixCon arg1 arg2 -> go 0 ([unLoc arg1, unLoc arg2] ++ ret) RecCon _ -> go 1 ret where - go n (HsDocTy _ _ (dL->L _ ds) : tys) = M.insert n ds $ go (n+1) tys - go n (_ : tys) = go (n+1) tys - go _ [] = M.empty + go n = M.fromList . catMaybes . zipWith f [n..] + where + f n (HsDocTy _ _ lds) = Just (n, unLoc lds) + f _ _ = Nothing ret = case con of ConDeclGADT { con_res_ty = res_ty } -> [ unLoc res_ty ] @@ -262,14 +264,13 @@ nubByName f ns = go emptyNameSet ns typeDocs :: HsType GhcRn -> Map Int (HsDocString) typeDocs = go 0 where - go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty) - go n (HsQualTy { hst_body = ty }) = go n (unLoc ty) - go n (HsFunTy _ (dL->L _ - (HsDocTy _ _ (dL->L _ x))) (dL->L _ ty)) = - M.insert n x $ go (n+1) ty - go n (HsFunTy _ _ ty) = go (n+1) (unLoc ty) - go n (HsDocTy _ _ (dL->L _ doc)) = M.singleton n doc - go _ _ = M.empty + go n = \case + HsForAllTy { hst_body = ty } -> go n (unLoc ty) + HsQualTy { hst_body = ty } -> go n (unLoc ty) + HsFunTy _ (unLoc->HsDocTy _ _ x) ty -> M.insert n (unLoc x) $ go (n+1) (unLoc ty) + HsFunTy _ _ ty -> go (n+1) (unLoc ty) + HsDocTy _ _ doc -> M.singleton n (unLoc doc) + _ -> M.empty -- | The top-level declarations of a module that we care about, -- ordered by source location, with documentation attached if it exists. @@ -289,11 +290,11 @@ ungroup group_ = mkDecls (valbinds . hs_valds) (ValD noExt) group_ where typesigs (XValBindsLR (NValBinds _ sigs)) = filter (isUserSig . unLoc) sigs - typesigs _ = error "expected ValBindsOut" + typesigs ValBinds{} = error "expected XValBindsLR" valbinds (XValBindsLR (NValBinds binds _)) = concatMap bagToList . snd . unzip $ binds - valbinds _ = error "expected ValBindsOut" + valbinds ValBinds{} = error "expected XValBindsLR" -- | Sort by source location sortByLoc :: [Located a] -> [Located a] @@ -304,17 +305,16 @@ sortByLoc = sortOn getLoc -- A declaration may have multiple doc strings attached to it. collectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])] -- ^ This is an example. -collectDocs = go Nothing [] +collectDocs = go [] Nothing where - go Nothing _ [] = [] - go (Just prev) docs [] = finished prev docs [] - go prev docs ((dL->L _ (DocD _ (DocCommentNext str))) : ds) - | Nothing <- prev = go Nothing (str:docs) ds - | Just decl <- prev = finished decl docs (go Nothing [str] ds) - go prev docs ((dL->L _ (DocD _ (DocCommentPrev str))) : ds) = - go prev (str:docs) ds - go Nothing docs (d:ds) = go (Just d) docs ds - go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds) + go docs mprev decls = case (decls, mprev) of + ((unLoc->DocD _ (DocCommentNext s)) : ds, Nothing) -> go (s:docs) Nothing ds + ((unLoc->DocD _ (DocCommentNext s)) : ds, Just prev) -> finished prev docs $ go [s] Nothing ds + ((unLoc->DocD _ (DocCommentPrev s)) : ds, mprev) -> go (s:docs) mprev ds + (d : ds, Nothing) -> go docs (Just d) ds + (d : ds, Just prev) -> finished prev docs $ go [] (Just d) ds + ([] , Nothing) -> [] + ([] , Just prev) -> finished prev docs [] finished decl docs rest = (decl, reverse docs) : rest @@ -335,13 +335,12 @@ filterDecls = filter (isHandled . unLoc . fst) -- | Go through all class declarations and filter their sub-declarations filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)] -filterClasses decls = [ if isClassD d then (cL loc (filterClass d), doc) else x - | x@(dL->L loc d, doc) <- decls ] +filterClasses = map (first (mapLoc filterClass)) where - filterClass (TyClD x c) = + filterClass (TyClD x c@(ClassDecl {})) = TyClD x $ c { tcdSigs = filter (liftA2 (||) (isUserSig . unLoc) isMinimalLSig) (tcdSigs c) } - filterClass _ = error "expected TyClD" + filterClass d = d -- | Was this signature given by the user? isUserSig :: Sig name -> Bool @@ -350,12 +349,10 @@ isUserSig ClassOpSig {} = True isUserSig PatSynSig {} = True isUserSig _ = False -isClassD :: HsDecl a -> Bool -isClassD (TyClD _ d) = isClassDecl d -isClassD _ = False - -- | Take a field of declarations from a data structure and create HsDecls -- using the given constructor -mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c] -mkDecls field con struct = [ cL loc (con decl) - | (dL->L loc decl) <- field struct ] +mkDecls :: (struct -> [Located decl]) + -> (decl -> hsDecl) + -> struct + -> [Located hsDecl] +mkDecls field con = map (mapLoc con) . field View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b9fe91fce5cf5ab233ab48a64e6a49caf1beced3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b9fe91fce5cf5ab233ab48a64e6a49caf1beced3 You're receiving 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 Jun 9 22:43:03 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:43:03 -0400 Subject: [Git][ghc/ghc][master] Handle trailing path separator in package DB names (#16360) Message-ID: <5cfd8b7764852_6f73fe5e040f3ac164013d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - 6 changed files: - compiler/main/Packages.hs - + testsuite/tests/driver/T16360/Hello.hs - + testsuite/tests/driver/T16360/Makefile - + testsuite/tests/driver/T16360/all.T - + testsuite/tests/driver/T16360/test/Test.hs - + testsuite/tests/driver/T16360/test/test.pkg Changes: ===================================== compiler/main/Packages.hs ===================================== @@ -559,13 +559,15 @@ readPackageConfig dflags conf_file = do "can't find a package database at " ++ conf_file let + -- Fix #16360: remove trailing slash from conf_file before calculting pkgroot + conf_file' = dropTrailingPathSeparator conf_file top_dir = topDir dflags - pkgroot = takeDirectory conf_file + pkgroot = takeDirectory conf_file' pkg_configs1 = map (mungePackageConfig top_dir pkgroot) proto_pkg_configs pkg_configs2 = setBatchPackageFlags dflags pkg_configs1 -- - return (conf_file, pkg_configs2) + return (conf_file', pkg_configs2) where readDirStylePackageConfig conf_dir = do let filename = conf_dir "package.cache" ===================================== testsuite/tests/driver/T16360/Hello.hs ===================================== @@ -0,0 +1,3 @@ +import Test + +main = print test ===================================== testsuite/tests/driver/T16360/Makefile ===================================== @@ -0,0 +1,17 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +LOCAL_PKGCONF=package.conf.d + +clean: + rm -f test/*.o test/*.hi *.o *.hi + rm -rf $(LOCAL_PKGCONF) + +.PHONY: T16360 +T16360: + @rm -rf $(LOCAL_PKGCONF) + "$(TEST_HC)" $(TEST_HC_OPTS) -this-unit-id test-1.0 -c test/Test.hs + "$(GHC_PKG)" init $(LOCAL_PKGCONF) + "$(GHC_PKG)" --no-user-package-db -f $(LOCAL_PKGCONF) register test/test.pkg -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -package-db $(LOCAL_PKGCONF)/ -c Hello.hs ===================================== testsuite/tests/driver/T16360/all.T ===================================== @@ -0,0 +1 @@ +test('T16360', [extra_files(['Hello.hs', 'test/'])], makefile_test, []) ===================================== testsuite/tests/driver/T16360/test/Test.hs ===================================== @@ -0,0 +1,4 @@ +module Test where + +test :: Int +test = 42 ===================================== testsuite/tests/driver/T16360/test/test.pkg ===================================== @@ -0,0 +1,8 @@ +name: test +version: 1.0 +id: test-1.0 +key: test-1.0 +exposed-modules: Test +import-dirs: ${pkgroot}/test +library-dirs: ${pkgroot}/test +exposed: True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9d238791862e8b128d397a1c0317986ea82ed000 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9d238791862e8b128d397a1c0317986ea82ed000 You're receiving 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 Jun 9 22:43:47 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:43:47 -0400 Subject: [Git][ghc/ghc][master] Fix #16517 by bumping the TcLevel for method sigs Message-ID: <5cfd8ba3e9621_6f7d02ef1016453f5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 16 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - + testsuite/tests/ghci/scripts/T16767.script - + testsuite/tests/ghci/scripts/T16767.stdout - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/typecheck/should_fail/T16517.hs - + testsuite/tests/typecheck/should_fail/T16517.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail134.stderr Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -2079,13 +2079,6 @@ What do we do when we have an equality where k1 and k2 differ? This Note explores this treacherous area. -First off, the question above is slightly the wrong question. Flattening -a tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening -the kind might introduce a cast. So we might have a casted tyvar on the -left. We thus revise our test case to - - (tv |> co :: k1) ~ (rhs :: k2) - We must proceed differently here depending on whether we have a Wanted or a Given. Consider this: @@ -2109,36 +2102,33 @@ The reason for this odd behavior is much the same as Note [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the new `co` is a Wanted. - The solution is then not to use `co` to "rewrite" -- that is, cast - -- `w`, but instead to keep `w` heterogeneous and - irreducible. Given that we're not using `co`, there is no reason to - collect evidence for it, so `co` is born a Derived, with a CtOrigin - of KindEqOrigin. +The solution is then not to use `co` to "rewrite" -- that is, cast -- `w`, but +instead to keep `w` heterogeneous and irreducible. Given that we're not using +`co`, there is no reason to collect evidence for it, so `co` is born a +Derived, with a CtOrigin of KindEqOrigin. When the Derived is solved (by +unification), the original wanted (`w`) will get kicked out. We thus get -When the Derived is solved (by unification), the original wanted (`w`) -will get kicked out. +[D] _ :: k ~ Type +[W] w :: (alpha :: k) ~ (Int :: Type) -Note that, if we had [G] co1 :: k ~ Type available, then none of this code would -trigger, because flattening would have rewritten k to Type. That is, -`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar -case will trigger, correctly rewriting alpha to (Int |> sym co1). +Note that the Wanted is unchanged and will be irreducible. This all happens +in canEqTyVarHetero. + +Note that, if we had [G] co1 :: k ~ Type available, then we never get +to canEqTyVarHetero: canEqTyVar tries flattening the kinds first. If +we have [G] co1 :: k ~ Type, then flattening the kind of alpha would +rewrite k to Type, and we would end up in canEqTyVarHomo. Successive canonicalizations of the same Wanted may produce duplicate Deriveds. Similar duplications can happen with fundeps, and there seems to be no easy way to avoid. I expect this case to be rare. -For Givens, this problem doesn't bite, so a heterogeneous Given gives +For Givens, this problem (the Wanteds-rewriting-Wanteds action of +a kind coercion) doesn't bite, so a heterogeneous Given gives rise to a Given kind equality. No Deriveds here. We thus homogenise -the Given (see the "homo_co" in the Given case in canEqTyVar) and +the Given (see the "homo_co" in the Given case in canEqTyVarHetero) and carry on with a homogeneous equality constraint. -Separately, I (Richard E) spent some time pondering what to do in the case -that we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2 -differ. Note that the tv is the same. (This case is handled as the first -case in canEqTyVarHomo.) At one point, I thought we could solve this limited -form of heterogeneous Wanted, but I then reconsidered and now treat this case -just like any other heterogeneous Wanted. - Note [Type synonyms and canonicalization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We treat type synonym applications as xi types, that is, they do not ===================================== compiler/typecheck/TcErrors.hs ===================================== @@ -158,14 +158,22 @@ reportUnsolved wanted -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on -- However, do not make any evidence bindings, because we don't -- have any convenient place to put them. +-- NB: Type-level holes are OK, because there are no bindings. -- See Note [Deferring coercion errors to runtime] -- Used by solveEqualities for kind equalities --- (see Note [Fail fast on kind errors] in TcSimplify] +-- (see Note [Fail fast on kind errors] in TcSimplify) -- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = do { ev_binds <- newNoTcEvBinds - ; report_unsolved TypeError HoleError HoleError HoleError + + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures + ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures + ; let type_holes | not partial_sigs = HoleError + | warn_partial_sigs = HoleWarn + | otherwise = HoleDefer + + ; report_unsolved TypeError HoleError type_holes HoleError ev_binds wanted } -- | Report all unsolved goals as warnings (but without deferring any errors to ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -11,7 +11,7 @@ module TcHsType ( -- Type signatures - kcHsSigType, tcClassSigType, + kcClassSigType, tcClassSigType, tcHsSigType, tcHsSigWcType, tcHsPartialSigType, funsSigCtxt, addSigCtxt, pprSigCtxt, @@ -187,24 +187,40 @@ tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type -- already checked this, so we can simply ignore it. tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty) -kcHsSigType :: [Located Name] -> LHsSigType GhcRn -> TcM () -kcHsSigType names (HsIB { hsib_body = hs_ty - , hsib_ext = sig_vars }) - = discardResult $ - addSigCtxt (funsSigCtxt names) hs_ty $ - bindImplicitTKBndrs_Skol sig_vars $ - tc_lhs_type typeLevelMode hs_ty liftedTypeKind - -kcHsSigType _ (XHsImplicitBndrs _) = panic "kcHsSigType" +kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () +kcClassSigType skol_info names sig_ty + = discardResult $ + tcClassSigType skol_info names sig_ty + -- tcClassSigType does a fair amount of extra work that we don't need, + -- such as ordering quantified variables. But we absolutely do need + -- to push the level when checking method types and solve local equalities, + -- and so it seems easier just to call tcClassSigType than selectively + -- extract the lines of code from tc_hs_sig_type that we really need. + -- If we don't push the level, we get #16517, where GHC accepts + -- class C a where + -- meth :: forall k. Proxy (a :: k) -> () + -- Note that k is local to meth -- this is hogwash. 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) $ - tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) -- Do not zonk-to-Type, nor perform a validity check -- We are in a knot with the class and associated types -- Zonking and validity checking is done by tcClassDecl + -- No need to fail here if the type has an error: + -- If we're in the kind-checking phase, the solveEqualities + -- in kcTyClGroup catches the error + -- If we're in the type-checking phase, the solveEqualities + -- in tcClassDecl1 gets it + -- Failing fast here degrades the error message in, e.g., tcfail135: + -- class Foo f where + -- baa :: f a -> f + -- If we fail fast, we're told that f has kind `k1` when we wanted `*`. + -- It should be that f has kind `k2 -> *`, but we never get a chance + -- to run the solver where the kind of f is touchable. This is + -- painfully delicate. tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type -- Does validity checking @@ -214,10 +230,13 @@ tcHsSigType ctxt sig_ty do { traceTc "tcHsSigType {" (ppr sig_ty) -- Generalise here: see Note [Kind generalisation] - ; ty <- tc_hs_sig_type skol_info sig_ty - (expectedKindInCtxt ctxt) + ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty + (expectedKindInCtxt ctxt) ; ty <- zonkTcType ty + ; when insol failM + -- See Note [Fail fast if there are insoluble kind equalities] in TcSimplify + ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) ; return ty } @@ -225,12 +244,14 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM Type + -> ContextKind -> TcM (Bool, TcType) -- Kind-checks/desugars an 'LHsSigType', -- solve equalities, -- and then kind-generalizes. -- This will never emit constraints, as it uses solveEqualities interally. -- No validity checking or zonking +-- Returns also a Bool indicating whether the type induced an insoluble constraint; +-- True <=> constraint is insoluble tc_hs_sig_type skol_info hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { (tc_lvl, (wanted, (spec_tkvs, ty))) @@ -248,11 +269,7 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs) tc_lvl wanted - -- See Note [Fail fast if there are insoluble kind equalities] - -- in TcSimplify - ; when (insolubleWC wanted) failM - - ; return (mkInvForAllTys kvs ty1) } + ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) } tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type" @@ -2225,7 +2242,8 @@ kindGeneralize :: TcType -> TcM [KindVar] -- Quantify the free kind variables of a kind or type -- In the latter case the type is closed, so it has no free -- type variables. So in both cases, all the free vars are kind vars --- Input needn't be zonked. +-- Input needn't be zonked. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. -- NB: You must call solveEqualities or solveLocalEqualities before -- kind generalization -- @@ -2243,7 +2261,8 @@ kindGeneralize kind_or_type -- | This variant of 'kindGeneralize' refuses to generalize over any -- variables free in the given WantedConstraints. Instead, it promotes --- these variables into an outer TcLevel. See also +-- these variables into an outer TcLevel. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. See also -- Note [Promoting unification variables] in TcSimplify kindGeneralizeLocal :: WantedConstraints -> TcType -> TcM [KindVar] kindGeneralizeLocal wanted kind_or_type ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -834,14 +834,14 @@ writeMetaTyVar tyvar ty -- Everything from here on only happens if DEBUG is on | not (isTcTyVar tyvar) - = WARN( True, text "Writing to non-tc tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar ) return () | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar = writeMetaTyVarRef tyvar ref ty | otherwise - = WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar ) return () -------------------- @@ -1094,18 +1094,18 @@ we are trying to generalise this type: forall arg. ... (alpha[tau]:arg) ... We have a metavariable alpha whose kind mentions a skolem variable -boudn inside the very type we are generalising. +bound inside the very type we are generalising. This can arise while type-checking a user-written type signature (see the test case for the full code). We cannot generalise over alpha! That would produce a type like forall {a :: arg}. forall arg. ...blah... The fact that alpha's kind mentions arg renders it completely -ineligible for generaliation. +ineligible for generalisation. However, we are not going to learn any new constraints on alpha, -because its kind isn't even in scope in the outer context. So alpha -is entirely unconstrained. +because its kind isn't even in scope in the outer context (but see Wrinkle). +So alpha is entirely unconstrained. What then should we do with alpha? During generalization, every metavariable is either (A) promoted, (B) generalized, or (C) zapped @@ -1126,6 +1126,17 @@ We do this eager zapping in candidateQTyVars, which always precedes generalisation, because at that moment we have a clear picture of what skolems are in scope. +Wrinkle: + +We must make absolutely sure that alpha indeed is not +from an outer context. (Otherwise, we might indeed learn more information +about it.) This can be done easily: we just check alpha's TcLevel. +That level must be strictly greater than the ambient TcLevel in order +to treat it as naughty. We say "strictly greater than" because the call to +candidateQTyVars is made outside the bumped TcLevel, as stated in the +comment to candidateQTyVarsOfType. The level check is done in go_tv +in collect_cant_qtvs. Skipping this check caused #16517. + -} data CandidatesQTvs @@ -1173,13 +1184,17 @@ candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs) -- | Gathers free variables to use as quantification candidates (in -- 'quantifyTyVars'). This might output the same var -- in both sets, if it's used in both a type and a kind. +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) -- See Note [CandidatesQTvs determinism and order] -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty --- | Like 'splitDepVarsOfType', but over a list of types +-- | Like 'candidateQTyVarsOfType', but over a list of types +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys @@ -1203,7 +1218,7 @@ delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars collect_cand_qtvs :: Bool -- True <=> consider every fv in Type to be dependent - -> VarSet -- Bound variables (both locally bound and globally bound) + -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked -> TcM CandidatesQTvs @@ -1248,16 +1263,26 @@ collect_cand_qtvs is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv - | tv `elemDVarSet` kvs = return dv -- We have met this tyvar aleady + | tv `elemDVarSet` kvs + = return dv -- We have met this tyvar aleady + | not is_dep - , tv `elemDVarSet` tvs = return dv -- We have met this tyvar aleady + , tv `elemDVarSet` tvs + = return dv -- We have met this tyvar aleady + | otherwise = do { tv_kind <- zonkTcType (tyVarKind tv) -- This zonk is annoying, but it is necessary, both to -- ensure that the collected candidates have zonked kinds -- (#15795) and to make the naughty check -- (which comes next) works correctly - ; if intersectsVarSet bound (tyCoVarsOfType tv_kind) + + ; cur_lvl <- getTcLevel + ; if tcTyVarLevel tv `strictlyDeeperThan` cur_lvl && + -- this tyvar is from an outer context: see Wrinkle + -- in Note [Naughty quantification candidates] + + intersectsVarSet bound (tyCoVarsOfType tv_kind) then -- See Note [Naughty quantification candidates] do { traceTc "Zapping naughty quantifier" (pprTyVar tv) ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2435,12 +2435,13 @@ tcRnType hsc_env flexi normalise rdr_type -- It can have any rank or kind -- First bring into scope any wildcards ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; ((ty, kind), lie) <- - captureTopConstraints $ + ; (ty, kind) <- pushTcLevelM_ $ + -- must push level to satisfy level precondition of + -- kindGeneralize, below + solveEqualities $ tcWildCardBinders wcs $ \ wcs' -> do { emitWildCardHoleConstraints wcs' ; tcLHsTypeUnsaturated rn_type } - ; _ <- checkNoErrs (simplifyInteractive lie) -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -2090,6 +2090,16 @@ see dropDerivedWC. For example [D] Int ~ Bool, and we don't want to report that because it's incomprehensible. That is why we don't rewrite wanteds with wanteds! + * We might float out some Wanteds from an implication, leaving behind + their insoluble Deriveds. For example: + + forall a[2]. [W] alpha[1] ~ Int + [W] alpha[1] ~ Bool + [D] Int ~ Bool + + The Derived is insoluble, but we very much want to drop it when floating + out. + But (tiresomely) we do keep *some* Derived constraints: * Type holes are derived constraints, because they have no evidence @@ -2098,8 +2108,7 @@ But (tiresomely) we do keep *some* Derived constraints: * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with KindEqOrigin, may arise from a type equality a ~ Int#, say. See Note [Equalities with incompatible kinds] in TcCanonical. - These need to be kept because the kind equalities might have different - source locations and hence different error messages. + Keeping these around produces better error messages, in practice. E.g., test case dependent/should_fail/T11471 * We keep most derived equalities arising from functional dependencies ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -169,9 +169,10 @@ solveLocalEqualities callsite thing_inside ; emitConstraints wanted -- See Note [Fail fast if there are insoluble kind equalities] - ; if insolubleWC wanted - then failM - else return res } + ; when (insolubleWC wanted) $ + failM + + ; return res } {- Note [Fail fast if there are insoluble kind equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -568,7 +568,7 @@ generaliseTcTyCon tc -- Running example in Note [Inferring kinds for type declarations] -- spec_req_prs = [ ("k1",kk1), ("a", (aa::kk1)) -- , ("k2",kk2), ("x", (xx::kk2))] - -- where "k1" dnotes the Name k1, and kk1, aa, etc are MetaTyVarss, + -- where "k1" dnotes the Name k1, and kk1, aa, etc are MetaTyVars, -- specifically TyVarTvs -- Step 0: zonk and skolemise the Specified and Required binders @@ -1153,9 +1153,11 @@ kcTyClDecl (ClassDecl { tcdLName = (dL->L _ name) do { _ <- tcHsContext ctxt ; mapM_ (wrapLocM_ kc_sig) sigs } where - kc_sig (ClassOpSig _ _ nms op_ty) = kcHsSigType nms op_ty + kc_sig (ClassOpSig _ _ nms op_ty) = kcClassSigType skol_info nms op_ty kc_sig _ = return () + skol_info = TyConSkol ClassFlavour name + kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name) , fdInfo = fd_info })) -- closed type families look at their equations, but other families don't ===================================== compiler/typecheck/TcType.hs ===================================== @@ -522,6 +522,17 @@ superSkolemTv = SkolemTv topTcLevel True -- Treat this as a completely disti -- The choice of level number here is a bit dodgy, but -- topTcLevel works in the places that vanillaSkolemTv is used +instance Outputable TcTyVarDetails where + ppr = pprTcTyVarDetails + +pprTcTyVarDetails :: TcTyVarDetails -> SDoc +-- For debugging +pprTcTyVarDetails (RuntimeUnk {}) = text "rt" +pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl +pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl +pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) + = ppr info <> colon <> ppr tclvl + ----------------------------- data MetaDetails = Flexi -- Flexi type variables unify to become Indirects @@ -550,20 +561,11 @@ instance Outputable MetaDetails where ppr Flexi = text "Flexi" ppr (Indirect ty) = text "Indirect" <+> ppr ty -pprTcTyVarDetails :: TcTyVarDetails -> SDoc --- For debugging -pprTcTyVarDetails (RuntimeUnk {}) = text "rt" -pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl -pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl -pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) - = pp_info <> colon <> ppr tclvl - where - pp_info = case info of - TauTv -> text "tau" - TyVarTv -> text "tyv" - FlatMetaTv -> text "fmv" - FlatSkolTv -> text "fsk" - +instance Outputable MetaInfo where + ppr TauTv = text "tau" + ppr TyVarTv = text "tyv" + ppr FlatMetaTv = text "fmv" + ppr FlatSkolTv = text "fsk" {- ********************************************************************* * * @@ -801,10 +803,10 @@ checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl +-- Returns topTcLevel for non-TcTyVars tcTyVarLevel :: TcTyVar -> TcLevel tcTyVarLevel tv - = ASSERT2( tcIsTcTyVar tv, ppr tv ) - case tcTyVarDetails tv of + = case tcTyVarDetails tv of MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl SkolemTv tv_lvl _ -> tv_lvl RuntimeUnk -> topTcLevel ===================================== testsuite/tests/ghci/scripts/T16767.script ===================================== @@ -0,0 +1,3 @@ +:set -fprint-explicit-foralls -fprint-explicit-kinds -XTypeApplications -XDataKinds +import Data.Proxy +:kind! 'Proxy @_ ===================================== testsuite/tests/ghci/scripts/T16767.stdout ===================================== @@ -0,0 +1,2 @@ +'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _ += 'Proxy @{k} @_ ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -297,3 +297,4 @@ test('T14828', normal, ghci_script, ['T14828.script']) test('T16376', normal, ghci_script, ['T16376.script']) test('T16527', normal, ghci_script, ['T16527.script']) test('T16569', normal, ghci_script, ['T16569.script']) +test('T16767', normal, ghci_script, ['T16767.script']) ===================================== testsuite/tests/typecheck/should_fail/T16517.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE PolyKinds #-} +module T16517 where + +import Data.Proxy +class C a where m :: Proxy (a :: k) ===================================== testsuite/tests/typecheck/should_fail/T16517.stderr ===================================== @@ -0,0 +1,6 @@ + +T16517.hs:5:29: error: + • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘Proxy’, namely ‘(a :: k)’ + In the type signature: m :: Proxy (a :: k) + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -517,3 +517,4 @@ test('T16414', normal, compile_fail, ['']) test('T16456', normal, compile_fail, ['-fprint-explicit-foralls']) test('T16627', normal, compile_fail, ['']) test('T502', normal, compile_fail, ['']) +test('T16517', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail134.stderr ===================================== @@ -2,6 +2,5 @@ tcfail134.hs:5:33: error: • Expecting one more argument to ‘XML’ Expected a type, but ‘XML’ has kind ‘* -> Constraint’ - • In the type signature: - toXML :: a -> XML + • In the type signature: toXML :: a -> XML In the class declaration for ‘XML’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a22e51ea6f7a046c87d57ce30d143eef6abee9ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/a22e51ea6f7a046c87d57ce30d143eef6abee9ff You're receiving 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 Jun 9 22:44:23 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:44:23 -0400 Subject: [Git][ghc/ghc][master] Add disable/enable commands to ghci debugger #2215 Message-ID: <5cfd8bc7bff13_6f73fe5e079605c1647516@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 8 changed files: - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - + testsuite/tests/ghci.debugger/scripts/T2215.hs - + testsuite/tests/ghci.debugger/scripts/T2215.script - + testsuite/tests/ghci.debugger/scripts/T2215.stdout - testsuite/tests/ghci.debugger/scripts/all.T Changes: ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -96,7 +96,7 @@ Compiler `copyByteArray#` calls that were not optimized before, now will be. See :ghc-ticket:`16052`. - GHC's runtime linker no longer uses global state. This allows programs - that use the GHC API to safely use multiple GHC sessions in a single + that use the GHC API to safely use multiple GHC sessions in a single process, as long as there are no native dependencies that rely on global state. @@ -112,6 +112,9 @@ GHCi - Added a command `:instances` to show the class instances available for a type. +- Added new debugger commands :ghci-cmd:`:disable` and :ghci-cmd:`:enable` to + disable and re-enable breakpoints. + Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -1556,17 +1556,32 @@ breakpoint on a let expression, but there will always be a breakpoint on its body, because we are usually interested in inspecting the values of the variables bound by the let. -Listing and deleting breakpoints -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Managing breakpoints +^^^^^^^^^^^^^^^^^^^^ -The list of breakpoints currently enabled can be displayed using +The list of breakpoints currently defined can be displayed using :ghci-cmd:`:show breaks`: .. code-block:: none *Main> :show breaks - [0] Main qsort.hs:1:11-12 - [1] Main qsort.hs:2:15-46 + [0] Main qsort.hs:1:11-12 enabled + [1] Main qsort.hs:2:15-46 enabled + +To disable one or several defined breakpoint, use the :ghci-cmd:`:disable` command with +one or several blank separated numbers +given in the output from :ghci-cmd:`:show breaks`:. +To disable all breakpoints at once, use ``:disable *``. + +.. code-block:: none + + *Main> :disable 0 + *Main> :show breaks + [0] Main qsort.hs:1:11-12 disabled + [1] Main qsort.hs:2:15-46 enabled + +Disabled breakpoints can be (re-)enabled with the :ghci-cmd:`:enable` command. +The parameters of the :ghci-cmd:`:disable` and :ghci-cmd:`:enable` commands are identical. To delete a breakpoint, use the :ghci-cmd:`:delete` command with the number given in the output from :ghci-cmd:`:show breaks`: @@ -1575,7 +1590,7 @@ given in the output from :ghci-cmd:`:show breaks`: *Main> :delete 0 *Main> :show breaks - [1] Main qsort.hs:2:15-46 + [1] Main qsort.hs:2:15-46 disabled To delete all breakpoints at once, use ``:delete *``. @@ -2377,6 +2392,12 @@ commonly used commands. see the number of each breakpoint). The ``*`` form deletes all the breakpoints. +.. ghci-cmd:: :disable; * | ⟨num⟩ ... + + Disable one or more breakpoints by number (use :ghci-cmd:`:show breaks` to + see the number and state of each breakpoint). The ``*`` form disables all the + breakpoints. + .. ghci-cmd:: :doc; ⟨name⟩ (Experimental: This command will likely change significantly in GHC 8.8.) @@ -2394,6 +2415,12 @@ commonly used commands. variable, or a default editor on your system if :envvar:`EDITOR` is not set. You can change the editor using :ghci-cmd:`:set editor`. +.. ghci-cmd:: :enable; * | ⟨num⟩ ... + + Enable one or more disabled breakpoints by number (use :ghci-cmd:`:show breaks` to + see the number and state of each breakpoint). The ``*`` form enables all the + disabled breakpoints. + .. ghci-cmd:: :etags See :ghci-cmd:`:ctags`. @@ -2764,8 +2791,10 @@ commonly used commands. If a number is given before the command, then the commands are run when the specified breakpoint (only) is hit. This can be quite useful: for example, ``:set stop 1 :continue`` effectively disables - breakpoint 1, by running :ghci-cmd:`:continue` whenever it is hit (although - GHCi will still emit a message to say the breakpoint was hit). What's more, + breakpoint 1, by running :ghci-cmd:`:continue` whenever it is hit + In this case GHCi will still emit a message to say the breakpoint was hit. + If you don't want such a message, you can use the :ghci-cmd:`:disable` + command. What's more, with cunning use of :ghci-cmd:`:def` and :ghci-cmd:`:cmd` you can use :ghci-cmd:`:set stop` to implement conditional breakpoints: ===================================== ghc/GHCi/UI.hs ===================================== @@ -108,6 +108,7 @@ import qualified Data.Set as S import Data.Maybe import Data.Map (Map) import qualified Data.Map as M +import qualified Data.IntMap.Strict as IntMap import Data.Time.LocalTime ( getZonedTime ) import Data.Time.Format ( formatTime, defaultTimeLocale ) import Data.Version ( showVersion ) @@ -187,8 +188,10 @@ ghciCommands = map mkCmd [ ("def", keepGoing (defineMacro False), completeExpression), ("def!", keepGoing (defineMacro True), completeExpression), ("delete", keepGoing deleteCmd, noCompletion), + ("disable", keepGoing disableCmd, noCompletion), ("doc", keepGoing' docCmd, completeIdentifier), ("edit", keepGoing' editFile, completeFilename), + ("enable", keepGoing enableCmd, noCompletion), ("etags", keepGoing createETagsFileCmd, completeFilename), ("force", keepGoing forceCmd, completeExpression), ("forward", keepGoing forwardCmd, noCompletion), @@ -331,8 +334,12 @@ defFullHelpText = " :break [] [] set a breakpoint at the specified location\n" ++ " :break set a breakpoint on the specified function\n" ++ " :continue resume after a breakpoint\n" ++ - " :delete delete the specified breakpoint\n" ++ + " :delete ... delete the specified breakpoints\n" ++ " :delete * delete all breakpoints\n" ++ + " :disable ... disable the specified breakpoints\n" ++ + " :disable * disable all breakpoints\n" ++ + " :enable ... enable the specified breakpoints\n" ++ + " :enable * enable all breakpoints\n" ++ " :force print , forcing unevaluated parts\n" ++ " :forward [] go forward in the history N step s(after :back)\n" ++ " :history [] after :trace, show the execution history\n" ++ @@ -493,7 +500,7 @@ interactiveUI config srcs maybe_exprs = do -- incremented after reading a line. line_number = 0, break_ctr = 0, - breaks = [], + breaks = IntMap.empty, tickarrays = emptyModuleEnv, ghci_commands = availableCommands config, ghci_macros = [], @@ -1300,7 +1307,7 @@ toBreakIdAndLocation (Just inf) = do let md = GHC.breakInfo_module inf nm = GHC.breakInfo_number inf st <- getGHCiState - return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st, + return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st), breakModule loc == md, breakTick loc == nm ] @@ -2813,14 +2820,14 @@ setStop str@(c:_) | isDigit c nm = read nm_str st <- getGHCiState let old_breaks = breaks st - if all ((/= nm) . fst) old_breaks - then printForUser (text "Breakpoint" <+> ppr nm <+> - text "does not exist") - else do - let new_breaks = map fn old_breaks - fn (i,loc) | i == nm = (i,loc { onBreakCmd = dropWhile isSpace rest }) - | otherwise = (i,loc) - setGHCiState st{ breaks = new_breaks } + case IntMap.lookup nm old_breaks of + Nothing -> printForUser (text "Breakpoint" <+> ppr nm <+> + text "does not exist") + Just loc -> do + let new_breaks = IntMap.insert nm + loc { onBreakCmd = dropWhile isSpace rest } + old_breaks + setGHCiState st{ breaks = new_breaks } setStop cmd = modifyGHCiState (\st -> st { stop = cmd }) setPrompt :: GhciMonad m => PromptFunction -> m () @@ -3521,6 +3528,56 @@ deleteCmd argLine = withSandboxOnly ":delete" $ do | all isDigit str = deleteBreak (read str) | otherwise = return () +enableCmd :: GhciMonad m => String -> m () +enableCmd argLine = withSandboxOnly ":enable" $ do + enaDisaSwitch True $ words argLine + +disableCmd :: GhciMonad m => String -> m () +disableCmd argLine = withSandboxOnly ":disable" $ do + enaDisaSwitch False $ words argLine + +enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m () +enaDisaSwitch enaDisa [] = + printForUser (text "The" <+> text strCmd <+> + text "command requires at least one argument.") + where + strCmd = if enaDisa then ":enable" else ":disable" +enaDisaSwitch enaDisa ("*" : _) = enaDisaAllBreaks enaDisa +enaDisaSwitch enaDisa idents = do + mapM_ (enaDisaOneBreak enaDisa) idents + where + enaDisaOneBreak :: GhciMonad m => Bool -> String -> m () + enaDisaOneBreak enaDisa strId = do + sdoc_loc <- getBreakLoc enaDisa strId + case sdoc_loc of + Left sdoc -> printForUser sdoc + Right loc -> enaDisaAssoc enaDisa (read strId, loc) + +getBreakLoc :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation) +getBreakLoc enaDisa strId = do + st <- getGHCiState + case readMaybe strId >>= flip IntMap.lookup (breaks st) of + Nothing -> return $ Left (text "Breakpoint" <+> text strId <+> + text "not found") + Just loc -> + if breakEnabled loc == enaDisa + then return $ Left + (text "Breakpoint" <+> text strId <+> + text "already in desired state") + else return $ Right loc + +enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m () +enaDisaAssoc enaDisa (intId, loc) = do + st <- getGHCiState + newLoc <- turnBreakOnOff enaDisa loc + let new_breaks = IntMap.insert intId newLoc (breaks st) + setGHCiState $ st { breaks = new_breaks } + +enaDisaAllBreaks :: GhciMonad m => Bool -> m() +enaDisaAllBreaks enaDisa = do + st <- getGHCiState + mapM_ (enaDisaAssoc enaDisa) $ IntMap.assocs $ breaks st + historyCmd :: GHC.GhcMonad m => String -> m () historyCmd arg | null arg = history 20 @@ -3648,6 +3705,7 @@ findBreakAndSet md lookupTickTree = do , breakLoc = RealSrcSpan pan , breakTick = tick , onBreakCmd = "" + , breakEnabled = True } printForUser $ text "Breakpoint " <> ppr nm <> @@ -3913,26 +3971,29 @@ mkTickArray ticks discardActiveBreakPoints :: GhciMonad m => m () discardActiveBreakPoints = do st <- getGHCiState - mapM_ (turnOffBreak.snd) (breaks st) - setGHCiState $ st { breaks = [] } + mapM_ (turnBreakOnOff False) $ breaks st + setGHCiState $ st { breaks = IntMap.empty } deleteBreak :: GhciMonad m => Int -> m () deleteBreak identity = do st <- getGHCiState - let oldLocations = breaks st - (this,rest) = partition (\loc -> fst loc == identity) oldLocations - if null this - then printForUser (text "Breakpoint" <+> ppr identity <+> - text "does not exist") - else do - mapM_ (turnOffBreak.snd) this + let oldLocations = breaks st + case IntMap.lookup identity oldLocations of + Nothing -> printForUser (text "Breakpoint" <+> ppr identity <+> + text "does not exist") + Just loc -> do + _ <- (turnBreakOnOff False) loc + let rest = IntMap.delete identity oldLocations setGHCiState $ st { breaks = rest } -turnOffBreak :: GHC.GhcMonad m => BreakLocation -> m () -turnOffBreak loc = do - (arr, _) <- getModBreak (breakModule loc) - hsc_env <- GHC.getSession - liftIO $ enableBreakpoint hsc_env arr (breakTick loc) False +turnBreakOnOff :: GHC.GhcMonad m => Bool -> BreakLocation -> m BreakLocation +turnBreakOnOff onOff loc + | onOff == breakEnabled loc = return loc + | otherwise = do + (arr, _) <- getModBreak (breakModule loc) + hsc_env <- GHC.getSession + liftIO $ enableBreakpoint hsc_env arr (breakTick loc) onOff + return loc { breakEnabled = onOff } getModBreak :: GHC.GhcMonad m => Module -> m (ForeignRef BreakArray, Array Int SrcSpan) ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -66,6 +66,7 @@ import qualified System.Console.Haskeline as Haskeline import Control.Monad.Trans.Class import Control.Monad.IO.Class import Data.Map.Strict (Map) +import qualified Data.IntMap.Strict as IntMap import qualified GHC.LanguageExtensions as LangExt ----------------------------------------------------------------------------- @@ -84,7 +85,7 @@ data GHCiState = GHCiState options :: [GHCiOption], line_number :: !Int, -- ^ input line break_ctr :: !Int, - breaks :: ![(Int, BreakLocation)], + breaks :: !(IntMap.IntMap BreakLocation), tickarrays :: ModuleEnv TickArray, -- ^ 'tickarrays' caches the 'TickArray' for loaded modules, -- so that we don't rebuild it each time the user sets @@ -213,6 +214,7 @@ data BreakLocation { breakModule :: !GHC.Module , breakLoc :: !SrcSpan , breakTick :: {-# UNPACK #-} !Int + , breakEnabled:: !Bool , onBreakCmd :: String } @@ -220,21 +222,27 @@ instance Eq BreakLocation where loc1 == loc2 = breakModule loc1 == breakModule loc2 && breakTick loc1 == breakTick loc2 -prettyLocations :: [(Int, BreakLocation)] -> SDoc -prettyLocations [] = text "No active breakpoints." -prettyLocations locs = vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs +prettyLocations :: IntMap.IntMap BreakLocation -> SDoc +prettyLocations locs = + case IntMap.null locs of + True -> text "No active breakpoints." + False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs instance Outputable BreakLocation where - ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> + ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+> if null (onBreakCmd loc) then Outputable.empty else doubleQuotes (text (onBreakCmd loc)) + where pprEnaDisa = case breakEnabled loc of + True -> text "enabled" + False -> text "disabled" recordBreak :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int) recordBreak brkLoc = do st <- getGHCiState - let oldActiveBreaks = breaks st + let oldmap = breaks st + oldActiveBreaks = IntMap.assocs oldmap -- don't store the same break point twice case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of (nm:_) -> return (True, nm) @@ -242,7 +250,7 @@ recordBreak brkLoc = do let oldCounter = break_ctr st newCounter = oldCounter + 1 setGHCiState $ st { break_ctr = newCounter, - breaks = (oldCounter, brkLoc) : oldActiveBreaks + breaks = IntMap.insert oldCounter brkLoc oldmap } return (False, oldCounter) ===================================== testsuite/tests/ghci.debugger/scripts/T2215.hs ===================================== @@ -0,0 +1,11 @@ +import System.Environment + +qsort :: [Int] -> [Int] +qsort [] = [] +qsort (a:as) = qsort left ++ [a] ++ qsort right + where (left,right) = (filter (<=a) as, filter (>a) as) + +main :: IO() +main = do + args <- getArgs + print $ qsort $ map read $ args ===================================== testsuite/tests/ghci.debugger/scripts/T2215.script ===================================== @@ -0,0 +1,26 @@ +:l T2215.hs +:break 5 +:break 6 +:show breaks +:main 5 21 7 13 8 +:abandon +:disable 0 +:show breaks +:main 5 21 7 13 8 +:abandon +:disable 1 +:disable 1 +:show breaks +:main 5 21 7 13 8 +:enable 0 +:enable 0 +:show breaks +:main 5 21 7 13 8 +:disable 0 +:continue +:enable * +:show breaks +:disable * +:show breaks +:enable 0 1 +:show breaks ===================================== testsuite/tests/ghci.debugger/scripts/T2215.stdout ===================================== @@ -0,0 +1,34 @@ +Breakpoint 0 activated at T2215.hs:5:16-47 +Breakpoint 1 activated at T2215.hs:6:24-56 +[0] Main T2215.hs:5:16-47 enabled +[1] Main T2215.hs:6:24-56 enabled +Stopped in Main.qsort, T2215.hs:5:16-47 +_result :: [Int] = _ +a :: Int = _ +left :: [Int] = _ +right :: [Int] = _ +[0] Main T2215.hs:5:16-47 disabled +[1] Main T2215.hs:6:24-56 enabled +Stopped in Main.qsort.(...), T2215.hs:6:24-56 +_result :: ([Int], [Int]) = _ +a :: Int = _ +as :: [Int] = _ +Breakpoint 1 already in desired state +[0] Main T2215.hs:5:16-47 disabled +[1] Main T2215.hs:6:24-56 disabled +[5,7,8,13,21] +Breakpoint 0 already in desired state +[0] Main T2215.hs:5:16-47 enabled +[1] Main T2215.hs:6:24-56 disabled +Stopped in Main.qsort, T2215.hs:5:16-47 +_result :: [Int] = _ +a :: Int = _ +left :: [Int] = _ +right :: [Int] = _ +[5,7,8,13,21] +[0] Main T2215.hs:5:16-47 enabled +[1] Main T2215.hs:6:24-56 enabled +[0] Main T2215.hs:5:16-47 disabled +[1] Main T2215.hs:6:24-56 disabled +[0] Main T2215.hs:5:16-47 enabled +[1] Main T2215.hs:6:24-56 enabled ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -111,3 +111,4 @@ test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), test('T16700', normal, ghci_script, ['T16700.script']) test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script']) +test('T2215', normal, ghci_script, ['T2215.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10452959136fbf271ac21eb0740030c046db36e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/10452959136fbf271ac21eb0740030c046db36e1 You're receiving 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 Jun 9 22:44:57 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:44:57 -0400 Subject: [Git][ghc/ghc][master] rts: Separate population of eventTypes from initial event generation Message-ID: <5cfd8be9e70c3_6f73fe61e6163d81650613@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - 1 changed file: - rts/eventlog/EventLog.c Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -267,15 +267,9 @@ flushEventLog(void) } static void -postHeaderEvents(void) +init_event_types(void) { - // Write in buffer: the header begin marker. - postInt32(&eventBuf, EVENT_HEADER_BEGIN); - - // Mark beginning of event types in the header. - postInt32(&eventBuf, EVENT_HET_BEGIN); for (int t = 0; t < NUM_GHC_EVENT_TAGS; ++t) { - eventTypes[t].etNum = t; eventTypes[t].desc = EventDesc[t]; @@ -450,9 +444,22 @@ postHeaderEvents(void) default: continue; /* ignore deprecated events */ } + } +} + +static void +postHeaderEvents(void) +{ + // Write in buffer: the header begin marker. + postInt32(&eventBuf, EVENT_HEADER_BEGIN); + // Mark beginning of event types in the header. + postInt32(&eventBuf, EVENT_HET_BEGIN); + + for (int t = 0; t < NUM_GHC_EVENT_TAGS; ++t) { // Write in buffer: the start event type. - postEventType(&eventBuf, &eventTypes[t]); + if (eventTypes[t].desc) + postEventType(&eventBuf, &eventTypes[t]); } // Mark end of event types in the header. @@ -470,6 +477,8 @@ initEventLogging(const EventLogWriter *ev_writer) { uint32_t n_caps; + init_event_types(); + event_log_writer = ev_writer; initEventLogWriter(); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/13572480cbb8588033a60c675bec0cdae382fb91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/13572480cbb8588033a60c675bec0cdae382fb91 You're receiving 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 Jun 9 22:45:35 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:45:35 -0400 Subject: [Git][ghc/ghc][master] Do not report error if Name in pragma is unbound Message-ID: <5cfd8c0f62586_6f7991116816534b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 4 changed files: - compiler/rename/RnEnv.hs - + testsuite/tests/rename/should_fail/T16610.hs - + testsuite/tests/rename/should_fail/T16610.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/rename/RnEnv.hs ===================================== @@ -68,6 +68,7 @@ import PrelNames ( rOOT_MAIN ) import BasicTypes ( pprWarningTxtForMsg, TopLevelFlag(..)) import SrcLoc import Outputable +import UniqSet ( uniqSetAny ) import Util import Maybes import DynFlags @@ -1462,7 +1463,9 @@ lookupBindGroupOcc ctxt what rdr_name RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns) LocalBindCtxt ns -> lookup_group ns ClsDeclCtxt cls -> lookup_cls_op cls - InstDeclCtxt ns -> lookup_top (`elemNameSet` ns) + InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610 + then return (Right $ mkUnboundNameRdr rdr_name) + else lookup_top (`elemNameSet` ns) where lookup_cls_op cls = lookupSubBndrOcc True cls doc rdr_name ===================================== testsuite/tests/rename/should_fail/T16610.hs ===================================== @@ -0,0 +1,6 @@ +module T16610 where + +data Foo = Foo +instance Eq Foo where + {-# INLINE wrong #-} + wrong _ = True ===================================== testsuite/tests/rename/should_fail/T16610.stderr ===================================== @@ -0,0 +1,3 @@ + +T16610.hs:6:3: error: + ‘wrong’ is not a (visible) method of class ‘Eq’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -150,3 +150,4 @@ test('T15957_Fail', normal, compile_fail, ['-Werror -Wall -Wno-missing-signature test('T16385', normal, compile_fail, ['']) test('T16504', normal, compile_fail, ['']) test('T14548', normal, compile_fail, ['']) +test('T16610', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ed20412a8ce7578d073461892c9643591c6993a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ed20412a8ce7578d073461892c9643591c6993a5 You're receiving 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 Jun 9 22:46:12 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:46:12 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add test for #16509 Message-ID: <5cfd8c347926e_6f7cf288c8165637b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 3 changed files: - + testsuite/tests/patsyn/should_compile/T16509.hs - + testsuite/tests/patsyn/should_compile/T16509.script - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== testsuite/tests/patsyn/should_compile/T16509.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +module PatternPanic where + +pattern TestPat :: (Int, Int) +pattern TestPat <- (isSameRef -> True, 0) + +isSameRef :: Int -> Bool +isSameRef e | 0 <- e = True +isSameRef _ = False + ===================================== testsuite/tests/patsyn/should_compile/T16509.script ===================================== @@ -0,0 +1 @@ +:load T16509.hs ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -77,5 +77,6 @@ test('T14326', normal, compile, ['']) test('T14394', normal, ghci_script, ['T14394.script']) test('T14552', normal, compile, ['']) test('T14498', normal, compile, ['']) +test('T16509', expect_broken(16509), ghci_script, ['T16509.script']) test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])], multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8a48a8a4e2f14f7f01aa1d4cf249420c908edb73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8a48a8a4e2f14f7f01aa1d4cf249420c908edb73 You're receiving 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 Jun 9 22:46:52 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:46:52 -0400 Subject: [Git][ghc/ghc][master] Hadrian: need CPP preprocessor dependencies #16660 Message-ID: <5cfd8c5c9ce2_6f7e0e6fc4165945e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -1,5 +1,9 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where +import Data.List.Extra (splitOn) + import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type @@ -131,7 +135,16 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do findHsDependencies :: Args findHsDependencies = builder (Ghc FindHsDependencies) ? do ways <- getLibraryWays + stage <- getStage + ghcVersion :: [Int] <- fmap read . splitOn "." <$> expr (ghcVersionStage stage) mconcat [ arg "-M" + + -- "-include-cpp-deps" is a new ish feature so is version gated. + -- Without this feature some dependencies will be missing in stage0. + -- TODO Remove version gate when minimum supported Stage0 compiler + -- is >= 8.9.0. + , ghcVersion > [8,9,0] ? arg "-include-cpp-deps" + , commonGhcArgs , arg "-include-pkg-deps" , arg "-dep-makefile", arg =<< getOutput View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69c58f8abbb0b51eca1f0004a8d8c1cee0c8f766 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69c58f8abbb0b51eca1f0004a8d8c1cee0c8f766 You're receiving 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 Jun 9 22:47:27 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:47:27 -0400 Subject: [Git][ghc/ghc][master] Comments only: document tcdDataCusk better. Message-ID: <5cfd8c7f30439_6f7db3f6701662313@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 1 changed file: - compiler/hsSyn/HsDecls.hs Changes: ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -550,6 +550,7 @@ type LHsFunDep pass = Located (FunDep (Located (IdP pass))) data DataDeclRn = DataDeclRn { tcdDataCusk :: Bool -- ^ does this have a CUSK? + -- See Note [CUSKs: complete user-supplied kind signatures] , tcdFVs :: NameSet } deriving Data @@ -864,6 +865,10 @@ NOTE THAT This last point is much more debatable than the others; see #15142 comment:22 + + Because this is fiddly to check, there is a field in the DataDeclRn + structure (included in a DataDecl after the renamer) that stores whether + or not the declaration has a CUSK. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1c7bb03db5956e8c56260ba0bbc8271afe073a01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1c7bb03db5956e8c56260ba0bbc8271afe073a01 You're receiving 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 Jun 9 22:48:05 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:48:05 -0400 Subject: [Git][ghc/ghc][master] Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops Message-ID: <5cfd8ca584458_6f73fe60552d9f81665283@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 1 changed file: - compiler/prelude/primops.txt.pp Changes: ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2175,7 +2175,6 @@ 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.} -#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# {Coerce directly from address to int.} with code_size = 0 @@ -2184,7 +2183,6 @@ primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# {Coerce directly from int to address.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } -#endif primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Int# primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Int# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5023adceeb59e9a2b57cda2e69cd2a6152a13ead -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5023adceeb59e9a2b57cda2e69cd2a6152a13ead You're receiving 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 Jun 9 22:48:41 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 18:48:41 -0400 Subject: [Git][ghc/ghc][master] rts: Fix RetainerProfile early return with TREC_CHUNK Message-ID: <5cfd8cc97da97_6f73fe59634ad1c1669916@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 1 changed file: - rts/RetainerProfile.c Changes: ===================================== rts/RetainerProfile.c ===================================== @@ -849,7 +849,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) { *c = NULL; popOff(); - return; + break; } entry = &((StgTRecChunk *)se->c)->entries[entry_no]; if (field_no == 0) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8e60e3f0c6c1482f448dd4d24d716d34046503e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8e60e3f0c6c1482f448dd4d24d716d34046503e9 You're receiving 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 Jun 9 23:19:30 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 09 Jun 2019 19:19:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Introduce log1p and expm1 primops Message-ID: <5cfd94029c596_6f73fe5bde5e8301675289@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 076d45bb by Ben Gamari at 2019-06-09T23:19:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - e19159db by Vladislav Zavialov at 2019-06-09T23:19:25Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 30 changed files: - compiler/cmm/CmmMachOp.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/GHC/Float.hs - libraries/base/tests/all.T - rts/RetainerProfile.c - rts/eventlog/EventLog.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c7c095075e1396941c6a1d19318469fcd49661a4...e19159dba3e59c2fa38d5809c889a1e2eb61775f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c7c095075e1396941c6a1d19318469fcd49661a4...e19159dba3e59c2fa38d5809c889a1e2eb61775f You're receiving 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 Jun 10 02:22:59 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 09 Jun 2019 22:22:59 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 41 commits: Explain that 'mappend' and '(<>)' should be the same [skip ci] Message-ID: <5cfdbf039047c_6f73fe61071535016956e5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 9fa32aaf by Ben Gamari at 2019-06-10T02:21:34Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 778b2174 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 2a86e8fe by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Make closureSize less sensitive to optimisation - - - - - d600c0c6 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - e3b8fe2c by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 48f6a3b9 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - dda400e3 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 09d0d99c by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 4a7f4315 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 7a39ac2b by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - 0798bdf1 by Ben Gamari at 2019-06-10T02:21:34Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - c148d75b by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - c60c82fb by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Fix fragile_for test modifier - - - - - b42b1aff by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 8b62847d by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - cff2b080 by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 90d76ccf by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 7c9ab792 by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 6df1b4c0 by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 1359637c by Ben Gamari at 2019-06-10T02:21:35Z testsuite: Fix typo in flags of T7130 - - - - - 5157d1bb by Ben Gamari at 2019-06-10T02:21:35Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 9b046fe1 by Ben Gamari at 2019-06-10T02:21:35Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 31d73f3a by Ben Gamari at 2019-06-10T02:21:35Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - a64f8d11 by Ben Gamari at 2019-06-10T02:21:35Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 2ed99184 by Ben Gamari at 2019-06-10T02:21:36Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/cmm/CmmMachOp.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - hadrian/src/Rules/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f10a9a3ba65f22a53369456a242c10ba30ef9c63...2ed991846914bd7e8abf97501edd26d8f5b4df9f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f10a9a3ba65f22a53369456a242c10ba30ef9c63...2ed991846914bd7e8abf97501edd26d8f5b4df9f You're receiving 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 Jun 10 05:11:45 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 01:11:45 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] 21 commits: Explain that 'mappend' and '(<>)' should be the same [skip ci] Message-ID: <5cfde691c56c3_6f73fe5e19f8f101702481@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 94db5146 by Ben Gamari at 2019-06-10T05:11:43Z testsuite: Skip dynamicToo006 when dynamic linking is not available This was previously failling on Windows. - - - - - f9e05f30 by Ben Gamari at 2019-06-10T05:11:43Z testsuite: Mark T3372 as fragile on Windows On Windows we must lock package databases even when opening for read-only access. This means that concurrent GHC sessions are very likely to fail with file lock contention. See #16773. - - - - - ff434f28 by Ben Gamari at 2019-06-10T05:11:43Z testsuite: Add stderr output for UnsafeInfered02 on Windows This test uses TemplateHaskell causing GHC to build dynamic objects on platforms where dynamic linking is available. However, Windows doesn't support dynamic linking. Consequently the test would fail on Windows with: ```patch --- safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.stderr.normalised 2019-06-04 15:10:10.521594200 +0000 +++ safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.comp.stderr.normalised 2019-06-04 15:10:10.523546200 +0000 @@ -1,5 +1,5 @@ -[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o, UnsafeInfered02_A.dyn_o ) -[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o, UnsafeInfered02.dyn_o ) +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) UnsafeInfered02.hs:4:1: UnsafeInfered02_A: Can't be safely imported! ``` The other approach I considered for this issue is to pass `-v0` to GHC. However, I felt we should probably do this consistently for all of the tests in this directory and this would take more time than I currently have. - - - - - d11efed3 by Ben Gamari at 2019-06-10T05:11:43Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 5f631f7b by Ben Gamari at 2019-06-10T05:11:43Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - 30 changed files: - .gitlab-ci.yml - compiler/cmm/CmmMachOp.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - docs/users_guide/8.10.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - libraries/base/GHC/Base.hs - libraries/base/GHC/Float.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51226024b2004304f4eac921e2aef72eaa501114...5f631f7b24dcbadf16af7a7097aee4ef911344bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/51226024b2004304f4eac921e2aef72eaa501114...5f631f7b24dcbadf16af7a7097aee4ef911344bb You're receiving 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 Jun 10 05:43:45 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 01:43:45 -0400 Subject: [Git][ghc/ghc][ghc-8.8] 44 commits: Enable external interpreter when TH is requested but no internal interpreter is available Message-ID: <5cfdee112d61d_6f73fe61071535017079c2@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 07131494 by Alp Mestanogullari at 2019-06-04T03:41:36Z Enable external interpreter when TH is requested but no internal interpreter is available (cherry picked from commit e172a6d127a65b945b31306ff7b6c43320debfb4) - - - - - 5d68a56b by Alec Theriault at 2019-06-04T03:41:59Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 551c4024 by Daniel Gröber at 2019-06-04T03:42:11Z Add hPutStringBuffer utility - - - - - 0f9ec9d1 by Daniel Gröber at 2019-06-04T03:42:11Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fa06d1c5 by Daniel Gröber at 2019-06-04T03:42:11Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 679d9958 by Daniel Gröber at 2019-06-04T03:42:11Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - 0cdd6459 by Daniel Gröber at 2019-06-04T03:42:11Z Add failing test for #10887 - - - - - f984a86d by Daniel Gröber at 2019-06-04T03:42:11Z Move throwErrors to HscTypes This, among other things, happened in 1ffee940a0 ("Fix warnings and fatal parsing errors") on master. - - - - - ae2e6b57 by Daniel Gröber at 2019-06-04T03:42:11Z Refactor downsweep to allow returning multiple errors per module - - - - - 35f9fdae by Daniel Gröber at 2019-06-04T03:42:11Z Refactor summarise{File,Module} to reduce code duplication - - - - - 01bb7ec3 by Daniel Gröber at 2019-06-04T03:42:11Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 23f8525f by Daniel Gröber at 2019-06-04T03:42:11Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - c2707d27 by Daniel Gröber at 2019-06-04T03:42:12Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - 693d8b95 by Daniel Gröber at 2019-06-04T03:42:12Z PartialDownsweep: Add test for import errors - - - - - 0072499f by Daniel Gröber at 2019-06-04T03:42:12Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - a0646db3 by Daniel Gröber at 2019-06-04T03:42:12Z Improve targetContents code docs - - - - - c26461fc by Ömer Sinan Ağacan at 2019-06-04T03:42:15Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - ed737292 by Ömer Sinan Ağacan at 2019-06-04T03:42:20Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - 0b91a029 by Krzysztof Gogolewski at 2019-06-04T03:42:27Z Handle hs-boot files in -Wmissing-home-modules (#16551) (cherry picked from commit 43a43a3319d68c1692df6acdf283109cb5c030d8) - - - - - 8a96ab44 by Zubin Duggal at 2019-06-04T03:42:33Z Fix and enforce validation of header for .hie files Implements #16686 automatically generate hieVersion from ghc version - - - - - 921941ee by Zubin Duggal at 2019-06-04T03:42:33Z Make header human readable - - - - - 4542f25d by Alec Theriault at 2019-06-04T03:42:39Z Bump Haddock submodule to 2.23 release This commit of Haddock is (hopefully) going to be the one corresponding to a Hackage release of Haddock 2.23. - - - - - f8d24178 by Michael Sloan at 2019-06-04T03:42:46Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - 7258f41b by Michael Sloan at 2019-06-04T03:42:46Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 (cherry picked from commit fe9034e9b4820214a8c703bd8a3146ce6eed37b8) - - - - - 3be42032 by Michael Sloan at 2019-06-04T03:42:46Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas (cherry picked from commit 061276ea5d265eb3c23a3698f0a10f6a764ff4b4) - - - - - a675f498 by Michael Sloan at 2019-06-04T03:42:47Z Extract out use of UnboxedTuples from GHCi.Leak See #13101 + #15454 for motivation. This change reduces the number of modules that need to be compiled to object code when loading GHC into GHCi. (cherry picked from commit c01d5af31c8feb634fc3dffc84e6e7ece61ba190) - - - - - 7af05bc4 by Michael Sloan at 2019-06-04T03:42:47Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 (cherry picked from commit 64959e51bf17a9f991cc345476a40515e7b32d81) - - - - - bbdcc375 by Ben Gamari at 2019-06-04T21:59:48Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 32ae6b2a by Ben Gamari at 2019-06-04T22:00:59Z Merge remote-tracking branch 'osa1/backport_t16066' into wip/ghc-8.8-merges - - - - - a91acd25 by Ben Gamari at 2019-06-04T22:01:54Z Merge remote-tracking branch 'origin/cherry-pick-43a43a33' into wip/ghc-8.8-merges - - - - - d21c21fc by Ben Gamari at 2019-06-04T22:02:11Z Merge remote-tracking branch 'osa1/port_16449_ghc_8_8' into wip/ghc-8.8-merges - - - - - 86259c2d by Ben Gamari at 2019-06-04T22:03:03Z Merge branch 'hie-backports-8.8' of https://gitlab.haskell.org/DanielG/ghc into wip/ghc-8.8-merges - - - - - 5fccdfad by Ben Gamari at 2019-06-04T22:03:41Z Merge branch 'wip/backport-ecc9366a0e0db107c286935130837b2222e2dd82' of https://gitlab.haskell.org/RyanGlScott/ghc into wip/ghc-8.8-merges - - - - - 514e7bf8 by Ben Gamari at 2019-06-04T22:04:04Z Merge branch 'cherry-pick-e172a6d1' of gitlab.haskell.org:ghc/ghc into wip/ghc-8.8-merges - - - - - 0fb35ed4 by Ben Gamari at 2019-06-04T22:06:59Z Merge branch 'wip/8-8-ghci' of gitlab.haskell.org:ghc/ghc into wip/ghc-8.8-merges - - - - - 5c42df84 by Ben Gamari at 2019-06-04T22:07:26Z Merge branch 'hiefile-header-8.8' of https://gitlab.haskell.org/wz1000/ghc into wip/ghc-8.8-merges - - - - - a598e25b by Ben Gamari at 2019-06-04T22:18:44Z Add missing import Missing from f8d24178f30b7837b35a9ea328bc6f520092ff08. - - - - - 15752087 by Ben Gamari at 2019-06-04T22:54:55Z Merge branch '8.8-haddock-release' of gitlab.haskell.org:harpocrates/ghc into wip/ghc-8.8-merges - - - - - 686bd33a by Ben Gamari at 2019-06-04T22:59:24Z Fix ghc-in-ghci - - - - - fe03067a by Ben Gamari at 2019-06-04T22:59:31Z Haddock for hiefile-header - - - - - 1134488b by Ben Gamari at 2019-06-05T00:31:38Z Bump terminfo to 0.4.1.4 - - - - - fdb07571 by Ben Gamari at 2019-06-05T00:34:27Z Bump time submodule to 1.9.3 - - - - - ff438786 by Ben Gamari at 2019-06-09T17:54:25Z Bump Cabal submodule - - - - - 983ada70 by Ben Gamari at 2019-06-09T17:54:25Z Bump binary to 0.8.7.0 - - - - - 30 changed files: - compiler/backpack/DriverBkp.hs - compiler/basicTypes/UniqSupply.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreArity.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeLink.hs - compiler/ghci/RtClosureInspect.hs - compiler/hieFile/HieAst.hs - compiler/hieFile/HieBin.hs - compiler/hieFile/HieDebug.hs - compiler/hieFile/HieTypes.hs - compiler/iface/BinFingerprint.hs - compiler/main/DriverPipeline.hs - compiler/main/GhcMake.hs - compiler/main/HeaderInfo.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/prelude/PrelRules.hs - compiler/utils/Binary.hs - compiler/utils/FastString.hs - compiler/utils/Panic.hs - + compiler/utils/PlainPanic.hs - compiler/utils/Pretty.hs - compiler/utils/StringBuffer.hs - compiler/utils/Util.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/ghci.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/605869c7b776ce6071a31ff447998b081e0354ed...983ada70a013c7642a751f6e41587ff95b57d0f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/605869c7b776ce6071a31ff447998b081e0354ed...983ada70a013c7642a751f6e41587ff95b57d0f8 You're receiving 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 Jun 10 05:59:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 01:59:53 -0400 Subject: [Git][ghc/ghc][wip/closure-size] ghc-heap: Add closure_size_noopt test Message-ID: <5cfdf1d9f05b0_6f73fe61938211c172721d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: 29bac572 by Ben Gamari at 2019-06-10T05:59:45Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4 changed files: - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs Changes: ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import GHC.Exts.Heap.Closures + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -5,11 +5,22 @@ test('heap_all', omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - [ when(have_profiling(), extra_ways(['prof'])), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['hpc']) ], compile_and_run, ['']) +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], + compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,5 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE UnboxedTuples #-} @@ -12,42 +10,7 @@ import Type.Reflection import GHC.Exts import GHC.Stack import GHC.IO - -import GHC.Exts.Heap.Closures - -assertSize - :: forall a. (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSize x = - assertSizeBox (asBox x) (typeRep @a) - -assertSizeUnlifted - :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSizeUnlifted x = - assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) - -assertSizeBox - :: forall a. (HasCallStack) - => Box -- ^ closure - -> TypeRep a - -> Int -- ^ expected size in words - -> IO () -assertSizeBox x ty expected = do - let !size = closureSize x - when (size /= expected') $ do - putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' - putStrLn $ prettyCallStack callStack - where expected' = expected + profHeaderSize -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} +import ClosureSizeUtils profHeaderSize :: Int #if PROFILING @@ -72,12 +35,6 @@ main = do assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - -- These depend too much upon the behavior of the simplifier to - -- test reliably. - --assertSize (id :: Int -> Int) 1 - --assertSize (fst :: (Int,Int) -> Int) 1 - --assertSize (pap 1) 2 - MA ma <- IO $ \s -> case newArray# 0# 0 s of (# s1, x #) -> (# s1, MA x #) ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/29bac57228ff6039ae987e178b8063b409b66610 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/29bac57228ff6039ae987e178b8063b409b66610 You're receiving 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 Jun 10 06:03:26 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 02:03:26 -0400 Subject: [Git][ghc/ghc][wip/closure-size] ghc-heap: Add closure_size_noopt test Message-ID: <5cfdf2aedab6e_6f73fe5e131e3fc172855@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC Commits: c1296951 by Ben Gamari at 2019-06-10T06:03:19Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4 changed files: - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs Changes: ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -5,11 +5,22 @@ test('heap_all', omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - [ when(have_profiling(), extra_ways(['prof'])), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['hpc']) ], compile_and_run, ['']) +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], + compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,60 +1,12 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -import Control.Monad -import Type.Reflection import GHC.Exts -import GHC.Stack import GHC.IO - -import GHC.Exts.Heap.Closures - -assertSize - :: forall a. (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSize x = - assertSizeBox (asBox x) (typeRep @a) - -assertSizeUnlifted - :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) - => a -- ^ closure - -> Int -- ^ expected size in words - -> IO () -assertSizeUnlifted x = - assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) - -assertSizeBox - :: forall a. (HasCallStack) - => Box -- ^ closure - -> TypeRep a - -> Int -- ^ expected size in words - -> IO () -assertSizeBox x ty expected = do - let !size = closureSize x - when (size /= expected') $ do - putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' - putStrLn $ prettyCallStack callStack - where expected' = expected + profHeaderSize -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} - -profHeaderSize :: Int -#if PROFILING -profHeaderSize = 2 -#else -profHeaderSize = 0 -#endif +import ClosureSizeUtils data A = A (Array# Int) data MA = MA (MutableArray# RealWorld Int) @@ -72,12 +24,6 @@ main = do assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - -- These depend too much upon the behavior of the simplifier to - -- test reliably. - --assertSize (id :: Int -> Int) 1 - --assertSize (fst :: (Int,Int) -> Int) 1 - --assertSize (pap 1) 2 - MA ma <- IO $ \s -> case newArray# 0# 0 s of (# s1, x #) -> (# s1, MA x #) ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c129695194267a13d5c3c3f99013a3db377cce13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c129695194267a13d5c3c3f99013a3db377cce13 You're receiving 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 Jun 10 07:42:57 2019 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Mon, 10 Jun 2019 03:42:57 -0400 Subject: [Git][ghc/ghc][wip/gc/aligned-block-allocation] 255 commits: Typeset Big-O complexities with Tex-style notation (#16090) Message-ID: <5cfe0a016acc6_6f73fe5bdb0907c174193@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/gc/aligned-block-allocation at Glasgow Haskell Compiler / GHC Commits: e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - f72550a3 by Ömer Sinan Ağacan at 2019-06-10T07:20:41Z rts/BlockAlloc: Allow aligned allocation requests This implements support for block group allocations which are aligned to an integral number of blocks. This will be used by the nonmoving garbage collector, which uses the block allocator to allocate the segments which back its heap. These segments are a fixed number of blocks in size, with each segment being aligned to the segment size boundary. This allows us to easily find the segment metadata stored at the beginning of the segment. - - - - - 8be022f1 by Ben Gamari at 2019-06-10T07:20:41Z testsuite/testblockalloc: A bit of refactoring - - - - - 94bacc46 by Ben Gamari at 2019-06-10T07:20:41Z testsuite/testblockalloc: Test aligned block group allocation - - - - - e9176cbb by Ben Gamari at 2019-06-10T07:20:41Z rts/BlockAlloc: Wibbles - - - - - 89c50927 by Ben Gamari at 2019-06-10T07:20:41Z rts/BlockAlloc: Use allocLargeChunk in aligned block allocation - - - - - 3fe074bc by Ömer Sinan Ağacan at 2019-06-10T07:20:41Z Disallow allocating megablocks, update tests - - - - - fc83b9f9 by Ömer Sinan Ağacan at 2019-06-10T07:20:41Z Fix lint errors - - - - - 88ac9ebe by Ömer Sinan Ağacan at 2019-06-10T07:20:41Z Use allocLargeChunkOnNode to reduce splitting - - - - - a08293aa by Ömer Sinan Ağacan at 2019-06-10T07:42:41Z Allow allocating megablocks in allocAlignedGroupOnNode This is currently broken because freeGroup assumes integral number of megablocks when freeing megablocks but we try to split the megablocks returned by allocLargeChunkOnNode to smaller groups and free the rest. - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitignore - .gitlab-ci.yml - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - compiler/backpack/DriverBkp.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/CmmType.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmMonad.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/coreSyn/CoreLint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81f7df9374ace2158cec2a940baf12668ab7d77c...a08293aa84ffe6e989a2b4797fd96822dcbbcd25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81f7df9374ace2158cec2a940baf12668ab7d77c...a08293aa84ffe6e989a2b4797fd96822dcbbcd25 You're receiving 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 Jun 10 11:13:03 2019 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 10 Jun 2019 07:13:03 -0400 Subject: [Git][ghc/ghc][wip/T16728] 29 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfe3b3f3bedc_6f73fe60552d9f817763df@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - be453a13 by Simon Peyton Jones at 2019-06-10T11:11:44Z Fix two places that failed the substitution invariant The substition invariant relies on keeping the in-scope set in sync, and we weren't always doing so, which means that a DEBUG compiler crashes sometimes with an assertion failure This patch fixes a couple more cases. Still not validate clean (with -DEEBUG) but closer! - - - - - efeded42 by Simon Peyton Jones at 2019-06-10T11:12:51Z Fix typechecking of partial type signatures Partial type sigs had grown hair. tcHsParialSigType was doing lots of unnecessary work, and tcInstSig was cloning it unnecessarily -- and the result didn't even work: #16728. This patch cleans it all up, described by TcHsType Note [Checking parital type signatures] I basically just deleted code... but very carefully! Some refactoring along the way * Distinguish more explicintly between "anonymous" wildcards "_" and "named" wildcards "_a". I changed the names of a number of functions to make this distinction much more apparent. The patch also revealed that the code in `TcExpr` that implements the special typing rule for `($)` was wrong. It called `getRuntimeRep` in a situation where where was no particular reason to suppose that the thing had kind `TYPE r`. This caused a crash in typecheck/should_run/T10846. The fix was easy, and actually simplifies the code in `TcExpr` quite a bit. Hooray. - - - - - df9a853a by Simon Peyton Jones at 2019-06-10T11:12:52Z Comments and tiny refactor * Added Note [Quantified varaibles in partial type signatures] in TcRnTypes * Kill dVarSetElemsWellScoped; it was only called in one function, quantifyTyVars. I inlined it because it was only scopedSort . dVarSetElems * Kill Type.tyCoVarsOfBindersWellScoped, never called. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/rename/RnTypes.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/Inst.hs - compiler/typecheck/TcBinds.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnMonad.hs - compiler/typecheck/TcRnTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/18e22a12db3278c71fedcff68251401ca6c672e5...df9a853a1aa58a8d5eb713920605ac651ed64eda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/18e22a12db3278c71fedcff68251401ca6c672e5...df9a853a1aa58a8d5eb713920605ac651ed64eda You're receiving 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 Jun 10 11:59:45 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 07:59:45 -0400 Subject: [Git][ghc/ghc][master] base: Mark CPUTime001 as fragile Message-ID: <5cfe4631d92cc_6f73fe59634ad1c17834e3@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 1 changed file: - libraries/base/tests/all.T Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a3420cabdcf6d7d90c154681230f1150604c097 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a3420cabdcf6d7d90c154681230f1150604c097 You're receiving 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 Jun 10 12:00:21 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 08:00:21 -0400 Subject: [Git][ghc/ghc][master] Print role annotations in TemplateHaskell brackets (#16718) Message-ID: <5cfe465539111_6f73fe5e19f8f10178580@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 5 changed files: - compiler/hsSyn/HsDecls.hs - + testsuite/tests/roles/should_compile/T16718.hs - + testsuite/tests/roles/should_compile/T16718.stderr - testsuite/tests/roles/should_compile/all.T - testsuite/tests/th/T15365.stderr Changes: ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -302,6 +302,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where if isEmptyValBinds val_decls then Nothing else Just (ppr val_decls), + ppr_ds (tyClGroupRoleDecls tycl_decls), ppr_ds (tyClGroupTyClDecls tycl_decls), ppr_ds (tyClGroupInstDecls tycl_decls), ppr_ds deriv_decls, ===================================== testsuite/tests/roles/should_compile/T16718.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, TemplateHaskell #-} + +module T16718 where + +$([d| type role P phantom + data P a + |]) ===================================== testsuite/tests/roles/should_compile/T16718.stderr ===================================== @@ -0,0 +1,7 @@ +T16718.hs:(5,3)-(7,6): Splicing declarations + [d| type role P phantom + + data P a |] + ======> + type role P phantom + data P a ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,3 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) +test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/th/T15365.stderr ===================================== @@ -4,6 +4,8 @@ T15365.hs:(9,3)-(31,6): Splicing declarations pattern (:!!!) :: Bool pattern (:!!!) = True + type role (***) + type (|||) = Either data (***) class (???) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9bc10993bb300d3712b0f13ec6e28621d75d4204 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9bc10993bb300d3712b0f13ec6e28621d75d4204 You're receiving 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 Jun 10 13:31:04 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:31:04 -0400 Subject: [Git][ghc/ghc][wip/T16742] 51 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cfe5b98dbc80_6f73fe5f67fd2b418202bf@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - ea852e68 by Ben Gamari at 2019-06-10T13:30:46Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/PrelRules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/802035236788df8168345c84b10fb012ef1c21df...ea852e687d7372851c7b9209e6bdb930c8cf07bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/802035236788df8168345c84b10fb012ef1c21df...ea852e687d7372851c7b9209e6bdb930c8cf07bc You're receiving 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 Jun 10 13:31:41 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:31:41 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cfe5bbd69502_6f73fe5ee968a0c18222e1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 67df8551 by Ben Gamari at 2019-06-10T13:31:31Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -180,8 +180,8 @@ primOpRules nm XorOp = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , equalArgs >> retLit zerow ] primOpRules nm NotOp = mkPrimOpRule nm 1 [ unaryLit complementOp , inversePrimOp NotOp ] -primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ] -primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ] +primOpRules nm SllOp = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) wordPrimTy ] +primOpRules nm SrlOp = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical wordPrimTy ] -- coercions primOpRules nm Word2IntOp = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ mkLitNumberWrap dflags nt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior and transform the invalid shift into an "obviously +incorrect" value. There are two cases: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/67df855119f629fbf4d3518529364695e4476355 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/67df855119f629fbf4d3518529364695e4476355 You're receiving 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 Jun 10 13:32:45 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:32:45 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cfe5bfd759e2_6f73fe61a3a952c182278d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 87b21352 by Ben Gamari at 2019-06-10T13:32:36Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ mkLitNumberWrap dflags nt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior and transform the invalid shift into an "obviously +incorrect" value. There are two cases: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/87b213520d22de4d0bca831c0ac75f8a8468ca59 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/87b213520d22de4d0bca831c0ac75f8a8468ca59 You're receiving 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 Jun 10 13:34:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:34:39 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cfe5c6fe6b4_6f73fe5f4f597f8182463d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 2daea8f3 by Ben Gamari at 2019-06-10T13:34:27Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ mkLitNumberWrap dflags nt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior and transform the invalid shift into an "obviously +incorrect" value. There are two cases: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2daea8f3d73096b316022675cb8296da2c1dd6b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2daea8f3d73096b316022675cb8296da2c1dd6b8 You're receiving 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 Jun 10 13:46:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:46:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/submod-bumps Message-ID: <5cfe5f1b9197c_6f73fe5f4f597f81826631@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/submod-bumps at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/submod-bumps You're receiving 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 Jun 10 13:53:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 09:53:21 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 31 commits: base: Mark CPUTime001 as fragile Message-ID: <5cfe60d16915e_6f7cf13cd418285de@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 664fcfc2 by Ben Gamari at 2019-06-10T13:39:27Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 0605edd7 by Ben Gamari at 2019-06-10T13:45:17Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) - - - - - 777f9720 by Ben Gamari at 2019-06-10T13:45:29Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e20c3814 by Ben Gamari at 2019-06-10T13:45:33Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 4a7e8ac4 by Ben Gamari at 2019-06-10T13:51:11Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 814f1bfd by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 7882f56a by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Make closureSize less sensitive to optimisation - - - - - b3510047 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - bbc0685f by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - f9c647ad by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 6ec96ae9 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - a020feac by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - aa9da3bb by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 384b22f9 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark closure_size as broken in threaded2, optasm, dyn ways As noted in #16531. - - - - - cced78c2 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 5ac39ec6 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 658199cc by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Fix fragile_for test modifier - - - - - 3b7b5615 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 64b1684d by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - e22a9e40 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - cdc07511 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - da9df85d by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - aa153477 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 12961344 by Ben Gamari at 2019-06-10T13:51:11Z testsuite: Fix typo in flags of T7130 - - - - - 02c77b52 by Ben Gamari at 2019-06-10T13:51:11Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - be55be34 by Ben Gamari at 2019-06-10T13:51:12Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 57052b9c by Ben Gamari at 2019-06-10T13:51:12Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 9c1ed9f5 by Ben Gamari at 2019-06-10T13:51:12Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 6dcc5073 by Ben Gamari at 2019-06-10T13:52:08Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/hsSyn/HsDecls.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/Cabal - libraries/base/tests/all.T - libraries/binary - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - libraries/process - libraries/terminfo - libraries/time - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - + testsuite/tests/roles/should_compile/T16718.hs - + testsuite/tests/roles/should_compile/T16718.stderr - testsuite/tests/roles/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/2ed991846914bd7e8abf97501edd26d8f5b4df9f...6dcc5073f3a19243569eae6dda31ffec689586fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/2ed991846914bd7e8abf97501edd26d8f5b4df9f...6dcc5073f3a19243569eae6dda31ffec689586fc You're receiving 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 Jun 10 14:31:53 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 10:31:53 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: base: Mark CPUTime001 as fragile Message-ID: <5cfe69d93fe84_6f79b8c67c1847812@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - ec2bc8dd by Richard Eisenberg at 2019-06-10T14:31:46Z Comments only: document newtypes' DataConWrapId - - - - - 75f146af by David Eichmann at 2019-06-10T14:31:48Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2d4855d8 by Ben Gamari at 2019-06-10T14:31:48Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - 21f1960d by Ben Gamari at 2019-06-10T14:31:48Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 12 changed files: - compiler/basicTypes/MkId.hs - compiler/hsSyn/HsDecls.hs - hadrian/src/Rules/Compile.hs - libraries/base/tests/all.T - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - + testsuite/tests/roles/should_compile/T16718.hs - + testsuite/tests/roles/should_compile/T16718.stderr - testsuite/tests/roles/should_compile/all.T - testsuite/tests/th/T15365.stderr Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -302,6 +302,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where if isEmptyValBinds val_decls then Nothing else Just (ppr val_decls), + ppr_ds (tyClGroupRoleDecls tycl_decls), ppr_ds (tyClGroupTyClDecls tycl_decls), ppr_ds (tyClGroupInstDecls tycl_decls), ppr_ds deriv_decls, ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + ===================================== testsuite/tests/roles/should_compile/T16718.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, TemplateHaskell #-} + +module T16718 where + +$([d| type role P phantom + data P a + |]) ===================================== testsuite/tests/roles/should_compile/T16718.stderr ===================================== @@ -0,0 +1,7 @@ +T16718.hs:(5,3)-(7,6): Splicing declarations + [d| type role P phantom + + data P a |] + ======> + type role P phantom + data P a ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,3 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) +test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/th/T15365.stderr ===================================== @@ -4,6 +4,8 @@ T15365.hs:(9,3)-(31,6): Splicing declarations pattern (:!!!) :: Bool pattern (:!!!) = True + type role (***) + type (|||) = Either data (***) class (???) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e19159dba3e59c2fa38d5809c889a1e2eb61775f...21f1960ddafc5b1f7c6bc6bb004ff45d24c74962 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e19159dba3e59c2fa38d5809c889a1e2eb61775f...21f1960ddafc5b1f7c6bc6bb004ff45d24c74962 You're receiving 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 Jun 10 15:09:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 11:09:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-debug Message-ID: <5cfe72b896177_6f73fe59634ad1c186079f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/ghc-debug at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ghc-debug You're receiving 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 Jun 10 15:51:44 2019 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Mon, 10 Jun 2019 11:51:44 -0400 Subject: [Git][ghc/ghc][wip/hadrian-sys-cabal] 126 commits: rts: Explicit state that CONSTR tag field is zero-based Message-ID: <5cfe7c90c6be0_6f73fe5f67fd2b4187258f@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/hadrian-sys-cabal at Glasgow Haskell Compiler / GHC Commits: 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 39cfc420 by Matthew Pickering at 2019-06-07T19:10:15Z WIP: Use system cabal to install user packages - - - - - 0869cf38 by Matthew Pickering at 2019-06-07T19:10:15Z WIP: New approach downloading packages and using existing logic to build - - - - - 9153f059 by Matthew Pickering at 2019-06-07T19:10:15Z WIP: Cleanup - - - - - f59df290 by Matthew Pickering at 2019-06-08T15:05:16Z Traces - - - - - 08a638d7 by Matthew Pickering at 2019-06-10T15:51:24Z broken - - - - - 30 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - compiler/backpack/DriverBkp.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmInfo.hs - compiler/cmm/CmmType.hs - compiler/cmm/PprCmmDecl.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/coreSyn/CoreArity.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsForeign.hs - compiler/deSugar/DsMeta.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/Debugger.hs - compiler/ghci/Linker.hs - + compiler/ghci/LinkerTypes.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79555e97b5de3a81ff21f3e2ad7bff86802074f6...08a638d774ba8072abcdbe31bad91ec92d78a002 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79555e97b5de3a81ff21f3e2ad7bff86802074f6...08a638d774ba8072abcdbe31bad91ec92d78a002 You're receiving 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 Jun 10 16:36:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 12:36:33 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] Bump process submodule to 1.6.5.1 Message-ID: <5cfe87119a6f2_6f73fe5f67fd2b41879881@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 719d4c7b by Ben Gamari at 2019-06-10T16:36:11Z Bump process submodule to 1.6.5.1 - - - - - 1 changed file: - libraries/process Changes: ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/719d4c7b5abd2fa02603eda8a0dfbebd47b3d748 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/719d4c7b5abd2fa02603eda8a0dfbebd47b3d748 You're receiving 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 Jun 10 16:40:09 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 12:40:09 -0400 Subject: [Git][ghc/ghc][wip/submod-bumps] Bump process submodule to 1.6.5.1 Message-ID: <5cfe87e984383_6f73fe5f67fd2b41886270@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/submod-bumps at Glasgow Haskell Compiler / GHC Commits: 7d899ea2 by Ben Gamari at 2019-06-10T16:39:58Z Bump process submodule to 1.6.5.1 - - - - - 1 changed file: - libraries/process Changes: ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7d899ea261eecb0945bd6f321b7ebe05426d7d82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7d899ea261eecb0945bd6f321b7ebe05426d7d82 You're receiving 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 Jun 10 16:58:16 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 12:58:16 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cfe8c2851b4b_6f73fe5f67fd2b4189025@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 7e08c809 by Ben Gamari at 2019-06-10T16:54:16Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the presence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. For instance, consider the expression: ```haskell unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) ``` Specifically, ticks appearing in two places can defeat the rule: a. Surrounding the inner application of `unpackFoldrCString#` b. Surrounding the fold function, `c` The latter caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,26 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the argument, lest + -- this may fail to fire when building with -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , cheapEqExpr' tickishFloatable c1 c2 + , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1 + , c2Ticks <- stripTicksTopT tickishFloatable c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` mkTicks (c1Ticks ++ c2Ticks) c1' + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7e08c809e5d4a6fff8780704e6ab2e53b869917c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7e08c809e5d4a6fff8780704e6ab2e53b869917c You're receiving 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 Jun 10 16:59:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 12:59:38 -0400 Subject: [Git][ghc/ghc][wip/T16740] PrelRules: Ensure that string unpack/append rule fires with source notes Message-ID: <5cfe8c7ac2861_6f73fe5f45bbb4c1890718@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16740 at Glasgow Haskell Compiler / GHC Commits: 3b973df7 by Ben Gamari at 2019-06-10T16:59:28Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the presence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. For instance, consider the expression: ```haskell unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) ``` Specifically, ticks appearing in two places can defeat the rule: a. Surrounding the inner application of `unpackFoldrCString#` b. Surrounding the fold function, `c` The latter caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -41,7 +41,7 @@ import TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons , tyConFamilySize ) import DataCon ( dataConTagZ, dataConTyCon, dataConWorkId ) -import CoreUtils ( cheapEqExpr, exprIsHNF, exprType ) +import CoreUtils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType, stripTicksTop, stripTicksTopT, mkTicks ) import CoreUnfold ( exprIsConApp_maybe ) import Type import OccName ( occNameFS ) @@ -1368,20 +1368,27 @@ match_append_lit _ id_unf _ [ Type ty1 , lit1 , c1 - , Var unpk `App` Type ty2 - `App` lit2 - `App` c2 - `App` n + , e2 ] - | unpk `hasKey` unpackCStringFoldrIdKey && - c1 `cheapEqExpr` c2 + -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the + -- `lit` and `c` arguments, lest this may fail to fire when building with + -- -g3. See #16740. + | (strTicks, Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n) <- stripTicksTop tickishFloatable e2 + , unpk `hasKey` unpackCStringFoldrIdKey + , cheapEqExpr' tickishFloatable c1 c2 + , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1 + , c2Ticks <- stripTicksTopT tickishFloatable c2 , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1 , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2 = ASSERT( ty1 `eqType` ty2 ) - Just (Var unpk `App` Type ty1 - `App` Lit (LitString (s1 `BS.append` s2)) - `App` c1 - `App` n) + Just $ mkTicks strTicks + $ Var unpk `App` Type ty1 + `App` Lit (LitString (s1 `BS.append` s2)) + `App` mkTicks (c1Ticks ++ c2Ticks) c1' + `App` n match_append_lit _ _ _ _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b973df7b8909f250e02338ea27c881aaa37fa90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3b973df7b8909f250e02338ea27c881aaa37fa90 You're receiving 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 Jun 10 17:18:06 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 13:18:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR706 Message-ID: <5cfe90ceb7a96_6f73fe5f67fd2b418912c5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR706 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR706 You're receiving 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 Jun 10 17:24:10 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 13:24:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR769 Message-ID: <5cfe923a1c1a_6f7816a62c19000d7@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR769 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR769 You're receiving 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 Jun 10 17:41:27 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 13:41:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR951 Message-ID: <5cfe96475afa2_6f73fe5f67fd2b4190541f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR951 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR951 You're receiving 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 Jun 10 20:07:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 16:07:42 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Fix revertCAFs Message-ID: <5cfeb88efbc4_6f79a1a7d019224dd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: d2833e62 by Ben Gamari at 2019-06-10T20:07:31Z Fix revertCAFs - - - - - 1 changed file: - rts/sm/GCAux.c Changes: ===================================== rts/sm/GCAux.c ===================================== @@ -123,9 +123,10 @@ revertCAFs( void ) c = (StgIndStatic *)c->static_link) { c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c); + const StgInfoTable *saved_info = c->saved_info; c->saved_info = NULL; write_barrier(); - SET_INFO((StgClosure *)c, c->saved_info); + SET_INFO((StgClosure *)c, saved_info); // could, but not necessary: c->static_link = NULL; } revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d2833e62a7c5ac3d24cf158d814927b34922aa73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d2833e62a7c5ac3d24cf158d814927b34922aa73 You're receiving 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 Jun 10 20:07:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 16:07:54 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] 36 commits: gitlab-ci: Linters, don't allow to fail Message-ID: <5cfeb89abb165_6f79a1a7d01924144@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 9887cc31 by Travis Whitaker at 2019-06-10T20:07:45Z Correct closure observation, construction, and mutation on weak memory machines. Here the following changes are introduced: - A read barrier machine op is added to Cmm. - The order in which a closure's fields are read and written is changed. - Memory barriers are added to RTS code to ensure correctness on out-or-order machines with weak memory ordering. Cmm has a new CallishMachOp called MO_ReadBarrier. On weak memory machines, this is lowered to an instruction that ensures memory reads that occur after said instruction in program order are not performed before reads coming before said instruction in program order. On machines with strong memory ordering properties (e.g. X86, SPARC in TSO mode) no such instruction is necessary, so MO_ReadBarrier is simply erased. However, such an instruction is necessary on weakly ordered machines, e.g. ARM and PowerPC. Weam memory ordering has consequences for how closures are observed and mutated. For example, consider a closure that needs to be updated to an indirection. In order for the indirection to be safe for concurrent observers to enter, said observers must read the indirection's info table before they read the indirectee. Furthermore, the entering observer makes assumptions about the closure based on its info table contents, e.g. an INFO_TYPE of IND imples the closure has an indirectee pointer that is safe to follow. When a closure is updated with an indirection, both its info table and its indirectee must be written. With weak memory ordering, these two writes can be arbitrarily reordered, and perhaps even interleaved with other threads' reads and writes (in the absence of memory barrier instructions). Consider this example of a bad reordering: - An updater writes to a closure's info table (INFO_TYPE is now IND). - A concurrent observer branches upon reading the closure's INFO_TYPE as IND. - A concurrent observer reads the closure's indirectee and enters it. (!!!) - An updater writes the closure's indirectee. Here the update to the indirectee comes too late and the concurrent observer has jumped off into the abyss. Speculative execution can also cause us issues, consider: - An observer is about to case on a value in closure's info table. - The observer speculatively reads one or more of closure's fields. - An updater writes to closure's info table. - The observer takes a branch based on the new info table value, but with the old closure fields! - The updater writes to the closure's other fields, but its too late. Because of these effects, reads and writes to a closure's info table must be ordered carefully with respect to reads and writes to the closure's other fields, and memory barriers must be placed to ensure that reads and writes occur in program order. Specifically, updates to a closure must follow the following pattern: - Update the closure's (non-info table) fields. - Write barrier. - Update the closure's info table. Observing a closure's fields must follow the following pattern: - Read the closure's info pointer. - Read barrier. - Read the closure's (non-info table) fields. This patch updates RTS code to obey this pattern. This should fix long-standing SMP bugs on ARM (specifically newer aarch64 microarchitectures supporting out-of-order execution) and PowerPC. This fixesd issue #15449. - - - - - aee9ae9e by Ben Gamari at 2019-06-10T20:07:45Z rts: Fix memory barriers This reverts and fixes some of the barriers introduced in the previous patch. In particular, we only need barriers on closures which are visible to other cores. This means we can exclude barriers on newly-allocated closures. However, when we make a closure visible to other cores (e.g. by introducing a pointer to it into another possibly-visible closure) then we must first place a write barrier to ensure that other cores cannot see a partially constructed closure. - - - - - 73968f1f by Ben Gamari at 2019-06-10T20:07:45Z More comments - - - - - 12e5b6a1 by Ben Gamari at 2019-06-10T20:07:45Z Add missing memory barrier - - - - - 61fab614 by Ben Gamari at 2019-06-10T20:07:45Z Fix weaks - - - - - 360685c9 by Ben Gamari at 2019-06-10T20:07:45Z Threads: Shuffle barrier It seems clearer if it's closer to its use site - - - - - 24d4f451 by Ben Gamari at 2019-06-10T20:07:45Z Evac: Drop redundant barrier in serial path - - - - - e5821bbb by Ben Gamari at 2019-06-10T20:07:45Z Fix revertCAFs - - - - - 30 changed files: - .gitlab-ci.yml - compiler/cmm/CmmMachOp.hs - compiler/cmm/CmmParse.y - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmBind.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/ExtractDocs.hs - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/HscTypes.hs - compiler/main/Packages.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/primops.txt.pp - compiler/rename/RnEnv.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/StgSyn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d2833e62a7c5ac3d24cf158d814927b34922aa73...e5821bbb20c119a2a8e1dfd93666413eaf750f0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d2833e62a7c5ac3d24cf158d814927b34922aa73...e5821bbb20c119a2a8e1dfd93666413eaf750f0a You're receiving 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 Jun 10 20:52:30 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 10 Jun 2019 16:52:30 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] 53 commits: TestRunner: Added --chart to display a chart of performance tests Message-ID: <5cfec30ea63e3_6f79a1a7d019281a3@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 8282026b by Sebastian Graf at 2019-06-10T20:51:52Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 27 changed files: - .gitlab-ci.yml - compiler/basicTypes/NameEnv.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExpr.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/17739b9aaf03dc90d4cf961c367ea47156c5bede...8282026bd37270e50344024c1c705b5b2b3ef98e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/17739b9aaf03dc90d4cf961c367ea47156c5bede...8282026bd37270e50344024c1c705b5b2b3ef98e You're receiving 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 Jun 10 22:08:34 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 18:08:34 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cfed4e29c778_6f73fe5bb4600241942299@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: de798ea4 by Ben Gamari at 2019-06-10T22:08:25Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. - - - - - 1 changed file: - compiler/prelude/PrelRules.hs Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ Lit $ mkLitNumberWrap dflags LitNumInt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior and transform the invalid shift into an "obviously +incorrect" value. There are two cases: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/de798ea462912d646b09dc9775e7df70c55e9e92 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/de798ea462912d646b09dc9775e7df70c55e9e92 You're receiving 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 Jun 10 22:42:37 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 18:42:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-fragile Message-ID: <5cfedcdd9816e_6f73fe61e6c7d40194346d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-fragile at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-fragile You're receiving 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 Jun 10 22:53:18 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 18:53:18 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 2 commits: Bump unix submodule Message-ID: <5cfedf5eed7aa_6f73fe5ee968a0c1946361@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: e73fa6ab by Ben Gamari at 2019-06-10T22:53:08Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 6d4c8752 by Ben Gamari at 2019-06-10T22:53:08Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 2 changed files: - libraries/process - libraries/unix Changes: ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 5c81524694ceaf8523a1846718a7a7c3f402124f ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit 3985f63a35235ce5e10a4cb6f532c1041f466372 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6dcc5073f3a19243569eae6dda31ffec689586fc...6d4c87523a635d447e7a0e20f4708eca4b35f39d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6dcc5073f3a19243569eae6dda31ffec689586fc...6d4c87523a635d447e7a0e20f4708eca4b35f39d You're receiving 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 Jun 10 23:01:57 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 19:01:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ignore-t-files Message-ID: <5cfee165bd1b_6f73fe5bb46002419484a0@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/ignore-t-files at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/ignore-t-files You're receiving 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 Jun 10 23:02:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 19:02:14 -0400 Subject: [Git][ghc/ghc][wip/ignore-t-files] testsuite: Add haddock perf test output to gitignore Message-ID: <5cfee176b4e6e_6f73fe5f67fd2b41949210@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ignore-t-files at Glasgow Haskell Compiler / GHC Commits: 91de4a82 by Ben Gamari at 2019-06-10T23:02:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - 1 changed file: - + testsuite/tests/perf/haddock/.gitignore Changes: ===================================== testsuite/tests/perf/haddock/.gitignore ===================================== @@ -0,0 +1,2 @@ +# RTS performance metrics output from haddock perf tests +*.t View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/91de4a8250741a1670e81e5c1c68d35c1d815c6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/91de4a8250741a1670e81e5c1c68d35c1d815c6e You're receiving 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 Jun 10 23:09:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 19:09:03 -0400 Subject: [Git][ghc/ghc][wip/submod-bumps] testsuite: Fix fragile_for test modifier Message-ID: <5cfee30f496b5_6f73fe61e6c7d401951324@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/submod-bumps at Glasgow Haskell Compiler / GHC Commits: 7124b715 by Ben Gamari at 2019-06-10T23:08:57Z testsuite: Fix fragile_for test modifier - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,7 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2 You're receiving 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 Jun 11 01:02:00 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 21:02:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/alpine-ci Message-ID: <5cfefd88510d4_6f73fe61a39a4dc1973919@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/alpine-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/alpine-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 Tue Jun 11 01:44:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 21:44:55 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: gitlab-ci: Build alpine release bindists Message-ID: <5cff0797f1f9c_6f73fe60538100019768c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 3fd59353 by Ben Gamari at 2019-06-11T01:44:49Z gitlab-ci: Build alpine release bindists - - - - - e3bda273 by Ben Gamari at 2019-06-11T01:44:49Z XXX: Test alpine job - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 908b8b40054e03436ad0c385f7af6d485715d17f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bbf66dd2e98daef56fa2005bb171ecaf767e4a1a...e3bda2731f3f642a57cccf3ea1a120bcba365eb1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bbf66dd2e98daef56fa2005bb171ecaf767e4a1a...e3bda2731f3f642a57cccf3ea1a120bcba365eb1 You're receiving 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 Jun 11 02:02:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 22:02:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T15208 Message-ID: <5cff0bc83193c_6f73fe618522fcc1981091@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T15208 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T15208 You're receiving 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 Jun 11 02:36:08 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 22:36:08 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: gitlab-ci: Build alpine release bindists Message-ID: <5cff13985a023_6f73fe5e03eefbc1996180@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 14a81116 by Ben Gamari at 2019-06-11T02:35:59Z gitlab-ci: Build alpine release bindists - - - - - f943436b by Ben Gamari at 2019-06-11T02:35:59Z XXX: Test alpine job - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: e17cf1185fb9e5c3a9873abee6759350bbcde8ae # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e3bda2731f3f642a57cccf3ea1a120bcba365eb1...f943436b9aa2fd01055650e4206f7118ef5b67ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e3bda2731f3f642a57cccf3ea1a120bcba365eb1...f943436b9aa2fd01055650e4206f7118ef5b67ad You're receiving 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 Jun 11 02:53:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 22:53:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-users-guide Message-ID: <5cff17b69329e_6f7816a62c1998849@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fix-users-guide at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-users-guide You're receiving 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 Jun 11 03:29:30 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:29:30 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: gitlab-ci: Build alpine release bindists Message-ID: <5cff201ac9a27_6f73fe6083b19502004579@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: f0d16c49 by Ben Gamari at 2019-06-11T03:29:25Z gitlab-ci: Build alpine release bindists - - - - - d5606ffb by Ben Gamari at 2019-06-11T03:29:25Z XXX: Test alpine job - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 9f6aae0874b01ac062ebc88193a6e444c281ad5f # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f943436b9aa2fd01055650e4206f7118ef5b67ad...d5606ffbfccf5f124e29900de19892fea3b221b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f943436b9aa2fd01055650e4206f7118ef5b67ad...d5606ffbfccf5f124e29900de19892fea3b221b2 You're receiving 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 Jun 11 03:34:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:34:25 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] FIx lowering of MO_ReadBarrier in PprC Message-ID: <5cff21411e1a9_6f73fe605db05442005583@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: be692a36 by Ben Gamari at 2019-06-11T03:33:47Z FIx lowering of MO_ReadBarrier in PprC This operation is known as load_load_barrier in the RTS. - - - - - 1 changed file: - compiler/cmm/PprC.hs Changes: ===================================== compiler/cmm/PprC.hs ===================================== @@ -812,7 +812,7 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "read_barrier" + MO_ReadBarrier -> text "load_load_barrier" MO_WriteBarrier -> text "write_barrier" MO_Memcpy _ -> text "memcpy" MO_Memset _ -> text "memset" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be692a3634f17a8e70e3f373c2f9e59ac919ac3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be692a3634f17a8e70e3f373c2f9e59ac919ac3d You're receiving 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 Jun 11 03:39:06 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:39:06 -0400 Subject: [Git][ghc/ghc][wip/T15208] llvm-targets: Add armv7l-unknown-linux-gnueabi Message-ID: <5cff225a568ea_6f73fe605db054420078e8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T15208 at Glasgow Haskell Compiler / GHC Commits: 96e6dac9 by Ben Gamari at 2019-06-11T03:39:01Z llvm-targets: Add armv7l-unknown-linux-gnueabi - - - - - 2 changed files: - llvm-targets - utils/llvm-targets/gen-data-layout.sh Changes: ===================================== llvm-targets ===================================== @@ -7,6 +7,7 @@ ,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7l-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ===================================== utils/llvm-targets/gen-data-layout.sh ===================================== @@ -24,6 +24,7 @@ TARGETS=( # Linux ARM "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "armv7l-unknown-linux-gnueabi" "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" # Linux x86 "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/96e6dac919246f10a23ebc35be29337229f3a691 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/96e6dac919246f10a23ebc35be29337229f3a691 You're receiving 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 Jun 11 03:39:22 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:39:22 -0400 Subject: [Git][ghc/ghc][wip/T15208] llvm-targets: Add armv7l-unknown-linux-gnueabi Message-ID: <5cff226a6fb31_6f73fe6083b195020084c5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T15208 at Glasgow Haskell Compiler / GHC Commits: 96dba75a by Ben Gamari at 2019-06-11T03:39:13Z llvm-targets: Add armv7l-unknown-linux-gnueabi [skip ci] - - - - - 2 changed files: - llvm-targets - utils/llvm-targets/gen-data-layout.sh Changes: ===================================== llvm-targets ===================================== @@ -7,6 +7,7 @@ ,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7l-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ===================================== utils/llvm-targets/gen-data-layout.sh ===================================== @@ -24,6 +24,7 @@ TARGETS=( # Linux ARM "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "armv7l-unknown-linux-gnueabi" "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" # Linux x86 "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/96dba75a4427ac989531e7b96518c63ca0d0844d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/96dba75a4427ac989531e7b96518c63ca0d0844d You're receiving 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 Jun 11 03:39:38 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:39:38 -0400 Subject: [Git][ghc/ghc][wip/T15208] llvm-targets: Add armv7l-unknown-linux-gnueabi Message-ID: <5cff227aebc85_6f73fe61e6c7d402009030@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T15208 at Glasgow Haskell Compiler / GHC Commits: 69068c90 by Ben Gamari at 2019-06-11T03:39:28Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - 2 changed files: - llvm-targets - utils/llvm-targets/gen-data-layout.sh Changes: ===================================== llvm-targets ===================================== @@ -7,6 +7,7 @@ ,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7l-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ===================================== utils/llvm-targets/gen-data-layout.sh ===================================== @@ -24,6 +24,7 @@ TARGETS=( # Linux ARM "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "armv7l-unknown-linux-gnueabi" "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" # Linux x86 "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69068c90a711abdd7c5459bcfd206b84dcbaf70f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/69068c90a711abdd7c5459bcfd206b84dcbaf70f You're receiving 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 Jun 11 03:50:03 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:50:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/circleci-cleanup Message-ID: <5cff24ebcc0e1_6f7d2f582020102a3@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/circleci-cleanup at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/circleci-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 Tue Jun 11 03:52:13 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 23:52:13 -0400 Subject: [Git][ghc/ghc][master] Comments only: document newtypes' DataConWrapId Message-ID: <5cff256da228d_6f73fe5fa12524420117b9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 1 changed file: - compiler/basicTypes/MkId.hs Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0345b1b0f62c8fac72d07a7b848d14b9893e9ac9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0345b1b0f62c8fac72d07a7b848d14b9893e9ac9 You're receiving 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 Jun 11 03:52:55 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 23:52:55 -0400 Subject: [Git][ghc/ghc][master] Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Message-ID: <5cff2597bb08_6f73fe5f02a056020146b0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 1 changed file: - hadrian/src/Rules/Compile.hs Changes: ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/58a5d728d0293110d7e80aa1f067721447b20882 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/58a5d728d0293110d7e80aa1f067721447b20882 You're receiving 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 Jun 11 03:53:31 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 10 Jun 2019 23:53:31 -0400 Subject: [Git][ghc/ghc][master] 2 commits: testsuite: Fix and extend closure_size test Message-ID: <5cff25bbbf3f6_6f73fe605db05442020650@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4 changed files: - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs Changes: ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/58a5d728d0293110d7e80aa1f067721447b20882...e5d275f45677ed89df310754973a15c522dc1003 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/58a5d728d0293110d7e80aa1f067721447b20882...e5d275f45677ed89df310754973a15c522dc1003 You're receiving 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 Jun 11 03:54:00 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 10 Jun 2019 23:54:00 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: gitlab-ci: Build alpine release bindists Message-ID: <5cff25d8d7c95_6f73fe6083b1950202227d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: fa0f6607 by Ben Gamari at 2019-06-11T03:52:02Z gitlab-ci: Build alpine release bindists - - - - - 42cb3248 by Ben Gamari at 2019-06-11T03:52:02Z XXX: Test alpine job - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: e09d9ede16065ac0237cf26274db4b774da02547 # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d5606ffbfccf5f124e29900de19892fea3b221b2...42cb3248985ad9c0675ad015f78abb590b9a8a2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d5606ffbfccf5f124e29900de19892fea3b221b2...42cb3248985ad9c0675ad015f78abb590b9a8a2e You're receiving 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 Jun 11 04:15:44 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 00:15:44 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: gitlab-ci: Build alpine release bindists Message-ID: <5cff2af0d97ef_6f7d2f582020234c1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 29cefea2 by Ben Gamari at 2019-06-11T04:15:37Z gitlab-ci: Build alpine release bindists - - - - - 36735b86 by Ben Gamari at 2019-06-11T04:15:37Z XXX: Test alpine job - - - - - 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: be61a2dec7eb4bc460eac9c0788c4d99671826f1 # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/42cb3248985ad9c0675ad015f78abb590b9a8a2e...36735b86d76decd1b84f57106c8d79e082e69e07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/42cb3248985ad9c0675ad015f78abb590b9a8a2e...36735b86d76decd1b84f57106c8d79e082e69e07 You're receiving 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 Jun 11 04:24:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 00:24:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Comments only: document newtypes' DataConWrapId Message-ID: <5cff2cfc8df2a_6f73fe605db054420265a0@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 5278d1a8 by Oleg Grenrus at 2019-06-11T04:24:18Z Add -Winferred-safe-imports warning This commit partly reverts e69619e923e84ae61a6bb4357f06862264daa94b commit by reintroducing Sf_SafeInferred SafeHaskellMode. We preserve whether module was declared or inferred Safe. When declared-Safe module imports inferred-Safe, we warn. This inferred status is volatile, often enough it's a happy coincidence, something which cannot be relied upon. However, explicitly Safe or Trustworthy packages won't accidentally become Unsafe. Updates haddock submodule. - - - - - a9bd5e24 by Oleg Grenrus at 2019-06-11T04:24:18Z Add -Wmissing-safe-haskell-mode warning - - - - - 1d3c656e by Alp Mestanogullari at 2019-06-11T04:24:21Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 16 changed files: - compiler/basicTypes/MkId.hs - compiler/main/DynFlags.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/typecheck/TcRnMonad.hs - docs/users_guide/safe_haskell.rst - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Test.hs - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - testsuite/mk/boilerplate.mk - testsuite/tests/plugins/T16260.stdout - testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout - utils/haddock Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== compiler/main/DynFlags.hs ===================================== @@ -911,6 +911,8 @@ data WarningFlag = | Opt_WarnSpaceAfterBang | Opt_WarnMissingDerivingStrategies -- Since 8.8 | Opt_WarnPrepositiveQualifiedModule -- Since TBD + | Opt_WarnInferredSafeImports -- Since 8.10 + | Opt_WarnMissingSafeHaskellMode -- Since 8.10 deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -921,11 +923,12 @@ instance Outputable Language where -- | The various Safe Haskell modes data SafeHaskellMode - = Sf_None - | Sf_Unsafe - | Sf_Trustworthy - | Sf_Safe - | Sf_Ignore + = Sf_None -- ^ inferred unsafe + | Sf_Unsafe -- ^ declared and checked + | Sf_Trustworthy -- ^ declared and checked + | Sf_Safe -- ^ declared and checked + | Sf_SafeInferred -- ^ inferred as safe + | Sf_Ignore -- ^ @-fno-safe-haskell@ state deriving (Eq) instance Show SafeHaskellMode where @@ -933,6 +936,7 @@ instance Show SafeHaskellMode where show Sf_Unsafe = "Unsafe" show Sf_Trustworthy = "Trustworthy" show Sf_Safe = "Safe" + show Sf_SafeInferred = "Safe-Inferred" show Sf_Ignore = "Ignore" instance Outputable SafeHaskellMode where @@ -3757,6 +3761,8 @@ dynamic_flags_deps = [ , make_ord_flag defFlag "fno-safe-infer" (noArg (\d -> d { safeInfer = False })) , make_ord_flag defFlag "fno-safe-haskell" (NoArg (setSafeHaskell Sf_Ignore)) + + ------ position independent flags ---------------------------------- , make_ord_flag defGhcFlag "fPIC" (NoArg (setGeneralFlag Opt_PIC)) , make_ord_flag defGhcFlag "fno-PIC" (NoArg (unSetGeneralFlag Opt_PIC)) , make_ord_flag defGhcFlag "fPIE" (NoArg (setGeneralFlag Opt_PIC)) @@ -4075,6 +4081,8 @@ wWarningFlagsDeps = [ flagSpec "all-missed-specializations" Opt_WarnAllMissedSpecs, flagSpec' "safe" Opt_WarnSafe setWarnSafe, flagSpec "trustworthy-safe" Opt_WarnTrustworthySafe, + flagSpec "inferred-safe-imports" Opt_WarnInferredSafeImports, + flagSpec "missing-safe-haskell-mode" Opt_WarnMissingSafeHaskellMode, flagSpec "tabs" Opt_WarnTabs, flagSpec "type-defaults" Opt_WarnTypeDefaults, flagSpec "typed-holes" Opt_WarnTypedHoles, ===================================== compiler/main/HscMain.hs ===================================== @@ -498,6 +498,14 @@ tcRnModule' sum save_rn_syntax mod = do hsc_env <- getHscEnv dflags <- getDynFlags + -- -Wmissing-safe-haskell-mode + when (not (safeHaskellModeEnabled dflags) + && wopt Opt_WarnMissingSafeHaskellMode dflags) $ + logWarnings $ unitBag $ + makeIntoWarning (Reason Opt_WarnMissingSafeHaskellMode) $ + mkPlainWarnMsg dflags (getLoc (hpm_module mod)) $ + warnMissingSafeHaskellMode + tcg_res <- {-# SCC "Typecheck-Rename" #-} ioMsgMaybe $ tcRnModule hsc_env sum @@ -542,6 +550,8 @@ tcRnModule' sum save_rn_syntax mod = do errSafe t = quotes (pprMod t) <+> text "has been inferred as safe!" errTwthySafe t = quotes (pprMod t) <+> text "is marked as Trustworthy but has been inferred as safe!" + warnMissingSafeHaskellMode = ppr (moduleName (ms_mod sum)) + <+> text "is missing Safe Haskell mode" -- | Convert a typechecked module to Core hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts @@ -1107,21 +1117,36 @@ hscCheckSafe' m l = do let trust = getSafeMode $ mi_trust iface' trust_own_pkg = mi_trust_pkg iface' -- check module is trusted - safeM = trust `elem` [Sf_Safe, Sf_Trustworthy] + safeM = trust `elem` [Sf_Safe, Sf_SafeInferred, Sf_Trustworthy] -- check package is trusted safeP = packageTrusted dflags trust trust_own_pkg m -- pkg trust reqs pkgRs = S.fromList . map fst $ filter snd $ dep_pkgs $ mi_deps iface' + -- warn if Safe module imports Safe-Inferred module. + warns = if wopt Opt_WarnInferredSafeImports dflags + && safeLanguageOn dflags + && trust == Sf_SafeInferred + then inferredImportWarn + else emptyBag -- General errors we throw but Safe errors we log errs = case (safeM, safeP) of (True, True ) -> emptyBag (True, False) -> pkgTrustErr (False, _ ) -> modTrustErr in do + logWarnings warns logWarnings errs return (trust == Sf_Trustworthy, pkgRs) where + inferredImportWarn = unitBag + $ makeIntoWarning (Reason Opt_WarnInferredSafeImports) + $ mkErrMsg dflags l (pkgQual dflags) + $ sep + [ text "Importing Safe-Inferred module " + <> ppr (moduleName m) + <> text " from explicitly Safe module" + ] pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $ sep [ ppr (moduleName m) <> text ": Can't be safely imported!" @@ -1144,6 +1169,7 @@ hscCheckSafe' m l = do packageTrusted dflags _ _ _ | not (packageTrustOn dflags) = True packageTrusted _ Sf_Safe False _ = True + packageTrusted _ Sf_SafeInferred False _ = True packageTrusted dflags _ _ m | isHomePkg dflags m = True | otherwise = trusted $ getPackageDetails dflags (moduleUnitId m) ===================================== compiler/main/HscTypes.hs ===================================== @@ -2949,6 +2949,7 @@ trustInfoToNum it Sf_Unsafe -> 1 Sf_Trustworthy -> 2 Sf_Safe -> 3 + Sf_SafeInferred -> 4 Sf_Ignore -> 0 numToTrustInfo :: Word8 -> IfaceTrustInfo @@ -2956,9 +2957,7 @@ numToTrustInfo 0 = setSafeMode Sf_None numToTrustInfo 1 = setSafeMode Sf_Unsafe numToTrustInfo 2 = setSafeMode Sf_Trustworthy numToTrustInfo 3 = setSafeMode Sf_Safe -numToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used - -- to be Sf_SafeInfered but we no longer - -- differentiate. +numToTrustInfo 4 = setSafeMode Sf_SafeInferred numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")" instance Outputable IfaceTrustInfo where @@ -2967,6 +2966,7 @@ instance Outputable IfaceTrustInfo where ppr (TrustInfo Sf_Unsafe) = text "unsafe" ppr (TrustInfo Sf_Trustworthy) = text "trustworthy" ppr (TrustInfo Sf_Safe) = text "safe" + ppr (TrustInfo Sf_SafeInferred) = text "safe-inferred" instance Binary IfaceTrustInfo where put_ bh iftrust = putByte bh $ trustInfoToNum iftrust ===================================== compiler/typecheck/TcRnMonad.hs ===================================== @@ -1837,13 +1837,13 @@ finalSafeMode :: DynFlags -> TcGblEnv -> IO SafeHaskellMode finalSafeMode dflags tcg_env = do safeInf <- fst <$> readIORef (tcg_safeInfer tcg_env) return $ case safeHaskell dflags of - Sf_None | safeInferOn dflags && safeInf -> Sf_Safe + Sf_None | safeInferOn dflags && safeInf -> Sf_SafeInferred | otherwise -> Sf_None s -> s -- | Switch instances to safe instances if we're in Safe mode. fixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst] -fixSafeInstances sfMode | sfMode /= Sf_Safe = id +fixSafeInstances sfMode | sfMode /= Sf_Safe && sfMode /= Sf_SafeInferred = id fixSafeInstances _ = map fixSafe where fixSafe inst = let new_flag = (is_flag inst) { isSafeOverlap = True } in inst { is_flag = new_flag } ===================================== docs/users_guide/safe_haskell.rst ===================================== @@ -739,7 +739,7 @@ And one general flag: requiring the package that ``M`` resides in be considered trusted, for ``M`` to be considered trusted. -And three warning flags: +And five warning flags: .. ghc-flag:: -Wunsafe :shortdesc: warn if the module being compiled is regarded to be unsafe. @@ -775,6 +775,55 @@ And three warning flags: -XSafe , a more informative bound. Can be used to detect once a Safe Haskell bound can be improved as dependencies are updated. +.. ghc-flag:: -Winferred-safe-imports + :shortdesc: warn when an explicitly Safe Haskell module imports a Safe-Inferred one + :type: dynamic + :reverse: -Wno-inferred-safe-imports + :category: + + :since: 8.10.1 + + .. index:: + single: safe haskell imports, warning + + The module ``A`` below is annotated to be explictly ``Safe``, but it imports + ``Safe-Inferred`` module. + + {-# LANGUAGE Safe #-} + module A where + + import B (double) + + quad :: Int -> Int + quad = double . double + + + module B where + + double :: Int -> Int + double n = n + n + + The inferred status is volatile: if an unsafe import is added to the module + ``B``, it will cause compilation error of ``A``. When + :ghc-flag:`-Winferred-safe-imports` is enabled, the compiler will emit a + warning about this. + This option is off by default. + +.. ghc-flag:: -Wmissing-safe-haskell-mode + :shortdesc: warn when the Safe Haskell mode is not explicitly specified. + :type: dynamic + :reverse: -Wno-missing-safe-haskell-mode + :category: + + :since: 8.10.1 + + .. index:: + single: safe haskell mode, missing + + The compiler will warn when none of :extension:`Safe`, + :extension:`Trustworthy` or :extension:`Unsafe` is specified. + This option is off by default. + .. _safe-compilation: Safe Compilation ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -122,7 +122,7 @@ testRules = do -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk -- which is in turn included by all test 'Makefile's. - setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + setEnv "ghc_config_mk" (top -/- root -/- ghcConfigPath) -- Execute the test target. -- We override the verbosity setting to make sure the user can see ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,17 +240,17 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) -ifeq "$(ghc-config-mk)" "" -ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk +ifeq "$(ghc_config_mk)" "" +ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk -$(ghc-config-mk) : $(TOP)/mk/ghc-config +$(ghc_config_mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" --include $(ghc-config-mk) +-include $(ghc_config_mk) endif # Note [WayFlags] ===================================== testsuite/tests/plugins/T16260.stdout ===================================== @@ -1,4 +1,4 @@ False None True -Safe +Safe-Inferred ===================================== testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout ===================================== @@ -4,42 +4,42 @@ pdb.safePkg01/local.db trusted: False M_SafePkg -package dependencies: base-4.12.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: base-4.13.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: False M_SafePkg2 -package dependencies: base-4.12.0.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: base-4.13.0.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False M_SafePkg3 -package dependencies: base-4.12.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: base-4.13.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: True M_SafePkg4 -package dependencies: base-4.12.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: base-4.13.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: True M_SafePkg5 -package dependencies: base-4.12.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 -trusted: safe +package dependencies: base-4.13.0.0* ghc-prim-0.6.1 integer-gmp-1.0.2.0 +trusted: safe-inferred require own pkg trusted: True M_SafePkg6 -package dependencies: array-0.5.2.0 base-4.12.0.0* bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: array-0.5.4.0 base-4.13.0.0* bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False M_SafePkg7 -package dependencies: array-0.5.2.0 base-4.12.0.0* bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: array-0.5.4.0 base-4.13.0.0* bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: False M_SafePkg8 -package dependencies: array-0.5.2.0 base-4.12.0.0 bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 +package dependencies: array-0.5.4.0 base-4.13.0.0 bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-prim-0.6.1 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 83bb9870a117f9426e6f6cff6fec3bb6e93a7c18 +Subproject commit 5e333bad752b9c048ad5400b7159e32f4d3d65bd View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/21f1960ddafc5b1f7c6bc6bb004ff45d24c74962...1d3c656ef5d3635bac84522e41d4ff59918e3632 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/21f1960ddafc5b1f7c6bc6bb004ff45d24c74962...1d3c656ef5d3635bac84522e41d4ff59918e3632 You're receiving 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 Jun 11 04:32:43 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 00:32:43 -0400 Subject: [Git][ghc/ghc][wip/fix-users-guide] users-guide: Fix a few markup issues Message-ID: <5cff2eeb92629_6f73fe605db054420366e1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-users-guide at Glasgow Haskell Compiler / GHC Commits: 785ce626 by Ben Gamari at 2019-06-11T04:32:22Z users-guide: Fix a few markup issues Strangely these were only causing the build to fail in the aarch64-linux job, despite Sphinx throwing errors in all jobs I checked. Also changes some `#ifdef`s to `#if defined` to satisfy the linter. - - - - - 2 changed files: - docs/users_guide/ffi-chap.rst - docs/users_guide/ghci.rst Changes: ===================================== docs/users_guide/ffi-chap.rst ===================================== @@ -87,7 +87,7 @@ Newtype wrapping of the IO monad The FFI spec requires the IO monad to appear in various places, but it can sometimes be convenient to wrap the IO monad in a ``newtype``, thus: :: - newtype MyIO a = MIO (IO a) + newtype MyIO a = MIO (IO a) (A reason for doing so might be to prevent the programmer from calling arbitrary IO procedures in some part of the program.) @@ -112,15 +112,15 @@ The type variables in the type of a foreign declaration may be quantified with an explicit ``forall`` by using the :extension:`ExplicitForAll` language extension, as in the following example: :: - {-# LANGUAGE ExplicitForAll #-} - foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a) + {-# LANGUAGE ExplicitForAll #-} + foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a) Note that an explicit ``forall`` must appear at the front of the type signature and is not permitted to appear nested within the type, as in the following (erroneous) examples: :: - foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a) - foreign import ccall quux :: (forall a. Ptr a) -> IO () + foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a) + foreign import ccall quux :: (forall a. Ptr a) -> IO () .. _ffi-prim: @@ -372,7 +372,7 @@ program. Here's the C code: #include #include "HsFFI.h" - #ifdef __GLASGOW_HASKELL__ + #if defined(__GLASGOW_HASKELL__) #include "Foo_stub.h" #endif @@ -391,7 +391,7 @@ program. Here's the C code: } We've surrounded the GHC-specific bits with -``#ifdef __GLASGOW_HASKELL__``; the rest of the code should be portable +``#if defined(__GLASGOW_HASKELL__)``; the rest of the code should be portable across Haskell implementations that support the FFI standard. The call to ``hs_init()`` initializes GHC's runtime system. Do NOT try @@ -435,7 +435,7 @@ GHC-specific API instead of ``hs_init()``: #include #include "HsFFI.h" - #ifdef __GLASGOW_HASKELL__ + #if defined(__GLASGOW_HASKELL__) #include "Foo_stub.h" #include "Rts.h" #endif ===================================== docs/users_guide/ghci.rst ===================================== @@ -2582,21 +2582,22 @@ commonly used commands. For example: .. code-block:: none - >:instances Maybe (Maybe Int) - instance Eq (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ - instance Ord (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ - instance Show (Maybe (Maybe Int)) -- Defined in ‘GHC.Show’ - instance Read (Maybe (Maybe Int)) -- Defined in ‘GHC.Read’ - - >:set -XPartialTypeSignatures -fno-warn-partial-type-signatures - - >:instances Maybe _ - instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ - instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ - instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ - instance Semigroup _ => Semigroup (Maybe _) -- Defined in ‘GHC.Base’ - instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ - instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ + + > :instances Maybe (Maybe Int) + instance Eq (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Ord (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’ + instance Show (Maybe (Maybe Int)) -- Defined in ‘GHC.Show’ + instance Read (Maybe (Maybe Int)) -- Defined in ‘GHC.Read’ + + > :set -XPartialTypeSignatures -fno-warn-partial-type-signatures + + > :instances Maybe _ + instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’ + instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’ + instance Semigroup _ => Semigroup (Maybe _) -- Defined in ‘GHC.Base’ + instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’ + instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’ .. ghci-cmd:: :main; ⟨arg1⟩ ... ⟨argn⟩ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/785ce6263367184ea5251cd9f5784e23d9b349d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/785ce6263367184ea5251cd9f5784e23d9b349d3 You're receiving 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 Jun 11 04:45:26 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 00:45:26 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cff31e674e13_6f7536c98c20416c0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 5aa4b8e4 by Ben Gamari at 2019-06-11T04:45:09Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. - - - - - 5 changed files: - compiler/prelude/PrelRules.hs - testsuite/tests/codeGen/should_run/T16449_2.hs - − testsuite/tests/codeGen/should_run/T16449_2.stderr - + testsuite/tests/codeGen/should_run/T16449_2.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ Lit $ mkLitNumberWrap dflags LitNumInt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior and transform the invalid shift into an "obviously +incorrect" value. There are two cases: ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -5,5 +5,9 @@ module Main where import GHC.Prim import GHC.Int +-- Test that large unchecked shifts, which constitute undefined behavior, do +-- not crash the compiler and instead evaluate to 0. +-- See Note [Guarding against silly shifts] in PrelRules. + -- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr deleted ===================================== @@ -1 +0,0 @@ -T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/T16449_2.stdout ===================================== @@ -0,0 +1,2 @@ +0 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -196,4 +196,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', exit_code(0), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5aa4b8e4c2939b73392cf8b5394a8c09e352027e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5aa4b8e4c2939b73392cf8b5394a8c09e352027e You're receiving 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 Jun 11 04:53:27 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 00:53:27 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: base/Event/Poll: Drop POLLRDHUP enum item Message-ID: <5cff33c7a3918_6f7d2f5820204427d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 59a5b904 by Ben Gamari at 2019-06-11T04:53:22Z base/Event/Poll: Drop POLLRDHUP enum item Previously the Event enumeration produced by hsc2hs would sometimes include a currently-unused POLLRDHUP item. This unused binding would result in a build failure. Drop it. - - - - - b6b82027 by Ben Gamari at 2019-06-11T04:53:22Z XXX: Test alpine job - - - - - 2 changed files: - .gitlab-ci.yml - libraries/base/GHC/Event/Poll.hsc Changes: ===================================== .gitlab-ci.yml ===================================== @@ -541,7 +541,7 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: extends: .validate-linux - stage: full-build + stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" variables: BUILD_SPHINX_PDF: "NO" @@ -549,8 +549,6 @@ release-x86_64-linux-alpine: BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - only: - - tags cache: key: linux-x86_64-alpine artifacts: ===================================== libraries/base/GHC/Event/Poll.hsc ===================================== @@ -162,24 +162,12 @@ newtype Event = Event CShort , FiniteBits -- ^ @since 4.7.0.0 ) --- We have to duplicate the whole enum like this in order for the --- hsc2hs cross-compilation mode to work -#if defined(POLLRDHUP) #{enum Event, Event , pollIn = POLLIN , pollOut = POLLOUT - , pollRdHup = POLLRDHUP , pollErr = POLLERR , pollHup = POLLHUP } -#else -#{enum Event, Event - , pollIn = POLLIN - , pollOut = POLLOUT - , pollErr = POLLERR - , pollHup = POLLHUP - } -#endif fromEvent :: E.Event -> Event fromEvent e = remap E.evtRead pollIn .|. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/36735b86d76decd1b84f57106c8d79e082e69e07...b6b8202744b8aea160fae39d977b04ad32f4f3a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/36735b86d76decd1b84f57106c8d79e082e69e07...b6b8202744b8aea160fae39d977b04ad32f4f3a5 You're receiving 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 Jun 11 04:57:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 00:57:21 -0400 Subject: [Git][ghc/ghc][wip/T16728] 9 commits: base: Mark CPUTime001 as fragile Message-ID: <5cff34b19789e_6f73fe5fa12524420448b0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16728 at Glasgow Haskell Compiler / GHC Commits: 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4b4d034f by Simon Peyton Jones at 2019-06-11T04:57:11Z Fix two places that failed the substitution invariant The substition invariant relies on keeping the in-scope set in sync, and we weren't always doing so, which means that a DEBUG compiler crashes sometimes with an assertion failure This patch fixes a couple more cases. Still not validate clean (with -DEEBUG) but closer! - - - - - cc962b22 by Simon Peyton Jones at 2019-06-11T04:57:11Z Fix typechecking of partial type signatures Partial type sigs had grown hair. tcHsParialSigType was doing lots of unnecessary work, and tcInstSig was cloning it unnecessarily -- and the result didn't even work: #16728. This patch cleans it all up, described by TcHsType Note [Checking parital type signatures] I basically just deleted code... but very carefully! Some refactoring along the way * Distinguish more explicintly between "anonymous" wildcards "_" and "named" wildcards "_a". I changed the names of a number of functions to make this distinction much more apparent. The patch also revealed that the code in `TcExpr` that implements the special typing rule for `($)` was wrong. It called `getRuntimeRep` in a situation where where was no particular reason to suppose that the thing had kind `TYPE r`. This caused a crash in typecheck/should_run/T10846. The fix was easy, and actually simplifies the code in `TcExpr` quite a bit. Hooray. - - - - - 322276e0 by Simon Peyton Jones at 2019-06-11T04:57:11Z Comments and tiny refactor * Added Note [Quantified varaibles in partial type signatures] in TcRnTypes * Kill dVarSetElemsWellScoped; it was only called in one function, quantifyTyVars. I inlined it because it was only scopedSort . dVarSetElems * Kill Type.tyCoVarsOfBindersWellScoped, never called. - - - - - 30 changed files: - compiler/basicTypes/MkId.hs - compiler/hsSyn/HsDecls.hs - compiler/rename/RnTypes.hs - compiler/typecheck/Inst.hs - compiler/typecheck/TcBinds.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnMonad.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSigs.hs - compiler/typecheck/TcType.hs - compiler/types/Type.hs - hadrian/src/Rules/Compile.hs - libraries/base/tests/all.T - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - + testsuite/tests/partial-sigs/should_compile/T16728.hs - + testsuite/tests/partial-sigs/should_compile/T16728.stderr - + testsuite/tests/partial-sigs/should_compile/T16728a.hs - + testsuite/tests/partial-sigs/should_compile/T16728a.stderr - + testsuite/tests/partial-sigs/should_compile/T16728b.hs - + testsuite/tests/partial-sigs/should_compile/T16728b.stderr - testsuite/tests/partial-sigs/should_compile/all.T - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - + testsuite/tests/roles/should_compile/T16718.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/df9a853a1aa58a8d5eb713920605ac651ed64eda...322276e0f1d16dc94579c6b4f2e18f765167a29d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/df9a853a1aa58a8d5eb713920605ac651ed64eda...322276e0f1d16dc94579c6b4f2e18f765167a29d You're receiving 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 Jun 11 05:09:07 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 01:09:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Fix #16525: ObjectCode freed wrongly because of lack of info header check Message-ID: <5cff3773f184c_6f73fe611d451d4206931b@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0a68dfeb by Phuong Trinh at 2019-06-11T05:09:02Z Fix #16525: ObjectCode freed wrongly because of lack of info header check `checkUnload` currently doesn't check the info header of static objects. Thus, it may free an `ObjectCode` struct wrongly even if there's still a live static object whose info header lies in a mapped section of that `ObjectCode`. This fixes the issue by adding an appropriate check. - - - - - 20203f19 by Alp Mestanogullari at 2019-06-11T05:09:04Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 10 changed files: - hadrian/src/Rules/Test.hs - rts/CheckUnload.c - rts/Linker.c - rts/linker/M32Alloc.c - testsuite/mk/boilerplate.mk - + testsuite/tests/ghci/T16525a/A.hs - + testsuite/tests/ghci/T16525a/B.hs - + testsuite/tests/ghci/T16525a/T16525a.script - + testsuite/tests/ghci/T16525a/T16525a.stdout - + testsuite/tests/ghci/T16525a/all.T Changes: ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -122,7 +122,7 @@ testRules = do -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk -- which is in turn included by all test 'Makefile's. - setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + setEnv "ghc_config_mk" (top -/- root -/- ghcConfigPath) -- Execute the test target. -- We override the verbosity setting to make sure the user can see ===================================== rts/CheckUnload.c ===================================== @@ -404,6 +404,7 @@ void checkUnload (StgClosure *static_objects) p = UNTAG_STATIC_LIST_PTR(p); checkAddress(addrs, p, s_indices); info = get_itbl(p); + checkAddress(addrs, info); link = *STATIC_LINK(info, p); } ===================================== rts/Linker.c ===================================== @@ -1176,11 +1176,17 @@ void freeObjectCode (ObjectCode *oc) oc->sections[i].mapped_size); break; case SECTION_M32: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); m32_free(oc->sections[i].start, oc->sections[i].size); break; #endif case SECTION_MALLOC: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); stgFree(oc->sections[i].start); break; default: ===================================== rts/linker/M32Alloc.c ===================================== @@ -24,7 +24,7 @@ Note [Compile Time Trickery] This file implements two versions of each of the `m32_*` functions. At the top of the file there is the real implementation (compiled in when `RTS_LINKER_USE_MMAP` is true) and a dummy implementation that exists only to -satisfy the compiler and which hould never be called. If any of these dummy +satisfy the compiler and which should never be called. If any of these dummy implementations are called the program will abort. The rationale for this is to allow the calling code to be written without using ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,17 +240,17 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) -ifeq "$(ghc-config-mk)" "" -ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk +ifeq "$(ghc_config_mk)" "" +ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk -$(ghc-config-mk) : $(TOP)/mk/ghc-config +$(ghc_config_mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" --include $(ghc-config-mk) +-include $(ghc_config_mk) endif # Note [WayFlags] ===================================== testsuite/tests/ghci/T16525a/A.hs ===================================== @@ -0,0 +1,12 @@ +module A where + +import B + +myIntVal :: Int +myIntVal = sum [1,2,3,4] + +value :: [Value] +value = [Value "a;lskdfa;lszkfsd;alkfjas" myIntVal] + +v1 :: Value -> String +v1 (Value a _) = a ===================================== testsuite/tests/ghci/T16525a/B.hs ===================================== @@ -0,0 +1,3 @@ +module B where + +data Value = Value String Int ===================================== testsuite/tests/ghci/T16525a/T16525a.script ===================================== @@ -0,0 +1,6 @@ +:set -fobject-code +:load A +import Control.Concurrent +_ <- forkIO $ threadDelay 1000000 >> (print (map v1 value)) +:l [] +System.Mem.performGC ===================================== testsuite/tests/ghci/T16525a/T16525a.stdout ===================================== ===================================== testsuite/tests/ghci/T16525a/all.T ===================================== @@ -0,0 +1,5 @@ +test('T16525a', + [extra_files(['A.hs', 'B.hs', ]), + extra_run_opts('+RTS -DS -RTS'), + when(ghc_dynamic(), skip), ], + ghci_script, ['T16525a.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1d3c656ef5d3635bac84522e41d4ff59918e3632...20203f193dc5e3f81ddeb9ec64ed5787b58e94fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1d3c656ef5d3635bac84522e41d4ff59918e3632...20203f193dc5e3f81ddeb9ec64ed5787b58e94fc You're receiving 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 Jun 11 05:12:42 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 01:12:42 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 32 commits: Comments only: document newtypes' DataConWrapId Message-ID: <5cff384a6beaf_6f7536c98c20741c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - dc2dbc74 by Ben Gamari at 2019-06-11T05:10:31Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 2be6a695 by Ben Gamari at 2019-06-11T05:10:31Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) - - - - - ac14154e by Ben Gamari at 2019-06-11T05:10:31Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - 5b1263aa by Ben Gamari at 2019-06-11T05:10:31Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - db013e8b by Ben Gamari at 2019-06-11T05:10:31Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 341e278d by Ben Gamari at 2019-06-11T05:10:31Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - efd6368f by Ben Gamari at 2019-06-11T05:10:44Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - d1b73ef3 by Ben Gamari at 2019-06-11T05:10:45Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 8ce526dc by Ben Gamari at 2019-06-11T05:10:45Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 3339bb68 by Ben Gamari at 2019-06-11T05:10:45Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - b45fae47 by Ben Gamari at 2019-06-11T05:10:45Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 7e67186e by Ben Gamari at 2019-06-11T05:10:45Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - bc597885 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 212c725c by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 963e3ba1 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Fix fragile_for test modifier - - - - - 8b3b9564 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 1c8eaee6 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 1e39638b by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - 691714f4 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 6c08a515 by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - 090385ff by Ben Gamari at 2019-06-11T05:10:53Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 949cc87a by Ben Gamari at 2019-06-11T05:11:58Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - 348bac59 by Ben Gamari at 2019-06-11T05:12:34Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 17561d0e by Ben Gamari at 2019-06-11T05:12:34Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 5ef86d21 by Ben Gamari at 2019-06-11T05:12:34Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - a645f5d5 by Ben Gamari at 2019-06-11T05:12:34Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - cab147e5 by Ben Gamari at 2019-06-11T05:12:35Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - b4ef27bb by Ben Gamari at 2019-06-11T05:12:35Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/basicTypes/MkId.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/Cabal - libraries/base/tests/all.T - libraries/binary - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - libraries/process - libraries/terminfo - libraries/time - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6d4c87523a635d447e7a0e20f4708eca4b35f39d...b4ef27bb15edb9cf2ab0e06704f2646c5101add0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6d4c87523a635d447e7a0e20f4708eca4b35f39d...b4ef27bb15edb9cf2ab0e06704f2646c5101add0 You're receiving 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 Jun 11 05:16:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 01:16:25 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5cff3929b3ecc_6f73fe605db05442074938@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 6f76f041 by Ben Gamari at 2019-06-11T05:16:16Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. - - - - - 5 changed files: - compiler/prelude/PrelRules.hs - testsuite/tests/codeGen/should_run/T16449_2.hs - − testsuite/tests/codeGen/should_run/T16449_2.stderr - + testsuite/tests/codeGen/should_run/T16449_2.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ Lit $ mkLitNumberWrap dflags LitNumInt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,23 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +Consequently we instead take advantage of the fact that large shifts are +undefined behavior (see associated documentation in primops.txt.pp) and +transform the invalid shift into an "obviously incorrect" value. There are two cases: ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -5,5 +5,9 @@ module Main where import GHC.Prim import GHC.Int +-- Test that large unchecked shifts, which constitute undefined behavior, do +-- not crash the compiler and instead evaluate to 0. +-- See Note [Guarding against silly shifts] in PrelRules. + -- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr deleted ===================================== @@ -1 +0,0 @@ -T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/T16449_2.stdout ===================================== @@ -0,0 +1,2 @@ +0 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -196,4 +196,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', exit_code(0), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f76f041ba358fd25435b47b588878bd2cabbe89 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f76f041ba358fd25435b47b588878bd2cabbe89 You're receiving 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 Jun 11 10:39:32 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 06:39:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Fix #16525: ObjectCode freed wrongly because of lack of info header check Message-ID: <5cff84e49dc56_6f73fe5e12b78a0215484@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6c7d73c8 by Phuong Trinh at 2019-06-11T10:39:17Z Fix #16525: ObjectCode freed wrongly because of lack of info header check `checkUnload` currently doesn't check the info header of static objects. Thus, it may free an `ObjectCode` struct wrongly even if there's still a live static object whose info header lies in a mapped section of that `ObjectCode`. This fixes the issue by adding an appropriate check. - - - - - d277632e by Alec Theriault at 2019-06-11T10:39:19Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 637c5388 by Alp Mestanogullari at 2019-06-11T10:39:20Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 7baef20f by Alp Mestanogullari at 2019-06-11T10:39:21Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - 27d31a3b by Ömer Sinan Ağacan at 2019-06-11T10:39:26Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - 13d8adec by Alp Mestanogullari at 2019-06-11T10:39:27Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 15 changed files: - docs/users_guide/phases.rst - hadrian/src/Rules/Test.hs - includes/rts/Config.h - rts/CheckUnload.c - rts/Linker.c - rts/RtsFlags.c - rts/linker/M32Alloc.c - testsuite/mk/boilerplate.mk - + testsuite/tests/ghci/T16525a/A.hs - + testsuite/tests/ghci/T16525a/B.hs - + testsuite/tests/ghci/T16525a/T16525a.script - + testsuite/tests/ghci/T16525a/T16525a.stdout - + testsuite/tests/ghci/T16525a/all.T - testsuite/tests/haddock/haddock_testsuite/Makefile - testsuite/tests/haddock/haddock_testsuite/all.T Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -365,7 +365,7 @@ defined by your local GHC installation, the following trick is useful: .. code-block:: c - #ifdef MIN_VERSION_GLASGOW_HASKELL + #if defined(MIN_VERSION_GLASGOW_HASKELL) #if MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) /* code that applies only to GHC 7.10.2 or later */ #endif ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -122,7 +122,7 @@ testRules = do -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk -- which is in turn included by all test 'Makefile's. - setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + setEnv "ghc_config_mk" (top -/- root -/- ghcConfigPath) -- Execute the test target. -- We override the verbosity setting to make sure the user can see ===================================== includes/rts/Config.h ===================================== @@ -26,11 +26,15 @@ #define USING_LIBBFD 1 #endif -/* DEBUG implies TRACING and TICKY_TICKY */ -#if defined(DEBUG) +/* DEBUG and PROFILING both imply TRACING */ +#if defined(DEBUG) || defined(PROFILING) #if !defined(TRACING) #define TRACING #endif +#endif + +/* DEBUG implies TICKY_TICKY */ +#if defined(DEBUG) #if !defined(TICKY_TICKY) #define TICKY_TICKY #endif ===================================== rts/CheckUnload.c ===================================== @@ -335,7 +335,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd, break; default: - barf("heapCensus, unknown object: %d", info->type); + barf("searchHeapBlocks, unknown object: %d", info->type); } if (!prim) { @@ -404,6 +404,7 @@ void checkUnload (StgClosure *static_objects) p = UNTAG_STATIC_LIST_PTR(p); checkAddress(addrs, p, s_indices); info = get_itbl(p); + checkAddress(addrs, info); link = *STATIC_LINK(info, p); } ===================================== rts/Linker.c ===================================== @@ -1176,11 +1176,17 @@ void freeObjectCode (ObjectCode *oc) oc->sections[i].mapped_size); break; case SECTION_M32: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); m32_free(oc->sections[i].start, oc->sections[i].size); break; #endif case SECTION_MALLOC: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); stgFree(oc->sections[i].start); break; default: ===================================== rts/RtsFlags.c ===================================== @@ -830,7 +830,7 @@ error = true; # define TRACING_BUILD_ONLY(x) x #else # define TRACING_BUILD_ONLY(x) \ -errorBelch("the flag %s requires the program to be built with -eventlog or -debug", \ +errorBelch("the flag %s requires the program to be built with -eventlog, -prof or -debug", \ rts_argv[arg]); \ error = true; #endif ===================================== rts/linker/M32Alloc.c ===================================== @@ -24,7 +24,7 @@ Note [Compile Time Trickery] This file implements two versions of each of the `m32_*` functions. At the top of the file there is the real implementation (compiled in when `RTS_LINKER_USE_MMAP` is true) and a dummy implementation that exists only to -satisfy the compiler and which hould never be called. If any of these dummy +satisfy the compiler and which should never be called. If any of these dummy implementations are called the program will abort. The rationale for this is to allow the calling code to be written without using ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,17 +240,17 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) -ifeq "$(ghc-config-mk)" "" -ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk +ifeq "$(ghc_config_mk)" "" +ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk -$(ghc-config-mk) : $(TOP)/mk/ghc-config +$(ghc_config_mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" --include $(ghc-config-mk) +-include $(ghc_config_mk) endif # Note [WayFlags] ===================================== testsuite/tests/ghci/T16525a/A.hs ===================================== @@ -0,0 +1,12 @@ +module A where + +import B + +myIntVal :: Int +myIntVal = sum [1,2,3,4] + +value :: [Value] +value = [Value "a;lskdfa;lszkfsd;alkfjas" myIntVal] + +v1 :: Value -> String +v1 (Value a _) = a ===================================== testsuite/tests/ghci/T16525a/B.hs ===================================== @@ -0,0 +1,3 @@ +module B where + +data Value = Value String Int ===================================== testsuite/tests/ghci/T16525a/T16525a.script ===================================== @@ -0,0 +1,6 @@ +:set -fobject-code +:load A +import Control.Concurrent +_ <- forkIO $ threadDelay 1000000 >> (print (map v1 value)) +:l [] +System.Mem.performGC ===================================== testsuite/tests/ghci/T16525a/T16525a.stdout ===================================== ===================================== testsuite/tests/ghci/T16525a/all.T ===================================== @@ -0,0 +1,5 @@ +test('T16525a', + [extra_files(['A.hs', 'B.hs', ]), + extra_run_opts('+RTS -DS -RTS'), + when(ghc_dynamic(), skip), ], + ghci_script, ['T16525a.script']) ===================================== testsuite/tests/haddock/haddock_testsuite/Makefile ===================================== @@ -24,6 +24,7 @@ htmlTest: $(haddockTest) \ $(TOP)/../utils/haddock/html-test/Main.hs ./html-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -39,6 +40,7 @@ latexTest: $(haddockTest) \ $(TOP)/../utils/haddock/latex-test/Main.hs ./latex-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -54,6 +56,7 @@ hoogleTest: $(haddockTest) \ $(TOP)/../utils/haddock/hoogle-test/Main.hs ./hoogle-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -69,6 +72,7 @@ hypsrcTest: $(haddockTest) \ $(TOP)/../utils/haddock/hypsrc-test/Main.hs ./hypsrc-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log ===================================== testsuite/tests/haddock/haddock_testsuite/all.T ===================================== @@ -1,19 +1,21 @@ +accept = 'ACCEPT=--accept' if config.accept else 'ACCEPT=""' + test('haddockHtmlTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['htmlTest']) + ['htmlTest ' + accept]) test('haddockLatexTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['latexTest']) + ['latexTest ' + accept]) test('haddockHoogleTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['hoogleTest']) + ['hoogleTest ' + accept]) test('haddockHypsrcTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['hypsrcTest']) + ['hypsrcTest ' + accept]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20203f193dc5e3f81ddeb9ec64ed5787b58e94fc...13d8adec0022b018696a26b65df775a99e641701 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/20203f193dc5e3f81ddeb9ec64ed5787b58e94fc...13d8adec0022b018696a26b65df775a99e641701 You're receiving 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 Jun 11 13:55:12 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 11 Jun 2019 09:55:12 -0400 Subject: [Git][ghc/ghc][wip/hadrian-librts-symlinks] 54 commits: Add GHCi :instances command Message-ID: <5cffb2c077a33_6f73fe6083dc2f42199915@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/hadrian-librts-symlinks at Glasgow Haskell Compiler / GHC Commits: 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 1cf4dafb by David Eichmann at 2019-06-11T13:49:04Z Hadrian: Track RTS library symlink targets This requires creating RTS library symlinks when registering, outside of the rule for the registered library file. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/MkId.hs - compiler/basicTypes/NameEnv.hs - compiler/cmm/CmmMachOp.hs - compiler/cmm/MkGraph.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmForeign.hs - compiler/codeGen/StgCmmPrim.hs - compiler/deSugar/Check.hs - compiler/deSugar/DsMonad.hs - compiler/deSugar/ExtractDocs.hs - compiler/deSugar/PmExpr.hs - + compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/ghci/LinkerTypes.hs - compiler/hsSyn/HsDecls.hs - compiler/llvmGen/LlvmCodeGen/CodeGen.hs - compiler/main/DriverPipeline.hs - compiler/main/GHC.hs - compiler/main/HscMain.hs - compiler/main/HscTypes.hs - compiler/main/InteractiveEval.hs - compiler/main/Packages.hs - compiler/main/SysTools/BaseDir.hs - compiler/nativeGen/PPC/CodeGen.hs - compiler/nativeGen/SPARC/CodeGen.hs - compiler/nativeGen/X86/CodeGen.hs - compiler/prelude/PrelInfo.hs - compiler/prelude/primops.txt.pp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d9db26c147389164484d90a5ca5a832e67ca1f62...1cf4dafbf60159ae48f8373a0434ae7d9a700484 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d9db26c147389164484d90a5ca5a832e67ca1f62...1cf4dafbf60159ae48f8373a0434ae7d9a700484 You're receiving 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 Jun 11 13:56:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 09:56:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16798 Message-ID: <5cffb3101f878_6f73fe61e8072a022012f4@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T16798 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T16798 You're receiving 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 Jun 11 13:58:08 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 09:58:08 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5cffb37060199_6f73fe60ccec81822027b3@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 5ead7a09 by Ben Gamari at 2019-06-11T13:57:51Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 5 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,26 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat']))), + extra_files(['enum_processor.py']), + when(opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.bat'))), + when(not opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.py'))) + ], + compile_and_run, + ['']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5ead7a09f17019d7d171c4213cc41a065082e96f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5ead7a09f17019d7d171c4213cc41a065082e96f You're receiving 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 Jun 11 14:00:31 2019 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 11 Jun 2019 10:00:31 -0400 Subject: [Git][ghc/ghc][wip/hadrian-librts-symlinks] Hadrian: Track RTS library symlink targets Message-ID: <5cffb3ffc0090_6f73fe6054f39242203362@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/hadrian-librts-symlinks at Glasgow Haskell Compiler / GHC Commits: fb7051c4 by David Eichmann at 2019-06-11T14:00:14Z Hadrian: Track RTS library symlink targets This requires creating RTS library symlinks when registering, outside of the rule for the registered library file. - - - - - 5 changed files: - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -16,7 +16,7 @@ module Hadrian.Utilities ( BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, -- * File system operations - copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile, + copyFile, copyFileUntracked, createFileLink, fixFile, makeExecutable, moveFile, removeFile, createDirectory, copyDirectory, moveDirectory, removeDirectory, @@ -290,17 +290,6 @@ infixl 1 <&> isGeneratedSource :: FilePath -> Action Bool isGeneratedSource file = buildRoot <&> (`isPrefixOf` file) --- | Link a file (without tracking the link target). Create the target directory --- if missing. -createFileLinkUntracked :: FilePath -> FilePath -> Action () -createFileLinkUntracked linkTarget link = do - let dir = takeDirectory link - liftIO $ IO.createDirectoryIfMissing True dir - putProgressInfo =<< renderCreateFileLink linkTarget link - quietly . liftIO $ do - IO.removeFile link <|> return () - IO.createFileLink linkTarget link - -- | Link a file tracking the link target. Create the target directory if -- missing. createFileLink :: FilePath -> FilePath -> Action () @@ -309,7 +298,12 @@ createFileLink linkTarget link = do then linkTarget else takeDirectory link -/- linkTarget need [source] - createFileLinkUntracked linkTarget link + let dir = takeDirectory link + liftIO $ IO.createDirectoryIfMissing True dir + putProgressInfo =<< renderCreateFileLink linkTarget link + quietly . liftIO $ do + IO.removeFile link <|> return () + IO.createFileLink linkTarget link -- | Copy a file tracking the source. Create the target directory if missing. copyFile :: FilePath -> FilePath -> Action () ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -11,7 +11,7 @@ import Expression hiding (way, package) import Oracles.ModuleFiles import Packages import Rules.Gmp -import Rules.Rts (needRtsLibffiTargets) +import Rules.Register import Target import Utilities @@ -85,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do dynlib <- parsePath (parseBuildLibDyn root suffix) "" dynlibpath let context = libDynContext dynlib deps <- contextDependencies context - need =<< mapM pkgRegisteredLibraryFile deps + registerPackages deps objs <- libraryObjects context build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath] @@ -144,28 +144,6 @@ libraryObjects context at Context{..} = do need $ noHsObjs ++ hsObjs return (noHsObjs ++ hsObjs) --- | Return extra library targets. -extraTargets :: Context -> Action [FilePath] -extraTargets context - | package context == rts = needRtsLibffiTargets (Context.stage context) - | otherwise = return [] - --- | Given a library 'Package' this action computes all of its targets. Needing --- all the targets should build the library such that it is ready to be --- registered into the package database. --- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. -libraryTargets :: Bool -> Context -> Action [FilePath] -libraryTargets includeGhciLib context at Context {..} = do - libFile <- pkgLibraryFile context - ghciLib <- pkgGhciLibraryFile context - ghci <- if includeGhciLib && not (wayUnit Dynamic way) - then interpretInContext context $ getContextData buildGhciLib - else return False - extra <- extraTargets context - return $ [ libFile ] - ++ [ ghciLib | ghci ] - ++ extra - -- | Coarse-grain 'need': make sure all given libraries are fully built. needLibrary :: [Context] -> Action () needLibrary cs = need =<< concatMapM (libraryTargets True) cs @@ -270,4 +248,4 @@ parseLibDynFilename ext = do -- | Get the package identifier given the package name and version. pkgId :: String -> [Integer] -> String -pkgId name version = name ++ "-" ++ intercalate "." (map show version) \ No newline at end of file +pkgId name version = name ++ "-" ++ intercalate "." (map show version) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -15,6 +15,7 @@ import Settings.Default import Target import Utilities import Rules.Library +import Rules.Register -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () @@ -96,8 +97,7 @@ buildProgram bin ctx@(Context{..}) rs = do -- but when building the program, we link against the *ghc-pkg registered* library e.g. -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so -- so we use pkgRegisteredLibraryFile instead. - need =<< mapM pkgRegisteredLibraryFile - =<< contextDependencies ctx + registerPackages =<< contextDependencies ctx cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,7 +1,11 @@ -module Rules.Register (configurePackageRules, registerPackageRules) where +module Rules.Register ( + configurePackageRules, registerPackageRules, registerPackages, + libraryTargets + ) where import Base import Context +import Expression ( getContextData ) import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal @@ -12,7 +16,9 @@ import Rules.Rts import Settings import Target import Utilities -import Rules.Library + +import Hadrian.Haskell.Cabal.Type +import qualified Text.Parsec as Parsec import Distribution.Version (Version) import qualified Distribution.Parsec as Cabal @@ -21,7 +27,6 @@ import qualified Distribution.Types.PackageId as Cabal import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO -import qualified Text.Parsec as Parsec -- * Configuring @@ -63,6 +68,15 @@ parseToBuildSubdirectory root = do -- * Registering +registerPackages :: [Context] -> Action () +registerPackages ctxs = do + need =<< mapM pkgRegisteredLibraryFile ctxs + + -- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). + forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do + ways <- interpretInContext ctx (getLibraryWays <> getRtsWays) + needRtsSymLinks (stage ctx) ways + -- | Register a package and initialise the corresponding package database if -- need be. Note that we only register packages in 'Stage0' and 'Stage1'. registerPackageRules :: [(Resource, Int)] -> Stage -> Rules () @@ -118,9 +132,6 @@ buildConf _ context at Context {..} conf = do Cabal.copyPackage context Cabal.registerPackage context - -- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). - when (package == rts) (needRtsSymLinks stage ways) - -- The above two steps produce an entry in the package database, with copies -- of many of the files we have build, e.g. Haskell interface files. We need -- to record this side effect so that Shake can cache these files too. @@ -171,3 +182,25 @@ parseCabalName = fmap f . Cabal.eitherParsec where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + +-- | Return extra library targets. +extraTargets :: Context -> Action [FilePath] +extraTargets context + | package context == rts = needRtsLibffiTargets (Context.stage context) + | otherwise = return [] + +-- | Given a library 'Package' this action computes all of its targets. Needing +-- all the targets should build the library such that it is ready to be +-- registered into the package database. +-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter. +libraryTargets :: Bool -> Context -> Action [FilePath] +libraryTargets includeGhciLib context at Context {..} = do + libFile <- pkgLibraryFile context + ghciLib <- pkgGhciLibraryFile context + ghci <- if includeGhciLib && not (wayUnit Dynamic way) + then interpretInContext context $ getContextData buildGhciLib + else return False + extra <- extraTargets context + return $ [ libFile ] + ++ [ ghciLib | ghci ] + ++ extra ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -17,7 +17,7 @@ rtsRules = priority 3 $ do root -/- "//libHSrts_*-ghc*.dylib", root -/- "//libHSrts-ghc*.so", root -/- "//libHSrts-ghc*.dylib"] - |%> \ rtsLibFilePath' -> createFileLinkUntracked + |%> \ rtsLibFilePath' -> createFileLink (addRtsDummyVersion $ takeFileName rtsLibFilePath') rtsLibFilePath' @@ -175,4 +175,4 @@ replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let (error $ "Expected RTS library file to start with " ++ oldPrefix) (newPrefix ++) (stripPrefix oldPrefix oldFileName) - in replaceFileName oldFilePath newFileName \ No newline at end of file + in replaceFileName oldFilePath newFileName View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb7051c406623951fe59e99192d81316a7f6fdf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb7051c406623951fe59e99192d81316a7f6fdf2 You're receiving 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 Jun 11 15:21:22 2019 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 11 Jun 2019 11:21:22 -0400 Subject: [Git][ghc/ghc][wip/pmcheck-ncon] Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Message-ID: <5cffc6f2a5a72_6f73fe61e8072a022245d4@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC Commits: f41c8c4b by Sebastian Graf at 2019-06-11T15:20:55Z Add `PmNCons` to `Check` for correct warnings in the presence of `COMPLETE` groups Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. The introduction of an `PmNCons` variant in `PmPat` fixes this: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case in `PmNCons`. After all clauses have been processed this way, we filter out any value vector abstractions from the uncovered set involving `PmNCons` whose set of covered constructors completely overlap a `COMPLETE` set. - - - - - 21 changed files: - compiler/basicTypes/NameEnv.hs - compiler/deSugar/Check.hs - compiler/deSugar/PmExpr.hs - compiler/deSugar/PmPpr.hs - compiler/deSugar/TmOracle.hs - compiler/ghc.cabal.in - compiler/utils/Binary.hs - compiler/utils/ListSetOps.hs - − compiler/utils/ListT.hs - docs/users_guide/glasgow_exts.rst - + testsuite/tests/perf/compiler/ManyAlternatives.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.hs - + testsuite/tests/pmcheck/complete_sigs/T13363a.stderr - + testsuite/tests/pmcheck/complete_sigs/T13363b.hs - + testsuite/tests/pmcheck/complete_sigs/T13363b.stderr - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/pmcheck/should_compile/pmc008.hs - + testsuite/tests/pmcheck/should_compile/pmc009.hs - + testsuite/tests/pmcheck/should_compile/pmc010.hs - + testsuite/tests/pmcheck/should_compile/pmc011.hs Changes: ===================================== compiler/basicTypes/NameEnv.hs ===================================== @@ -27,7 +27,7 @@ module NameEnv ( lookupDNameEnv, delFromDNameEnv, mapDNameEnv, - alterDNameEnv, + alterDNameEnv, extendDNameEnv_C, -- ** Dependency analysis depAnal ) where @@ -156,3 +156,6 @@ mapDNameEnv = mapUDFM alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a alterDNameEnv = alterUDFM + +extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a +extendDNameEnv_C = addToUDFM_C ===================================== compiler/deSugar/Check.hs ===================================== @@ -24,6 +24,7 @@ module Check ( import GhcPrelude +import PmExpr import TmOracle import PmPpr import Unify( tcMatchTy ) @@ -56,20 +57,19 @@ import TyCoRep import Type import UniqSupply import DsUtils (isTrueLHsExpr) -import Maybes (expectJust) +import Maybes (MaybeT (..), expectJust) import qualified GHC.LanguageExtensions as LangExt -import Data.List (find) +import Data.List (find, (\\)) import Data.Maybe (catMaybes, isJust, fromMaybe) -import Control.Monad (forM, when, forM_, zipWithM, filterM) +import Control.Monad (forM, when, guard, forM_, zipWithM, filterM) +import Control.Monad.Trans.Class (lift) import Coercion import TcEvidence import TcSimplify (tcNormalise) import IOEnv import qualified Data.Semigroup as Semi -import ListT (ListT(..), fold, select) - {- This module checks pattern matches for: \begin{enumerate} @@ -92,79 +92,38 @@ The algorithm is based on the paper: %************************************************************************ -} --- We use the non-determinism monad to apply the algorithm to several --- possible sets of constructors. Users can specify complete sets of --- constructors by using COMPLETE pragmas. --- The algorithm only picks out constructor --- sets deep in the bowels which makes a simpler `mapM` more difficult to --- implement. The non-determinism is only used in one place, see the ConVar --- case in `pmCheckHd`. - -type PmM a = ListT DsM a +type PmM = DsM -liftD :: DsM a -> PmM a -liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk - --- Pick the first match complete covered match or otherwise the "best" match. --- The best match is the one with the least uncovered clauses, ties broken --- by the number of inaccessible clauses followed by number of redundant --- clauses. --- --- This is specified in the --- "Disambiguating between multiple ``COMPLETE`` pragmas" section of the --- users' guide. If you update the implementation of this function, make sure --- to update that section of the users' guide as well. -getResult :: PmM PmResult -> DsM PmResult -getResult ls - = do { res <- fold ls goM (pure Nothing) - ; case res of - Nothing -> panic "getResult is empty" - Just a -> return a } - where - goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do { pmr <- dpm - ; return $ Just $ go pmr mpm } - - -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> PmResult - go Nothing rs = rs - go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new - | null us && null rs && null is = old - | otherwise = - let PmResult prov' rs' (UncoveredPatterns us') is' = new - in case compareLength us us' - `mappend` (compareLength is is') - `mappend` (compareLength rs rs') - `mappend` (compare prov prov') of - GT -> new - EQ -> new - LT -> old - go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new - = panic "getResult: No inhabitation candidates" - -data PatTy = PAT | VA -- Used only as a kind, to index PmPat +-- | Used only as a kind, to index PmPat +data PatTy = PAT | VA -- The *arity* of a PatVec [p1,..,pn] is -- the number of p1..pn that are not Guards data PmPat :: PatTy -> * where + -- | For the arguments' meaning see 'HsPat.ConPatOut'. PmCon :: { pm_con_con :: ConLike , pm_con_arg_tys :: [Type] , pm_con_tvs :: [TyVar] - , pm_con_dicts :: [EvVar] , pm_con_args :: [PmPat t] } -> PmPat t - -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs PmVar :: { pm_var_id :: Id } -> PmPat t - PmLit :: { pm_lit_lit :: PmLit } -> PmPat t -- See Note [Literals in PmPat] - PmNLit :: { pm_lit_id :: Id - , pm_lit_not :: [PmLit] } -> PmPat 'VA - PmGrd :: { pm_grd_pv :: PatVec + -- | See Note [Literals in PmPat] + PmLit :: { pm_lit_lit :: PmLit } -> PmPat t + PmGrd :: { pm_grd_pv :: PatVec -- ^ Always has 'patVecArity' 1. , pm_grd_expr :: PmExpr } -> PmPat 'PAT -- | A fake guard pattern (True <- _) used to represent cases we cannot handle. PmFake :: PmPat 'PAT +-- | Should not face a user. instance Outputable (PmPat a) where - ppr = pprPmPatDebug + ppr (PmCon cc _arg_tys _con_tvs con_args) + = hsep [ppr cc, hsep (map ppr con_args)] + -- the @ is to differentiate (flexible) variables from rigid constructors and + -- literals + ppr (PmVar vid) = char '@' <> ppr vid + ppr (PmLit li) = ppr li + ppr (PmGrd pv ge) = hsep (map ppr pv) <+> text "<-" <+> ppr ge + ppr PmFake = text "" -- data T a where -- MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p] @@ -185,6 +144,17 @@ data Delta = MkDelta { delta_ty_cs :: Bag EvVar type ValSetAbs = [ValVec] -- ^ Value Set Abstractions type Uncovered = ValSetAbs +-- | Should not face a user. See 'pprValVecSubstituted' for that. +instance Outputable ValVec where + ppr (ValVec vva delta) = ppr vva <+> text "|>" <+> ppr_delta delta + where + ppr_delta _d = hcat [ + -- intentionally formatted this way enable the dev to comment in only + -- the info she needs + ppr (delta_tm_cs delta), + ppr (delta_ty_cs delta) + ] + -- Instead of keeping the whole sets in memory, we keep a boolean for both the -- covered and the divergent set (we store the uncovered set though, since we -- want to print it). For both the covered and the divergent we have: @@ -200,8 +170,7 @@ data Covered = Covered | NotCovered deriving Show instance Outputable Covered where - ppr (Covered) = text "Covered" - ppr (NotCovered) = text "NotCovered" + ppr = text . show -- Like the or monoid for booleans -- Covered = True, Uncovered = False @@ -218,8 +187,7 @@ data Diverged = Diverged | NotDiverged deriving Show instance Outputable Diverged where - ppr Diverged = text "Diverged" - ppr NotDiverged = text "NotDiverged" + ppr = text . show instance Semi.Semigroup Diverged where Diverged <> _ = Diverged @@ -230,51 +198,27 @@ instance Monoid Diverged where mempty = NotDiverged mappend = (Semi.<>) --- | When we learned that a given match group is complete -data Provenance = - FromBuiltin -- ^ From the original definition of the type - -- constructor. - | FromComplete -- ^ From a user-provided @COMPLETE@ pragma - deriving (Show, Eq, Ord) - -instance Outputable Provenance where - ppr = text . show - -instance Semi.Semigroup Provenance where - FromComplete <> _ = FromComplete - _ <> FromComplete = FromComplete - _ <> _ = FromBuiltin - -instance Monoid Provenance where - mempty = FromBuiltin - mappend = (Semi.<>) - data PartialResult = PartialResult { - presultProvenance :: Provenance - -- keep track of provenance because we don't want - -- to warn about redundant matches if the result - -- is contaminated with a COMPLETE pragma - , presultCovered :: Covered + presultCovered :: Covered , presultUncovered :: Uncovered , presultDivergent :: Diverged } instance Outputable PartialResult where - ppr (PartialResult prov c vsa d) - = text "PartialResult" <+> ppr prov <+> ppr c - <+> ppr d <+> ppr vsa - + ppr (PartialResult c vsa d) + = hang (text "PartialResult" <+> ppr c <+> ppr d) 2 (ppr_vsa vsa) + where + ppr_vsa = braces . fsep . punctuate comma . map ppr instance Semi.Semigroup PartialResult where - (PartialResult prov1 cs1 vsa1 ds1) - <> (PartialResult prov2 cs2 vsa2 ds2) - = PartialResult (prov1 Semi.<> prov2) - (cs1 Semi.<> cs2) + (PartialResult cs1 vsa1 ds1) + <> (PartialResult cs2 vsa2 ds2) + = PartialResult (cs1 Semi.<> cs2) (vsa1 Semi.<> vsa2) (ds1 Semi.<> ds2) instance Monoid PartialResult where - mempty = PartialResult mempty mempty [] mempty + mempty = PartialResult mempty [] mempty mappend = (Semi.<>) -- newtype ChoiceOf a = ChoiceOf [a] @@ -292,15 +236,13 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] + pmresultRedundant :: [Located [LPat GhcTc]] , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } instance Outputable PmResult where ppr pmr = hang (text "PmResult") 2 $ vcat - [ text "pmresultProvenance" <+> ppr (pmresultProvenance pmr) - , text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) + [ text "pmresultRedundant" <+> ppr (pmresultRedundant pmr) , text "pmresultUncovered" <+> ppr (pmresultUncovered pmr) , text "pmresultInaccessible" <+> ppr (pmresultInaccessible pmr) ] @@ -325,11 +267,11 @@ instance Outputable UncoveredCandidates where -- | The empty pattern check result emptyPmResult :: PmResult -emptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) [] +emptyPmResult = PmResult [] (UncoveredPatterns []) [] -- | Non-exhaustive empty case with unknown/trivial inhabitants uncoveredWithTy :: Type -> PmResult -uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] +uncoveredWithTy ty = PmResult [] (TypeOfUncovered ty) [] {- %************************************************************************ @@ -342,8 +284,8 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) [] -- | Check a single pattern binding (let) checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do - tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - mb_pm_res <- tryM (getResult (checkSingle' locn var p)) + tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) + mb_pm_res <- tryM (checkSingle' locn var p) case mb_pm_res of Left _ -> warnPmIters dflags ctxt Right res -> dsPmWarn dflags ctxt res @@ -351,25 +293,25 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do -- | Check a single pattern binding (let) checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult checkSingle' locn var p = do - liftD resetPmIterDs -- set the iter-no to zero - fam_insts <- liftD dsGetFamInstEnvs - clause <- liftD $ translatePat fam_insts p + resetPmIterDs -- set the iter-no to zero + fam_insts <- dsGetFamInstEnvs + clause <- translatePat fam_insts p missing <- mkInitialUncovered [var] - tracePm "checkSingle': missing" (vcat (map pprValVecDebug missing)) + tracePm "checkSingle': missing" (vcat (map ppr missing)) -- no guards - PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing - let us' = UncoveredPatterns us + PartialResult cs us ds <- runMany (pmcheckI clause []) missing + us' <- UncoveredPatterns <$> normaliseUncovered normaliseValVec us return $ case (cs,ds) of - (Covered, _ ) -> PmResult prov [] us' [] -- useful - (NotCovered, NotDiverged) -> PmResult prov m us' [] -- redundant - (NotCovered, Diverged ) -> PmResult prov [] us' m -- inaccessible rhs + (Covered, _ ) -> PmResult [] us' [] -- useful + (NotCovered, NotDiverged) -> PmResult m us' [] -- redundant + (NotCovered, Diverged ) -> PmResult [] us' m -- inaccessible rhs where m = [cL locn [cL locn p]] -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. checkGuardMatches :: HsMatchContext Name -- Match context -> GRHSs GhcTc (LHsExpr GhcTc) -- Guarded RHSs - -> DsM () + -> PmM () checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do dflags <- getDynFlags let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) @@ -384,14 +326,14 @@ checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches" -- | Check a matchgroup (case, functions, etc.) checkMatches :: DynFlags -> DsMatchContext - -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM () + -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM () checkMatches dflags ctxt vars matches = do - tracePmD "checkMatches" (hang (vcat [ppr ctxt + tracePm "checkMatches" (hang (vcat [ppr ctxt , ppr vars , text "Matches:"]) 2 (vcat (map ppr matches))) - mb_pm_res <- tryM $ getResult $ case matches of + mb_pm_res <- tryM $ case matches of -- Check EmptyCase separately -- See Note [Checking EmptyCase Expressions] [] | [var] <- vars -> checkEmptyCase' var @@ -406,38 +348,36 @@ checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult checkMatches' vars matches | null matches = panic "checkMatches': EmptyCase" | otherwise = do - liftD resetPmIterDs -- set the iter-no to zero + resetPmIterDs -- set the iter-no to zero missing <- mkInitialUncovered vars - tracePm "checkMatches': missing" (vcat (map pprValVecDebug missing)) - (prov, rs,us,ds) <- go matches missing + tracePm "checkMatches': missing" (vcat (map ppr missing)) + (rs,us,ds) <- go matches missing + us' <- normaliseUncovered normaliseValVec us return $ PmResult { - pmresultProvenance = prov - , pmresultRedundant = map hsLMatchToLPats rs - , pmresultUncovered = UncoveredPatterns us + pmresultRedundant = map hsLMatchToLPats rs + , pmresultUncovered = UncoveredPatterns us' , pmresultInaccessible = map hsLMatchToLPats ds } where go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered - -> PmM (Provenance - , [LMatch GhcTc (LHsExpr GhcTc)] + -> PmM ( [LMatch GhcTc (LHsExpr GhcTc)] , Uncovered , [LMatch GhcTc (LHsExpr GhcTc)]) - go [] missing = return (mempty, [], missing, []) + go [] missing = return ([], missing, []) go (m:ms) missing = do tracePm "checkMatches': go" (ppr m $$ ppr missing) - fam_insts <- liftD dsGetFamInstEnvs - (clause, guards) <- liftD $ translateMatch fam_insts m - r@(PartialResult prov cs missing' ds) + fam_insts <- dsGetFamInstEnvs + (clause, guards) <- translateMatch fam_insts m + r@(PartialResult cs missing' ds) <- runMany (pmcheckI clause guards) missing tracePm "checkMatches': go: res" (ppr r) - (ms_prov, rs, final_u, is) <- go ms missing' - let final_prov = prov `mappend` ms_prov + (rs, final_u, is) <- go ms missing' return $ case (cs, ds) of -- useful - (Covered, _ ) -> (final_prov, rs, final_u, is) + (Covered, _ ) -> (rs, final_u, is) -- redundant - (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is) + (NotCovered, NotDiverged) -> (m:rs, final_u,is) -- inaccessible - (NotCovered, Diverged ) -> (final_prov, rs, final_u, m:is) + (NotCovered, Diverged ) -> (rs, final_u, m:is) hsLMatchToLPats :: LMatch id body -> Located [LPat id] hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats @@ -465,7 +405,7 @@ checkEmptyCase' var = do pure $ fmap (ValVec [va]) mb_sat return $ if null missing_m then emptyPmResult - else PmResult FromBuiltin [] (UncoveredPatterns missing_m) [] + else PmResult [] (UncoveredPatterns missing_m) [] -- | Returns 'True' if the argument 'Type' is a fully saturated application of -- a closed type constructor. @@ -516,7 +456,7 @@ pmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> 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_maybe env ty_cs typ - = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ + = do (_, mb_typ') <- initTcDsForSolver $ tcNormalise ty_cs typ -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See -- "Wrinkle: local equalities" in @@ -579,8 +519,8 @@ pmTopNormaliseType_maybe env ty_cs typ -- for why this is done.) pmInitialTmTyCs :: PmM Delta pmInitialTmTyCs = do - ty_cs <- liftD getDictsDs - tm_cs <- bagToList <$> liftD getTmCsDs + ty_cs <- getDictsDs + tm_cs <- bagToList <$> getTmCsDs sat_ty <- tyOracle ty_cs let initTyCs = if sat_ty then ty_cs else emptyBag initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs) @@ -671,12 +611,98 @@ tmTyCsAreSatisfiable , delta_tm_cs = term_cs } _unsat -> Nothing +-- | Tests whether the 'Id' can inhabit the given 'ConLike' in the context +-- expressed by the 'Delta'. +type InhabitationTest = Delta -> Id -> ConLike -> PmM Bool + +-- | An 'InhabitationTest' consulting 'mkOneSatisfiableConFull'. Precise, but +-- expensive. +isConSatisfiable :: InhabitationTest +isConSatisfiable delta x con = do + tracePm "conInhabitsId" (ppr con <+> ppr x <+> ppr (delta_tm_cs delta)) + isJust <$> mkOneSatisfiableConFull delta x con + +-- | Cheap 'InhabitationTest', always returning @True at . +cheapInhabitationTest :: InhabitationTest +cheapInhabitationTest _ _ _ = pure True + +normaliseValAbs :: InhabitationTest -> Delta -> ValAbs -> PmM (Maybe (Delta, ValAbs)) +normaliseValAbs is_con_inh delta = runMaybeT . go_va delta + where + go_va :: Delta -> ValAbs -> MaybeT PmM (Delta, ValAbs) + go_va delta pm at PmCon{ pm_con_args = args } = do + (delta', args') <- mapAccumLM go_va delta args + pure (delta', pm { pm_con_args = args' }) + go_va delta va@(PmVar x) + | let (ty, pacs) = lookupRefutableAltCons (delta_tm_cs delta) x + -- TODO: Even if ncons is empty, we might have a complete match ('Void', + -- constraints). Figure out how to the complete matches solely from + -- @ty at . + , ncons@(cl:_) <- [ cl | PmAltConLike cl <- pacs ] = do + grps <- lift (allCompleteMatches cl ty) + let is_grp_inh = filterM (lift . is_con_inh delta x) . (\\ ncons) + incomplete_grps <- traverse is_grp_inh grps + -- If all cons of any COMPLETE set are matched, the ValAbs is vacuous. + guard (all notNull incomplete_grps) + -- If there's a unique singleton incomplete group, turn it into a + -- @PmCon@ for better readability of warning messages. + case incomplete_grps of + [[con]] -> do + -- We don't want to simplify to a @PmCon@ (which won't normalise + -- any further) when @p@ is just the 'cheapInhabitationTest'. + -- Thus, we have to assert satisfiability here, even if the + -- expensive 'isConSatisfiable' already did so. Also, we have to + -- store the constraints in @delta at . + (delta', ic) <- MaybeT $ mkOneSatisfiableConFull delta x con + pure (delta', ic_val_abs ic) + _ -> pure (delta, va) + go_va delta va = pure (delta, va) + +-- | Something that normalises a 'ValVec' by consulting the given +-- 'InhabitationTest' to weed out vacuous 'ValAbs'. +-- See also 'normaliseValVecHead' and 'normaliseValVec'. +type ValVecNormaliser = InhabitationTest -> ValVec -> PmM (Maybe ValVec) + +-- | A 'ValVecNormaliser' that normalises all components of a 'ValVec'. This is +-- the 'ValVecNormaliser' to choose once at the end. +normaliseValVec :: ValVecNormaliser +normaliseValVec test (ValVec vva delta) = runMaybeT $ do + (delta', vva') <- mapAccumLM ((MaybeT .) . normaliseValAbs test) delta vva + pure (ValVec vva' delta') + +-- | A 'ValVecNormaliser' that only tries to normalise the head of each +-- 'ValVec'. This is mandatory for pattern guards, where we call 'utail' on the +-- temporarily extended 'ValVec', hence there's no way to delay this check. +-- Of course we could 'normaliseValVec' instead, but that's unnecessarily +-- expensive. +normaliseValVecHead :: ValVecNormaliser +normaliseValVecHead _ vva@(ValVec [] _) = pure (Just vva) +normaliseValVecHead test (ValVec (va:vva) delta) = runMaybeT $ do + (delta', va') <- MaybeT (normaliseValAbs test delta va) + pure (ValVec (va':vva) delta') + +-- | This weeds out 'ValVec's with 'PmVar's where at least one COMPLETE set is +-- rendered vacuous by equality constraints, by calling out the given +-- 'ValVecNormaliser' with different 'InhabitationTest's. +-- +-- This is quite costly due to the many oracle queries, so we only call this at +-- the last possible moment. I.e., with 'normaliseValVecHead' when leaving a +-- pattern guard and with 'normaliseValVec' on the final uncovered set. +normaliseUncovered :: ValVecNormaliser -> Uncovered -> PmM Uncovered +normaliseUncovered normalise_val_vec us = do + -- We'll first do a cheap sweep without consulting the oracles + us1 <- mapMaybeM (normalise_val_vec cheapInhabitationTest) us + -- Then we'll do another pass trying to weed out the rest with (in)equalities + us2 <- mapMaybeM (normalise_val_vec isConSatisfiable) us1 + tracePm "normaliseUncovered" (vcat (map ppr us2)) + pure us2 + -- | Implements two performance optimizations, as described in the -- \"Strict argument type constraints\" section of -- @Note [Extensions to GADTs Meet Their Match]@. checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs let definitely_inhabited = definitelyInhabitedType fam_insts (delta_ty_cs amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys @@ -833,7 +859,7 @@ equalities (such as i ~ Int) that may be in scope. inhabitationCandidates :: Bag EvVar -> Type -> PmM (Either Type (TyCon, [InhabitationCandidate])) inhabitationCandidates ty_cs ty = do - fam_insts <- liftD dsGetFamInstEnvs + fam_insts <- dsGetFamInstEnvs mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty case mb_norm_res of Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs @@ -847,7 +873,7 @@ inhabitationCandidates ty_cs ty = do -- PmCon empty, since we know that they are not gonna be used. Is the -- right-thing-to-do to actually create them, even if they are never used? build_tm :: ValAbs -> [DataCon] -> ValAbs - build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [] [e]) + build_tm = foldr (\dc e -> PmCon (RealDataCon dc) [] [] [e]) -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe alts_to_check :: Type -> Type -> [DataCon] @@ -857,7 +883,7 @@ inhabitationCandidates ty_cs ty = do | tc `elem` trivially_inhabited -> case dcs of [] -> return (Left src_ty) - (_:_) -> do var <- liftD $ mkPmId core_ty + (_:_) -> do var <- mkPmId core_ty let va = build_tm (PmVar var) dcs return $ Right (tc, [InhabitationCandidate { ic_val_abs = va, ic_tm_ct = mkIdEq var @@ -867,7 +893,7 @@ inhabitationCandidates ty_cs ty = do -- Don't consider abstract tycons since we don't know what their -- constructors are, which makes the results of coverage checking -- them extremely misleading. - -> liftD $ do + -> do var <- mkPmId core_ty -- it would be wrong to unify x alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc) return $ Right @@ -925,7 +951,7 @@ nullaryConPattern :: ConLike -> Pattern -- Nullary data constructor and nullary type constructor nullaryConPattern con = PmCon { pm_con_con = con, pm_con_arg_tys = [] - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nullaryConPattern #-} truePattern :: Pattern @@ -933,7 +959,7 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon) {-# INLINE truePattern #-} -- | Generate a `canFail` pattern vector of a specific type -mkCanFailPmPat :: Type -> DsM PatVec +mkCanFailPmPat :: Type -> PmM PatVec mkCanFailPmPat ty = do var <- mkPmVar ty return [var, PmFake] @@ -942,21 +968,20 @@ vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern -- ADT constructor pattern => no existentials, no local constraints vanillaConPattern con arg_tys args = PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args } + , pm_con_tvs = [], pm_con_args = args } {-# INLINE vanillaConPattern #-} -- | Create an empty list pattern of a given type nilPattern :: Type -> Pattern nilPattern ty = PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] - , pm_con_args = [] } + , pm_con_tvs = [], pm_con_args = [] } {-# INLINE nilPattern #-} mkListPatVec :: Type -> PatVec -> PatVec -> PatVec mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon , pm_con_arg_tys = [ty] - , pm_con_tvs = [], pm_con_dicts = [] + , pm_con_tvs = [] , pm_con_args = xs++ys }] {-# INLINE mkListPatVec #-} @@ -968,7 +993,7 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit } -- ----------------------------------------------------------------------- -- * Transform (Pat Id) into of (PmPat Id) -translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec +translatePat :: FamInstEnvs -> Pat GhcTc -> PmM PatVec translatePat fam_insts pat = case pat of WildPat ty -> mkPmVars [ty] VarPat _ id -> return [PmVar (unLoc id)] @@ -1047,17 +1072,16 @@ translatePat fam_insts pat = case pat of ConPatOut { pat_con = (dL->L _ con) , pat_arg_tys = arg_tys , pat_tvs = ex_tvs - , pat_dicts = dicts , pat_args = ps } -> do - groups <- allCompleteMatches con arg_tys + let ty = conLikeResTy con arg_tys + groups <- allCompleteMatches con ty case groups of - [] -> mkCanFailPmPat (conLikeResTy con arg_tys) + [] -> mkCanFailPmPat ty _ -> do args <- translateConPatVec fam_insts arg_tys ex_tvs con ps return [PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args }] -- See Note [Translate Overloaded Literal for Exhaustiveness Checking] @@ -1185,12 +1209,12 @@ from translation in pattern matcher. -- | Translate a list of patterns (Note: each pattern is translated -- to a pattern vector but we do not concatenate the results). -translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec] +translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> PmM [PatVec] translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats -- | Translate a constructor pattern translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar] - -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec + -> ConLike -> HsConPatDetails GhcTc -> PmM PatVec translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps) = concat <$> translatePatVec fam_insts (map unLoc ps) translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2) @@ -1246,11 +1270,12 @@ translateConPatVec fam_insts univ_tys ex_tvs c (RecCon (HsRecFields fs _)) -- Translate a single match translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM (PatVec,[PatVec]) + -> PmM (PatVec,[PatVec]) translateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) = do pats' <- concat <$> translatePatVec fam_insts pats guards' <- mapM (translateGuards fam_insts) guards + -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr guards, ppr guards']) return (pats', guards') where extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc] @@ -1265,11 +1290,11 @@ translateMatch _ _ = panic "translateMatch" -- * Transform source guards (GuardStmt Id) to PmPats (Pattern) -- | Translate a list of guard statements to a pattern vector -translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec +translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> PmM PatVec translateGuards fam_insts guards = do all_guards <- concat <$> mapM (translateGuard fam_insts) guards let - shouldKeep :: Pattern -> DsM Bool + shouldKeep :: Pattern -> PmM Bool shouldKeep p | PmVar {} <- p = pure True | PmCon {} <- p = (&&) @@ -1294,7 +1319,7 @@ translateGuards fam_insts guards = do pure (PmFake : kept) -- | Check whether a pattern can fail to match -cantFailPattern :: Pattern -> DsM Bool +cantFailPattern :: Pattern -> PmM Bool cantFailPattern PmVar {} = pure True cantFailPattern PmCon { pm_con_con = c, pm_con_arg_tys = tys, pm_con_args = ps} = (&&) <$> singleMatchConstructor c tys <*> allM cantFailPattern ps @@ -1302,7 +1327,7 @@ cantFailPattern (PmGrd pv _e) = allM cantFailPattern pv cantFailPattern _ = pure False -- | Translate a guard statement to Pattern -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec +translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> PmM PatVec translateGuard fam_insts guard = case guard of BodyStmt _ e _ _ -> translateBoolGuard e LetStmt _ binds -> translateLet (unLoc binds) @@ -1315,18 +1340,18 @@ translateGuard fam_insts guard = case guard of XStmtLR {} -> panic "translateGuard RecStmt" -- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM PatVec +translateLet :: HsLocalBinds GhcTc -> PmM PatVec translateLet _binds = return [] -- | Translate a pattern guard -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec +translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> PmM PatVec translateBind fam_insts (dL->L _ p) e = do ps <- translatePat fam_insts p g <- mkGuard ps (unLoc e) return [g] -- | Translate a boolean guard -translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec +translateBoolGuard :: LHsExpr GhcTc -> PmM PatVec translateBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) @@ -1427,10 +1452,17 @@ efficiently, which gave rise to #11276. The original approach translated pat |> co ===> x (pat <- (e |> co)) -Instead, we now check whether the coercion is a hole or if it is just refl, in -which case we can drop it. Unfortunately, data families generate useful -coercions so guards are still generated in these cases and checking data -families is not really efficient. +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. %************************************************************************ %* * @@ -1449,7 +1481,6 @@ pmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys }) = conLikeResTy con tys pmPatType (PmVar { pm_var_id = x }) = idType x pmPatType (PmLit { pm_lit_lit = l }) = pmLitType l -pmPatType (PmNLit { pm_lit_id = x }) = idType x pmPatType (PmGrd { pm_grd_pv = pv }) = ASSERT(patVecArity pv == 1) (pmPatType p) where Just p = find ((==1) . patternArity) pv @@ -1477,10 +1508,13 @@ 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. ------ --- Strict argument type constraints ------ +* Handling of uninhabited fields like `!Void`. + See Note [Strict argument type constraints] +* Efficient handling of literal splitting, large enumerations and accurate + redundancy warnings for `COMPLETE` groups. See Note [PmNLit and PmNCon] +Note [Strict argument type constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1600,8 +1634,43 @@ intuition formal, we say that a type is definitely inhabitable (DI) if: 1. C has no equality constraints (since they might be unsatisfiable) 2. C has no strict argument types (since they might be uninhabitable) -It's relatively cheap to cheap if a type is DI, so before we call `nonVoid` +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. + +Note [PmNLit and PmNCon] +~~~~~~~~~~~~~~~~~~~~~~~~~ +TLDR: +* 'PmNLit' is an efficient encoding of literals we already matched on. + Important for checking redundancy without blowing up the term oracle. +* 'PmNCon' is an efficient encoding of all constructors we already matched on. + Important for proper redundancy and completeness checks while being more + efficient than the `ConVar` split in GADTs Meet Their Match. + +GADTs Meet Their Match handled literals by desugaring to guard expressions, +effectively encoding the knowledge in the term oracle. As it turned out, this +doesn't scale (#11303, cf. Note [Literals in PmPat]), so we adopted an approach +that encodes negative information about literals as a 'PmNLit', which encodes +literal values the carried variable may no longer take on. + +The counterpart for constructor values is 'PmNCon', where we associate +with a variable the topmost 'ConLike's it surely can't be. This is in contrast +to GADTs Meet Their Match, where instead the `ConVar` case would split the value +vector abstraction on all possible constructors from a `COMPLETE` group. +In fact, we used to do just that, but committing to a particular `COMPLETE` +group in `ConVar`, even nondeterministically, led to misleading redundancy +warnings (#13363). +Apart from that, splitting on huge enumerations in the presence of a catch-all +case is a huge waste of resources. + +Note that since we have pattern guards, the term oracle must also be able to +cope with negative equations involving literals and constructors, cf. +Note [Refutable shapes] in TmOracle. Since we don't want to put too much strain +on the term oracle with repeated coverage checks against all `COMPLETE` groups, +we only do so once at the end in 'normaliseUncovered'. + +Peter Sestoft was probably the first to describe positive and negative +information about terms in this manner in ML Pattern Match Compilation and +Partial Evaluation. -} instance Outputable InhabitationCandidate where @@ -1616,7 +1685,7 @@ instance Outputable InhabitationCandidate where -- | Generate an 'InhabitationCandidate' for a given conlike (generate -- fresh variables of the appropriate type for arguments) -mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate +mkOneConFull :: Id -> ConLike -> PmM InhabitationCandidate -- * x :: T tys, where T is an algebraic data type -- NB: in the case of a data family, T is the *representation* TyCon -- e.g. data instance T (a,b) = T1 a b @@ -1656,7 +1725,6 @@ mkOneConFull x con = do let con_abs = PmCon { pm_con_con = con , pm_con_arg_tys = tc_args , pm_con_tvs = ex_tvs' - , pm_con_dicts = evvars , pm_con_args = arguments } strict_arg_tys = filterByList arg_is_banged arg_tys' return $ InhabitationCandidate @@ -1666,24 +1734,46 @@ mkOneConFull x con = do , ic_strict_arg_tys = strict_arg_tys } +-- | 'mkOneConFull' and immediately check whether the resulting +-- 'InhabitationCandidat' @ic@ is inhabited by consulting 'pmIsSatisfiable'. +-- Return @Just ic@ if it is. +mkOneSatisfiableConFull :: Delta -> Id -> ConLike -> PmM (Maybe (Delta, InhabitationCandidate)) +mkOneSatisfiableConFull delta x con = do + -- mkOneConFull doesn't cope with type families, so we have to normalise + -- x's result type first and introduce an auxiliary binding. + fam_insts <- dsGetFamInstEnvs + mb_res_ty <- pmTopNormaliseType_maybe fam_insts (delta_ty_cs delta) (idType x) + case mb_res_ty of + Nothing -> pure Nothing -- it was empty to begin with + Just (res_ty, _, _) -> do + (y, delta') <- mkIdCoercion x res_ty delta + ic <- mkOneConFull y con + tracePm "mkOneSatisfiableConFull" (ppr x <+> ppr y $$ ppr ic $$ ppr (delta_tm_cs delta')) + ((,ic) <$>) <$> pmIsSatisfiable delta' (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + -- ---------------------------------------------------------------------------- -- * More smart constructors and fresh variable generation +-- | Introduce a new 'Id' that has the given type and is in the same equivalence +-- class as the argument. +mkIdCoercion :: Id -> Type -> Delta -> PmM (Id, Delta) +mkIdCoercion x ty delta + | eqType (idType x) ty = pure (x, delta) -- no need to introduce anything new + | otherwise = do + y <- mkPmId ty + let e = PmExprVar (idName x) + pure (y, delta { delta_tm_cs = extendSubst y e (delta_tm_cs delta) }) + -- | Create a guard pattern -mkGuard :: PatVec -> HsExpr GhcTc -> DsM Pattern +mkGuard :: PatVec -> HsExpr GhcTc -> PmM Pattern mkGuard pv e = do res <- allM cantFailPattern pv let expr = hsExprToPmExpr e - tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) + tracePm "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr]) if | res -> pure (PmGrd pv expr) | PmExprOther {} <- expr -> pure PmFake | otherwise -> pure (PmGrd pv expr) --- | Create a term equality of the form: `(x ~ lit)` -mkPosEq :: Id -> PmLit -> TmVarCt -mkPosEq x l = TVC x (PmExprLit l) -{-# INLINE mkPosEq #-} - -- | Create a term equality of the form: `(x ~ x)` -- (always discharged by the term oracle) mkIdEq :: Id -> TmVarCt @@ -1691,17 +1781,17 @@ mkIdEq x = TVC x (PmExprVar (idName x)) {-# INLINE mkIdEq #-} -- | Generate a variable pattern of a given type -mkPmVar :: Type -> DsM (PmPat p) +mkPmVar :: Type -> PmM (PmPat p) mkPmVar ty = PmVar <$> mkPmId ty {-# INLINE mkPmVar #-} -- | Generate many variable patterns, given a list of types -mkPmVars :: [Type] -> DsM PatVec +mkPmVars :: [Type] -> PmM PatVec mkPmVars tys = mapM mkPmVar tys {-# INLINE mkPmVars #-} -- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id +mkPmId :: Type -> PmM Id mkPmId ty = getUniqueM >>= \unique -> let occname = mkVarOccFS $ fsLit "$pm" name = mkInternalName unique occname noSrcSpan @@ -1710,7 +1800,7 @@ mkPmId ty = getUniqueM >>= \unique -> -- | Generate a fresh term variable of a given and return it in two forms: -- * A variable pattern -- * A variable expression -mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc) +mkPmId2Forms :: Type -> PmM (Pattern, LHsExpr GhcTc) mkPmId2Forms ty = do x <- mkPmId ty return (PmVar x, noLoc (HsVar noExt (noLoc x))) @@ -1721,10 +1811,9 @@ mkPmId2Forms ty = do -- | Convert a value abstraction an expression vaToPmExpr :: ValAbs -> PmExpr vaToPmExpr (PmCon { pm_con_con = c, pm_con_args = ps }) - = PmExprCon c (map vaToPmExpr ps) + = PmExprCon (PmAltConLike c) (map vaToPmExpr ps) vaToPmExpr (PmVar { pm_var_id = x }) = PmExprVar (idName x) -vaToPmExpr (PmLit { pm_lit_lit = l }) = PmExprLit l -vaToPmExpr (PmNLit { pm_lit_id = x }) = PmExprVar (idName x) +vaToPmExpr (PmLit { pm_lit_lit = l }) = mkPmExprLit l -- | Convert a pattern vector to a list of value abstractions by dropping the -- guards (See Note [Translating As Patterns]) @@ -1738,20 +1827,18 @@ coercePmPat :: Pattern -> [ValAbs] coercePmPat (PmVar { pm_var_id = x }) = [PmVar { pm_var_id = x }] coercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }] coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = args }) + , pm_con_tvs = tvs, pm_con_args = args }) = [PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys - , pm_con_tvs = tvs, pm_con_dicts = dicts - , pm_con_args = coercePatVec args }] + , pm_con_tvs = tvs, pm_con_args = coercePatVec args }] coercePmPat (PmGrd {}) = [] -- drop the guards coercePmPat PmFake = [] -- drop the guards -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether -- it is the only possible match in the given context. See also -- 'allCompleteMatches' and Note [Single match constructors]. -singleMatchConstructor :: ConLike -> [Type] -> DsM Bool +singleMatchConstructor :: ConLike -> [Type] -> PmM Bool singleMatchConstructor cl tys = - any (isSingleton . snd) <$> allCompleteMatches cl tys + any isSingleton <$> allCompleteMatches cl (conLikeResTy cl tys) {- Note [Single match constructors] @@ -1786,20 +1873,17 @@ translation step. See #15753 for why this yields surprising results. -- 2. From `COMPLETE` pragmas which have the same type as the result -- type constructor. Note that we only use `COMPLETE` pragmas -- *all* of whose pattern types match. See #14135 -allCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])] -allCompleteMatches cl tys = do +allCompleteMatches :: ConLike -> Type -> DsM [[ConLike]] +allCompleteMatches cl ty = do let fam = case cl of RealDataCon dc -> - [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))] + [map RealDataCon (tyConDataCons (dataConTyCon dc))] PatSynCon _ -> [] - ty = conLikeResTy cl tys pragmas <- case splitTyConApp_maybe ty of Just (tc, _) -> dsGetCompleteMatches tc Nothing -> return [] - let fams cm = (FromComplete,) <$> - mapM dsLookupConLike (completeMatchConLikes cm) - from_pragma <- filter (\(_,m) -> isValidCompleteMatch ty m) <$> - mapM fams pragmas + let fams cm = mapM dsLookupConLike (completeMatchConLikes cm) + from_pragma <- filter (isValidCompleteMatch ty) <$> mapM fams pragmas let final_groups = fam ++ from_pragma return final_groups where @@ -1891,8 +1975,7 @@ nameType name ty = do -- | Check whether a set of type constraints is satisfiable. tyOracle :: Bag EvVar -> PmM Bool tyOracle evs - = liftD $ - do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs + = do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs ; case res of Just sat -> return sat Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } @@ -1974,10 +2057,11 @@ mkInitialUncovered vars = do -- limit is not exceeded and call `pmcheck` pmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult pmcheckI ps guards vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheck" (ppr n <> colon <+> pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheck" (ppr n <> colon + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr vva) res <- pmcheck ps guards vva tracePm "pmCheckResult:" (ppr res) return res @@ -1986,7 +2070,7 @@ pmcheckI ps guards vva = do -- | Increase the counter for elapsed algorithm iterations, check that the -- limit is not exceeded and call `pmcheckGuards` pmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult -pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva +pmcheckGuardsI gvs vva = incrCheckPmIterDs >> pmcheckGuards gvs vva {-# INLINE pmcheckGuardsI #-} -- | Increase the counter for elapsed algorithm iterations, check that the @@ -1994,12 +2078,12 @@ pmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva pmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec -> PmM PartialResult pmcheckHdI p ps guards va vva = do - n <- liftD incrCheckPmIterDs - tracePm "pmCheckHdI" (ppr n <> colon <+> pprPmPatDebug p - $$ pprPatVec ps - $$ hang (text "guards:") 2 (vcat (map pprPatVec guards)) - $$ pprPmPatDebug va - $$ pprValVecDebug vva) + n <- incrCheckPmIterDs + tracePm "pmCheckHdI" (ppr n <> colon <+> ppr p + $$ hang (text "patterns:") 2 (ppr ps) + $$ hang (text "guards:") 2 (ppr guards) + $$ ppr va + $$ ppr vva) res <- pmcheckHd p ps guards va vva tracePm "pmCheckHdI: res" (ppr res) @@ -2024,10 +2108,15 @@ pmcheck (PmFake : ps) guards vva = pmcheck (p : ps) guards (ValVec vas delta) | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p = do - y <- liftD $ mkPmId (pmPatType p) + tracePm "PmGrd: pmPatType" (hcat [ppr p, ppr (pmPatType p)]) + y <- mkPmId (pmPatType p) let tm_state = extendSubst y e (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } - utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + pr <- pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta') + -- The heads of the ValVecs in the uncovered set might be vacuous, so + -- normalise them + us <- normaliseUncovered normaliseValVecHead (presultUncovered pr) + pure $ utail pr { presultUncovered = us } pmcheck [] _ (ValVec (_:_) _) = panic "pmcheck: nil-cons" pmcheck (_:_) _ (ValVec [] _) = panic "pmcheck: cons-nil" @@ -2039,10 +2128,9 @@ pmcheck (p:ps) guards (ValVec (va:vva) delta) pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult pmcheckGuards [] vva = return (usimple [vva]) pmcheckGuards (gv:gvs) vva = do - (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva - (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa - return $ PartialResult (prov1 `mappend` prov2) - (cs `mappend` css) + (PartialResult cs vsa ds) <- pmcheckI gv [] vva + (PartialResult css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa + return $ PartialResult (cs `mappend` css) vsas (ds `mappend` dss) @@ -2077,72 +2165,52 @@ pmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1 | otherwise = Just <$> to_evvar tv1 tv2 evvars <- (listToBag . catMaybes) <$> ASSERT(ex_tvs1 `equalLength` ex_tvs2) - liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) + (zipWithM mb_to_evvar ex_tvs1 ex_tvs2) let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta } - kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p) + kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta') -- LitLit -pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva = - case eqPmLit l1 l2 of - True -> ucon va <$> pmcheckI ps guards vva - False -> return $ ucon va (usimple [vva]) +pmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva + | l1 == l2 = ucon va <$> pmcheckI ps guards vva + | otherwise = return $ ucon va (usimple [vva]) -- ConVar -pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys })) - ps guards - (PmVar x) (ValVec vva delta) = do - (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys) - - cons_cs <- mapM (liftD . mkOneConFull x) complete_match - - inst_vsa <- flip mapMaybeM cons_cs $ - \InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct - , ic_ty_cs = ty_cs - , ic_strict_arg_tys = strict_arg_tys } -> do - mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys - pure $ fmap (ValVec (va:vva)) mb_sat - - set_provenance prov . - force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - runMany (pmcheckI (p:ps) guards) inst_vsa +pmcheckHd p at PmCon{} ps guards (PmVar x) vva@(ValVec vas delta) = do + -- Split the value vector into two value vectors: One representing the current + -- constructor, the other representing everything but the current constructor + -- (and the already known impossible constructors). + let con = pm_con_con p + + -- For the value vector of the current constructor, we directly recurse into + -- checking the the current case, so we get back a PartialResult + ic <- mkOneConFull x con + mb_delta' <- pmIsSatisfiable delta (ic_tm_ct ic) (ic_ty_cs ic) (ic_strict_arg_tys ic) + pr_pos <- case mb_delta' of + Nothing -> pure mempty + Just delta' -> do + tracePm "success" (ppr (delta_tm_cs delta)) + pmcheckHdI p ps guards (ic_val_abs ic) (ValVec vas delta') + + let pr_neg = mkUnmatched x (PmAltConLike con) vva + tracePm "ConVar" (vcat [ppr p, ppr x, ppr pr_pos, ppr pr_neg]) + + -- Combine both into a single PartialResult + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- LitVar -pmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta) - = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$> - mkUnion non_matched <$> - case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of - Just tm_state -> pmcheckHdI p ps guards (PmLit l) $ - ValVec vva (delta {delta_tm_cs = tm_state}) - Nothing -> return mempty - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] +pmcheckHd p@(PmLit l) ps guards (PmVar x) vva@(ValVec vas delta) = do + pr_pos <- case solveOneEq (delta_tm_cs delta) (TVC x (mkPmExprLit l)) of + Nothing -> pure mempty + Just tms -> pmcheckHdI p ps guards (PmLit l) vva' + where + vva'= ValVec vas (delta { delta_tm_cs = tms }) - non_matched = usimple us - --- LitNLit -pmcheckHd (p@(PmLit l)) ps guards - (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta) - | all (not . eqPmLit l) lits - , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l) - -- Both guards check the same so it would be sufficient to have only - -- the second one. Nevertheless, it is much cheaper to check whether - -- the literal is in the list so we check it first, to avoid calling - -- the term oracle (`solveOneEq`) if possible - = mkUnion non_matched <$> - pmcheckHdI p ps guards (PmLit l) - (ValVec vva (delta { delta_tm_cs = tm_state })) - | otherwise = return non_matched - where - -- See Note [Refutable shapes] in TmOracle - us | Just tm_state <- addSolveRefutableAltCon (delta_tm_cs delta) x (PmAltLit l) - = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })] - | otherwise = [] + let pr_neg = mkUnmatched x (PmAltLit l) vva - non_matched = usimple us + let pr = mkUnion pr_pos pr_neg + pure (forceIfCanDiverge x (delta_tm_cs delta) pr) -- ---------------------------------------------------------------------------- -- The following three can happen only in cases like #322 where constructors @@ -2153,7 +2221,7 @@ pmcheckHd (p@(PmLit l)) ps guards -- LitCon pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType va) + = do y <- mkPmId (pmPatType va) -- Analogous to the ConVar case, we have to case split the value -- abstraction on possible literals. We do so by introducing a fresh -- variable that is equated to the constructor. LitVar will then take @@ -2164,18 +2232,14 @@ pmcheckHd p at PmLit{} ps guards va at PmCon{} (ValVec vva delta) -- ConLit pmcheckHd p at PmCon{} ps guards (PmLit l) (ValVec vva delta) - = do y <- liftD $ mkPmId (pmPatType p) + = do y <- mkPmId (pmPatType p) -- This desugars to the ConVar case by introducing a fresh variable that -- is equated to the literal via a constraint. ConVar will then properly -- case split on all possible constructors. - let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta) + let tm_state = extendSubst y (mkPmExprLit l) (delta_tm_cs delta) delta' = delta { delta_tm_cs = tm_state } pmcheckHdI p ps guards (PmVar y) (ValVec vva delta') --- ConNLit -pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva - = pmcheckHdI p ps guards (PmVar x) vva - -- Impossible: handled by pmcheck pmcheckHd PmFake _ _ _ _ = panic "pmcheckHd: Fake" pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard" @@ -2323,9 +2387,8 @@ ucon va = updateVsa upd -- value vector abstractions of length `(a+n)`, pass the first `n` value -- abstractions to the constructor (Hence, the resulting value vector -- abstractions will have length `n+1`) -kcon :: ConLike -> [Type] -> [TyVar] -> [EvVar] - -> PartialResult -> PartialResult -kcon con arg_tys ex_tvs dicts +kcon :: ConLike -> [Type] -> [TyVar] -> PartialResult -> PartialResult +kcon con arg_tys ex_tvs = let n = conLikeArity con upd vsa = [ ValVec (va:vva) delta @@ -2334,7 +2397,6 @@ kcon con arg_tys ex_tvs dicts , let va = PmCon { pm_con_con = con , pm_con_arg_tys = arg_tys , pm_con_tvs = ex_tvs - , pm_con_dicts = dicts , pm_con_args = args } ] in updateVsa upd @@ -2354,13 +2416,19 @@ mkCons vva = updateVsa (vva:) forces :: PartialResult -> PartialResult forces pres = pres { presultDivergent = Diverged } --- | Set the divergent set to non-empty if the flag is `True` -force_if :: Bool -> PartialResult -> PartialResult -force_if True pres = forces pres -force_if False pres = pres +-- | Set the divergent set to non-empty if the variable has not been forced yet +forceIfCanDiverge :: Id -> TmState -> PartialResult -> PartialResult +forceIfCanDiverge x tms + | canDiverge (idName x) tms = forces + | otherwise = id -set_provenance :: Provenance -> PartialResult -> PartialResult -set_provenance prov pr = pr { presultProvenance = prov } +mkUnmatched :: Id -> PmAltCon -> ValVec -> PartialResult +mkUnmatched x nalt (ValVec vva delta) = usimple us + where + -- See Note [Refutable shapes] in TmOracle + us | Just tms <- tryAddRefutableAltCon (delta_tm_cs delta) x nalt + = [ValVec (PmVar x : vva) (delta { delta_tm_cs = tms })] + | otherwise = [] -- ---------------------------------------------------------------------------- -- * Propagation of term constraints inwards when checking nested matches @@ -2369,7 +2437,7 @@ set_provenance prov pr = pr { presultProvenance = prov } ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 `addTmCsDs' in PmMonad that store in the environment type and +`addDictsDs' and `addTmCsDs' in DsMonad that store in the environment type and term constraints (respectively) as we go deeper. The type constraints we propagate inwards are collected by `collectEvVarsPats' @@ -2478,11 +2546,11 @@ isAnyPmCheckEnabled :: DynFlags -> DsMatchContext -> Bool isAnyPmCheckEnabled dflags (DsMatchContext kind _loc) = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind -instance Outputable ValVec where - ppr (ValVec vva delta) - = let (subst, refuts) = wrapUpTmState (delta_tm_cs delta) - vector = substInValAbs subst vva - in pprUncovered (vector, refuts) +pprValVecSubstituted :: ValVec -> SDoc +pprValVecSubstituted (ValVec vva delta) = pprUncovered (vector, refuts) + where + (subst, refuts) = wrapUpTmState (delta_tm_cs delta) + vector = substInValAbs subst vva -- | Apply a term substitution to a value vector abstraction. All VAs are -- transformed to PmExpr (used only before pretty printing). @@ -2493,8 +2561,8 @@ substInValAbs subst = map (exprDeepLookup subst . vaToPmExpr) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd + let exists_r = flag_i && notNull redundant + exists_i = flag_i && notNull inaccessible && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -2511,8 +2579,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result UncoveredPatterns candidates -> pprEqns candidates where PmResult - { pmresultProvenance = prov - , pmresultRedundant = redundant + { pmresultRedundant = redundant , pmresultUncovered = uncovered , pmresultInaccessible = inaccessible } = pm_result @@ -2523,8 +2590,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result is_rec_upd = case kind of { RecUpd -> True; _ -> False } -- See Note [Inaccessible warnings for record updates] - onlyBuiltin = prov == FromBuiltin - maxPatterns = maxUncoveredPatterns dflags -- Print a single clause (for redundant/with-inaccessible-rhs) @@ -2536,7 +2601,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result case qs of -- See #11245 [ValVec [] _] -> text "Guards do not cover entire pattern space" - _missing -> let us = map ppr qs + _missing -> let us = map pprValVecSubstituted qs in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -2637,39 +2702,8 @@ pprPats kind pats -- Debugging Infrastructre tracePm :: String -> SDoc -> PmM () -tracePm herald doc = liftD $ tracePmD herald doc - - -tracePmD :: String -> SDoc -> DsM () -tracePmD herald doc = do +tracePm herald doc = do dflags <- getDynFlags printer <- mkPrintUnqualifiedDs liftIO $ dumpIfSet_dyn_printer printer dflags Opt_D_dump_ec_trace (text herald $$ (nest 2 doc)) - - -pprPmPatDebug :: PmPat a -> SDoc -pprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args) - = hsep [text "PmCon", ppr cc, hsep (map pprPmPatDebug con_args)] -pprPmPatDebug (PmVar vid) = text "PmVar" <+> ppr vid -pprPmPatDebug (PmLit li) = text "PmLit" <+> ppr li -pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl -pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv) - <+> ppr ge -pprPmPatDebug PmFake = text "PmFake" - -pprPatVec :: PatVec -> SDoc -pprPatVec ps = hang (text "Pattern:") 2 - (brackets $ sep - $ punctuate (comma <> char '\n') (map pprPmPatDebug ps)) - -pprValAbs :: [ValAbs] -> SDoc -pprValAbs ps = hang (text "ValAbs:") 2 - (brackets $ sep - $ punctuate (comma) (map pprPmPatDebug ps)) - -pprValVecDebug :: ValVec -> SDoc -pprValVecDebug (ValVec vas _d) = text "ValVec" <+> - parens (pprValAbs vas) - -- $$ ppr (delta_tm_cs _d) - -- $$ ppr (delta_ty_cs _d) ===================================== compiler/deSugar/PmExpr.hs ===================================== @@ -9,14 +9,15 @@ Haskell expressions (as used by the pattern matching checker) and utilities. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module PmExpr ( - PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), - eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr + PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), isNotPmExprOther, + lhsExprToPmExpr, hsExprToPmExpr, mkPmExprLit, pmExprAsList ) where #include "HsVersions.h" import GhcPrelude +import Util import BasicTypes (SourceText) import FastString (FastString, unpackFS) import HsSyn @@ -29,6 +30,7 @@ import TcType (isStringTy) import TysWiredIn import Outputable import SrcLoc +import Data.Bifunctor (first) {- %************************************************************************ @@ -53,34 +55,29 @@ refer to variables that are otherwise substituted away. -- | Lifted expressions for pattern match checking. data PmExpr = PmExprVar Name - | PmExprCon ConLike [PmExpr] - | PmExprLit PmLit + | PmExprCon PmAltCon [PmExpr] | PmExprOther (HsExpr GhcTc) -- Note [PmExprOther in PmExpr] - -mkPmExprData :: DataCon -> [PmExpr] -> PmExpr -mkPmExprData dc args = PmExprCon (RealDataCon dc) args - -- | Literals (simple and overloaded ones) for pattern match checking. +-- +-- See Note [Undecidable Equality for Overloaded Literals] data PmLit = PmSLit (HsLit GhcTc) -- simple | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded + deriving Eq --- | Equality between literals for pattern match checking. -eqPmLit :: PmLit -> PmLit -> Bool -eqPmLit (PmSLit l1) (PmSLit l2) = l1 == l2 -eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2 - -- See Note [Undecidable Equality for Overloaded Literals] -eqPmLit _ _ = False - --- | Represents a match against a literal. We mostly use it to to encode shapes --- for a variable that immediately lead to a refutation. +-- | Represents a match against a 'ConLike' or literal. We mostly use it to +-- to encode shapes for a variable that immediately lead to a refutation. -- -- See Note [Refutable shapes] in TmOracle. Really similar to 'CoreSyn.AltCon'. -newtype PmAltCon = PmAltLit PmLit - deriving Outputable +data PmAltCon = PmAltConLike ConLike + | PmAltLit PmLit + deriving Eq + +mkPmExprData :: DataCon -> [PmExpr] -> PmExpr +mkPmExprData dc args = PmExprCon (PmAltConLike (RealDataCon dc)) args -instance Eq PmAltCon where - PmAltLit l1 == PmAltLit l2 = eqPmLit l1 l2 +mkPmExprLit :: PmLit -> PmExpr +mkPmExprLit l = PmExprCon (PmAltLit l) [] {- Note [Undecidable Equality for Overloaded Literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -192,17 +189,17 @@ hsExprToPmExpr (HsVar _ x) = PmExprVar (idName (unLoc x)) hsExprToPmExpr (HsOverLit _ olit) | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty = stringExprToList src s - | otherwise = PmExprLit (PmOLit False olit) + | otherwise = PmExprCon (PmAltLit (PmOLit False olit)) [] hsExprToPmExpr (HsLit _ lit) | HsString src s <- lit = stringExprToList src s - | otherwise = PmExprLit (PmSLit lit) + | otherwise = PmExprCon (PmAltLit (PmSLit lit)) [] hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _) - | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr + | PmExprCon (PmAltLit (PmOLit False olit)) _ <- hsExprToPmExpr neg_expr -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x at . when extension -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x. - = PmExprLit (PmOLit True olit) + = PmExprCon (PmAltLit (PmOLit False olit)) [] | otherwise = PmExprOther e hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e @@ -249,7 +246,35 @@ stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s)) where cons x xs = mkPmExprData consDataCon [x,xs] nil = mkPmExprData nilDataCon [] - charToPmExpr c = PmExprLit (PmSLit (HsChar src c)) + charToPmExpr c = PmExprCon (PmAltLit (PmSLit (HsChar src c))) [] + +-- | Return @Just@ a 'DataCon' application or @Nothing@, otherwise. +pmExprToDataConApp :: PmExpr -> Maybe (DataCon, [PmExpr]) +pmExprToDataConApp (PmExprCon (PmAltConLike (RealDataCon c)) es) = Just (c, es) +pmExprToDataConApp _ = Nothing + +-- | Extract a list of 'PmExpr's out of a sequence of cons cells, optionally +-- terminated by a wildcard variable instead of @[]@. +-- +-- So, @pmExprAsList (a:b:[]) == Just ([a,b], Nothing)@ is a @[]@ terminated, +-- while @pmExprAsList (a:b:c) == Just ([a,b], Just c)@ signifies a list prefix +-- @[a,b]++@ with an unspecified suffix represented by @c at . The prefix shall +-- never be empty if a suffix is returned (we don't consider that a list). +-- Returns @Nothing@ in all other cases. +pmExprAsList :: PmExpr -> Maybe ([PmExpr], Maybe Name) +pmExprAsList = go False + where + go allow_id_suffix (PmExprVar x) + -- We only allow an Id suffix when we are sure the prefix is not empty + | allow_id_suffix + = Just ([], Just x) + go _ (pmExprToDataConApp -> Just (c, es)) + | c == nilDataCon + = ASSERT( null es ) Just ([], Nothing) + | c == consDataCon + = ASSERT( length es == 2 ) first (es !! 0 :) <$> go True (es !! 1) + go _ _ + = Nothing {- %************************************************************************ @@ -263,18 +288,19 @@ instance Outputable PmLit where ppr (PmSLit l) = pmPprHsLit l ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l +instance Outputable PmAltCon where + ppr (PmAltConLike cl) = ppr cl + ppr (PmAltLit l) = ppr l + instance Outputable PmExpr where ppr = go (0 :: Int) where - go _ (PmExprLit l) = ppr l - go _ (PmExprVar v) = ppr v - go _ (PmExprOther e) = angleBrackets (ppr e) - go _ (PmExprCon (RealDataCon dc) args) - | isTupleDataCon dc = parens $ comma_sep $ map ppr args - | dc == consDataCon = brackets $ comma_sep $ map ppr (list_cells args) - where - comma_sep = fsep . punctuate comma - list_cells (hd:tl) = hd : list_cells tl - list_cells _ = [] + go _ (PmExprVar v) = ppr v + go _ (PmExprOther e) = angleBrackets (ppr e) + go _ (pmExprAsList -> Just (list, suff)) = case suff of + Nothing -> brackets $ fsep $ punctuate comma $ map ppr list + Just x -> parens $ fcat $ punctuate colon $ map ppr list ++ [ppr x] + go _ (pmExprToDataConApp -> Just (dc, args)) + | isTupleDataCon dc = parens $ fsep $ punctuate comma $ map ppr args go prec (PmExprCon cl args) - = cparen (null args || prec > 0) (hcat (ppr cl:map (go 1) args)) + = cparen (notNull args && prec > 0) (hsep (ppr cl:map (go 1) args)) ===================================== compiler/deSugar/PmPpr.hs ===================================== @@ -21,8 +21,8 @@ import TysWiredIn import Outputable import Control.Monad.Trans.State.Strict import Maybes -import Util +import PmExpr import TmOracle -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its @@ -35,6 +35,9 @@ import TmOracle -- where p is not one of {3, 4} -- q is not one of {0, 5} -- @ +-- +-- When the set of refutable shapes contains more than 3 elements, the +-- additional elements are indicated by "...". pprUncovered :: ([PmExpr], PmRefutEnv) -> SDoc pprUncovered (expr_vec, refuts) | null cs = fsep vec -- there are no literal constraints @@ -45,12 +48,17 @@ pprUncovered (expr_vec, refuts) (vec,cs) = runPmPpr sdoc_vec (prettifyRefuts refuts) -- | Output refutable shapes of a variable in the form of @var is not one of {2, --- Nothing, 3}@. +-- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is +-- indicated by an ellipsis. pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc pprRefutableShapes (var, alts) - = var <+> text "is not one of" <+> braces (pprWithCommas ppr_alt alts) + = var <+> text "is not one of" <+> format_alts alts where - ppr_alt (PmAltLit lit) = ppr lit + format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt + shorten (a:b:c:_:_) = a:b:c:[text "..."] + shorten xs = xs + ppr_alt (PmAltConLike cl) = ppr cl + ppr_alt (PmAltLit lit) = ppr lit {- 1. Literals ~~~~~~~~~~~~~~ @@ -86,7 +94,7 @@ type PrettyPmRefutEnv = DNameEnv (SDoc, [PmAltCon]) prettifyRefuts :: PmRefutEnv -> PrettyPmRefutEnv prettifyRefuts = listToUDFM . zipWith rename nameList . udfmToList where - rename new (old, lits) = (old, (new, lits)) + rename new (old, (_ty, lits)) = (old, (new, lits)) -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ @@ -124,48 +132,35 @@ pprPmExpr (PmExprVar x) = do Just name -> addUsed x >> return name Nothing -> return underscore pprPmExpr (PmExprCon con args) = pprPmExprCon con args -pprPmExpr (PmExprLit l) = return (ppr l) pprPmExpr (PmExprOther _) = return underscore -- don't show needsParens :: PmExpr -> Bool -needsParens (PmExprVar {}) = False -needsParens (PmExprLit l) = isNegatedPmLit l -needsParens (PmExprOther {}) = False -- will become a wildcard -needsParens (PmExprCon (RealDataCon c) es) - | isTupleDataCon c - || isConsDataCon c || null es = False - | otherwise = True -needsParens (PmExprCon (PatSynCon _) es) = not (null es) +needsParens (PmExprVar {}) = False +needsParens (PmExprOther {}) = False -- will become a wildcard +needsParens (PmExprCon (PmAltLit l) _) = isNegatedPmLit l +needsParens (PmExprCon (PmAltConLike (RealDataCon c)) _) + | isTupleDataCon c || isConsDataCon c = False +needsParens (PmExprCon _ es) = not (null es) pprPmExprWithParens :: PmExpr -> PmPprM SDoc pprPmExprWithParens expr | needsParens expr = parens <$> pprPmExpr expr | otherwise = pprPmExpr expr -pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc -pprPmExprCon (RealDataCon con) args - | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args - | isConsDataCon con = pretty_list - where - mkTuple :: [SDoc] -> SDoc - mkTuple = parens . fsep . punctuate comma - - -- lazily, to be used in the list case only - pretty_list :: PmPprM SDoc - pretty_list = case isNilPmExpr (last list) of - True -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list) - False -> parens . hcat . punctuate colon <$> mapM pprPmExpr list - - list = list_elements args - - list_elements [x,y] - | PmExprCon c es <- y, RealDataCon nilDataCon == c - = ASSERT(null es) [x,y] - | PmExprCon c es <- y, RealDataCon consDataCon == c - = x : list_elements es - | otherwise = [x,y] - list_elements list = pprPanic "list_elements:" (ppr list) -pprPmExprCon cl args +pprPmExprCon :: PmAltCon -> [PmExpr] -> PmPprM SDoc +pprPmExprCon (PmAltConLike cl) args = pprConLike cl args +pprPmExprCon (PmAltLit l) _ = pure (ppr l) + +pprConLike :: ConLike -> [PmExpr] -> PmPprM SDoc +pprConLike cl args + | Just (list, suff) <- pmExprAsList (PmExprCon (PmAltConLike cl) args) + = case suff of + Nothing -> brackets . fsep . punctuate comma <$> mapM pprPmExpr list + Just x -> parens . fcat . punctuate colon <$> mapM pprPmExpr (list ++ [PmExprVar x]) +pprConLike (RealDataCon con) args + | isTupleDataCon con + = parens . fsep . punctuate comma <$> mapM pprPmExpr args +pprConLike cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmExprWithParens x y' <- pprPmExprWithParens y @@ -181,11 +176,6 @@ isNegatedPmLit :: PmLit -> Bool isNegatedPmLit (PmOLit b _) = b isNegatedPmLit _other_lit = False --- | Check whether a PmExpr is syntactically e -isNilPmExpr :: PmExpr -> Bool -isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon -isNilPmExpr _other_expr = False - -- | Check if a DataCon is (:). isConsDataCon :: DataCon -> Bool isConsDataCon con = consDataCon == con ===================================== compiler/deSugar/TmOracle.hs ===================================== @@ -5,20 +5,16 @@ Author: George Karachalias {-# LANGUAGE CPP, MultiWayIf #-} -- | The term equality oracle. The main export of the module are the functions --- 'tmOracle', 'solveOneEq' and 'addSolveRefutableAltCon'. +-- 'tmOracle', 'solveOneEq' and 'tryAddRefutableAltCon'. -- -- If you are looking for an oracle that can solve type-level constraints, look -- at 'TcSimplify.tcCheckSatisfiability'. module TmOracle ( - -- re-exported from PmExpr - PmExpr(..), PmLit(..), PmAltCon(..), TmVarCt(..), TmVarCtEnv, - PmRefutEnv, eqPmLit, isNotPmExprOther, lhsExprToPmExpr, hsExprToPmExpr, - -- the term oracle - tmOracle, TmState, initialTmState, wrapUpTmState, solveOneEq, - extendSubst, canDiverge, isRigid, - addSolveRefutableAltCon, lookupRefutableAltCons, + tmOracle, TmVarCtEnv, PmRefutEnv, TmState, initialTmState, + wrapUpTmState, solveOneEq, extendSubst, canDiverge, isRigid, + tryAddRefutableAltCon, lookupRefutableAltCons, -- misc. exprDeepLookup, pmLitType @@ -33,16 +29,16 @@ import PmExpr import Util import Id import Name +import NameEnv +import UniqFM +import UniqDFM import Type import HsLit import TcHsSyn import MonadUtils -import ListSetOps (insertNoDup, unionLists) +import ListSetOps (unionLists) import Maybes import Outputable -import NameEnv -import UniqFM -import UniqDFM {- %************************************************************************ @@ -58,14 +54,16 @@ import UniqDFM type TmVarCtEnv = NameEnv PmExpr -- | An environment assigning shapes to variables that immediately lead to a --- refutation. So, if this maps @x :-> [3]@, then trying to solve a 'TmVarCt' --- like @x ~ 3@ immediately leads to a contradiction. +-- refutation. So, if this maps @x :-> [Just]@, then trying to solve a +-- 'TmVarCt' like @x ~ Just False@ immediately leads to a contradiction. +-- Additionally, this stores the 'Type' from which to draw 'ConLike's from. +-- -- Determinism is important since we use this for warning messages in -- 'PmPpr.pprUncovered'. We don't do the same for 'TmVarCtEnv', so that is a plain -- 'NameEnv'. -- -- See also Note [Refutable shapes] in TmOracle. -type PmRefutEnv = DNameEnv [PmAltCon] +type PmRefutEnv = DNameEnv (Type, [PmAltCon]) -- | The state of the term oracle. Tracks all term-level facts of the form "x is -- @True@" ('tm_pos') and "x is not @5@" ('tm_neg'). @@ -81,13 +79,19 @@ data TmState = TmS -- advantage that when we update the solution for @y@ above, we automatically -- update the solution for @x@ in a union-find-like fashion. -- Invariant: Only maps to other variables ('PmExprVar') or to WHNFs - -- ('PmExprLit', 'PmExprCon'). Ergo, never maps to a 'PmExprOther'. + -- ('PmExprCon'). Ergo, never maps to a 'PmExprOther'. , tm_neg :: !PmRefutEnv -- ^ Maps each variable @x@ to a list of 'PmAltCon's that @x@ definitely - -- cannot match. Example, @x :-> [3, 4]@ means that @x@ cannot match a literal - -- 3 or 4. Should we later solve @x@ to a variable @y@ - -- ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into those of - -- @y at . See also Note [The Pos/Neg invariant]. + -- 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 . Should we later solve @x@ to a variable + -- @y@ ('extendSubstAndSolve'), we merge the refutable shapes of @x@ into + -- those of @y at . See also Note [The Pos/Neg invariant]. } {- Note [The Pos/Neg invariant] @@ -113,7 +117,7 @@ instance Outputable TmState where pos = map pos_eq (nonDetUFMToList (tm_pos state)) neg = map neg_eq (udfmToList (tm_neg state)) pos_eq (l, r) = ppr l <+> char '~' <+> ppr r - neg_eq (l, r) = ppr l <+> char '≁' <+> ppr r + neg_eq (l, r) = ppr l <+> text "/~" <+> ppr r -- | Initial state of the oracle. initialTmState :: TmState @@ -148,21 +152,23 @@ canDiverge x TmS{ tm_pos = pos, tm_neg = neg } -- | Check whether the equality @x ~ e@ leads to a refutation. Make sure that -- @x@ and @e@ are completely substituted before! isRefutable :: Name -> PmExpr -> PmRefutEnv -> Bool -isRefutable x e env - = fromMaybe False $ elem <$> exprToAlt e <*> lookupDNameEnv env x +isRefutable x e env = fromMaybe False $ do + alt <- exprToAlt e + (_, nalts) <- lookupDNameEnv env x + pure (elem alt nalts) -- | Solve an equality (top-level). solveOneEq :: TmState -> TmVarCt -> Maybe TmState solveOneEq solver_env (TVC x e) = unify solver_env (PmExprVar (idName x), e) exprToAlt :: PmExpr -> Maybe PmAltCon -exprToAlt (PmExprLit l) = Just (PmAltLit l) -exprToAlt _ = Nothing +exprToAlt (PmExprCon c _) = Just c +exprToAlt _ = Nothing -- | Record that a particular 'Id' can't take the shape of a 'PmAltCon' in the -- 'TmState' and return @Nothing@ if that leads to a contradiction. -addSolveRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState -addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt +tryAddRefutableAltCon :: TmState -> Id -> PmAltCon -> Maybe TmState +tryAddRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt = case exprToAlt e of -- We have to take care to preserve Note [The Pos/Neg invariant] Nothing -> Just extended -- Not solved yet @@ -172,20 +178,24 @@ addSolveRefutableAltCon original at TmS{ tm_pos = pos, tm_neg = neg } x nalt where -- refutation redundant (y, e) = varDeepLookup pos (idName x) extended = original { tm_neg = neg' } - neg' = alterDNameEnv (delNulls (insertNoDup nalt)) neg y + neg' = extendDNameEnv_C combineRefutEntries neg y (idType x, [nalt]) --- | When updating 'tm_neg', we want to delete any 'null' entries. This adapter --- intends to provide a suitable interface for 'alterDNameEnv'. -delNulls :: ([a] -> [a]) -> Maybe [a] -> Maybe [a] -delNulls f mb_entry - | ret@(_:_) <- f (fromMaybe [] mb_entry) = Just ret - | otherwise = Nothing +-- | Combines two entries in a 'PmRefutEnv' by merging the set of refutable +-- 'PmAltCon's. +combineRefutEntries :: (Type, [PmAltCon]) -> (Type, [PmAltCon]) -> (Type, [PmAltCon]) +combineRefutEntries (old_ty, old_nalts) (new_ty, new_nalts) + = ASSERT( eqType old_ty new_ty ) (old_ty, unionLists old_nalts new_nalts) -- | Return all 'PmAltCon' shapes that are impossible for 'Id' to take, i.e. -- would immediately lead to a refutation by the term oracle. -lookupRefutableAltCons :: Id -> TmState -> [PmAltCon] -lookupRefutableAltCons x TmS { tm_neg = neg } - = fromMaybe [] (lookupDNameEnv neg (idName x)) +-- +-- Note that because of Note [The Pos/Neg invariant], this will return an empty +-- list of alt cons for 'Id's which already have a solution. +lookupRefutableAltCons :: TmState -> Id -> (Type, [PmAltCon]) +lookupRefutableAltCons _tms at TmS{ tm_pos = pos, tm_neg = neg } x + = fromMaybe (idType x, []) (lookupDNameEnv neg y) + where + (y, _e) = varDeepLookup pos (idName x) -- | Is the given variable /rigid/ (i.e., we have a solution for it) or -- /flexible/ (i.e., no solution)? Returns the solution if /rigid/. A @@ -197,6 +207,11 @@ isRigid TmS{ tm_pos = pos } x = lookupNameEnv pos x isFlexible :: TmState -> Name -> Bool isFlexible tms = isNothing . isRigid tms +-- | Is this a solution for a variable, i.e., something in WHNF? +isSolution :: PmExpr -> Bool +isSolution PmExprCon{} = True +isSolution _ = False + -- | Try to unify two 'PmExpr's and record the gained knowledge in the -- 'TmState'. -- @@ -209,12 +224,8 @@ unify tms eq@(e1, e2) = case eq of (PmExprOther _,_) -> boring (_,PmExprOther _) -> boring - (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of - -- See Note [Undecidable Equality for Overloaded Literals] - True -> boring - False -> unsat - (PmExprCon c1 ts1, PmExprCon c2 ts2) + -- See Note [Undecidable Equality for Overloaded Literals] | c1 == c2 -> foldlM unify tms (zip ts1 ts2) | otherwise -> unsat @@ -231,9 +242,6 @@ unify tms eq@(e1, e2) = case eq of (PmExprVar x, PmExprVar y) -> Just (equate x y tms) (PmExprVar x, _) -> trySolve x e2 tms (_, PmExprVar y) -> trySolve y e1 tms - - _ -> WARN( True, text "unify: Catch all" <+> ppr eq) - boring -- I HATE CATCH-ALLS where boring = Just tms unsat = Nothing @@ -252,28 +260,25 @@ equate x y tms at TmS{ tm_pos = pos, tm_neg = neg } pos' = extendNameEnv pos x (PmExprVar y) -- Be careful to uphold Note [The Pos/Neg invariant] by merging the refuts -- of x into those of y - nalts = fromMaybe [] (lookupDNameEnv neg x) - neg' = alterDNameEnv (delNulls (unionLists nalts)) neg y - `delFromDNameEnv` x + neg' = case lookupDNameEnv neg x of + Nothing -> neg + Just entry -> extendDNameEnv_C combineRefutEntries neg y entry + `delFromDNameEnv` x tms' = TmS { tm_pos = pos', tm_neg = neg' } -- | Extend the substitution with a mapping @x: -> e@ if compatible with -- refutable shapes of @x@ and its solution, reject (@Nothing@) otherwise. -- -- Precondition: @x@ is flexible (cf. 'isFlexible'/'isRigid'). --- Precondition: @e@ is a 'PmExprCon' or 'PmExprLit' +-- Precondition: @e@ is a solution, i.e., 'PmExprCon' (cf. 'isSolution'). trySolve:: Name -> PmExpr -> TmState -> Maybe TmState trySolve x e _tms at TmS{ tm_pos = pos, tm_neg = neg } | ASSERT( isFlexible _tms x ) - ASSERT( _is_whnf e ) + ASSERT( isSolution e ) isRefutable x e neg = Nothing | otherwise = Just (TmS (extendNameEnv pos x e) (delFromDNameEnv neg x)) - where - _is_whnf PmExprCon{} = True - _is_whnf PmExprLit{} = True - _is_whnf _ = False -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -303,7 +308,7 @@ varDeepLookup env x = case lookupNameEnv env x of exprDeepLookup :: TmVarCtEnv -> PmExpr -> PmExpr exprDeepLookup env (PmExprVar x) = snd (varDeepLookup env x) exprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es) -exprDeepLookup _ other_expr = other_expr -- PmExprLit, PmExprOther +exprDeepLookup _ e at PmExprOther{} = e -- | External interface to the term oracle. tmOracle :: TmState -> [TmVarCt] -> Maybe TmState @@ -354,9 +359,17 @@ second clause and report the clause as redundant. After the third clause, the set of such *refutable* literals is again extended to `[0, 1]`. In general, we want to store a set of refutable shapes (`PmAltCon`) for each -variable. That's the purpose of the `PmRefutEnv`. `addSolveRefutableAltCon` will -add such a refutable mapping to the `PmRefutEnv` in the term oracles state and -check if causes any immediate contradiction. Whenever we record a solution in -the substitution via `extendSubstAndSolve`, the refutable environment is checked -for any matching refutable `PmAltCon`. +variable. That's the purpose of the `PmRefutEnv`. This extends to +`ConLike`s, where all value arguments are universally quantified implicitly. +So, if the `PmRefutEnv` contains an entry for `x` with `Just [Bool]`, then this +corresponds to the fact that `forall y. x ≁ Just @Bool y`. + +`tryAddRefutableAltCon` will add such a refutable mapping to the `PmRefutEnv` +in the term oracles state and check if it causes any immediate contradiction. +Whenever we record a solution in the substitution via `extendSubstAndSolve`, the +refutable environment is checked for any matching refutable `PmAltCon`. + +Note that `PmAltConLike` carries a list of type arguments. This purely for the +purpose of being able to reconstruct all other constructors of the matching +group the `ConLike` is part of through calling `allCompleteMatches` in Check. -} ===================================== compiler/ghc.cabal.in ===================================== @@ -557,7 +557,6 @@ Library IOEnv Json ListSetOps - ListT Maybes MonadUtils OrdList ===================================== compiler/utils/Binary.hs ===================================== @@ -724,7 +724,6 @@ putTypeRep bh (Fun arg res) = do put_ bh (3 :: Word8) putTypeRep bh arg putTypeRep bh res -putTypeRep _ _ = fail "Binary.putTypeRep: Impossible" getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, removeDups, findDupsEq, insertNoDup, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -169,10 +169,3 @@ findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs - --- | \( O(n) \). @'insertNoDup' x xs@ treats @xs@ as a set, inserting @x@ only --- when an equal element couldn't be found in @xs at . -insertNoDup :: (Eq a) => a -> [a] -> [a] -insertNoDup x set - | elem x set = set - | otherwise = x:set ===================================== compiler/utils/ListT.hs deleted ===================================== @@ -1,80 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -------------------------------------------------------------------------- --- | --- Module : Control.Monad.Logic --- Copyright : (c) Dan Doel --- License : BSD3 --- --- Maintainer : dan.doel at gmail.com --- Stability : experimental --- Portability : non-portable (multi-parameter type classes) --- --- A backtracking, logic programming monad. --- --- Adapted from the paper --- /Backtracking, Interleaving, and Terminating --- Monad Transformers/, by --- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry --- (). -------------------------------------------------------------------------- - -module ListT ( - ListT(..), - runListT, - select, - fold - ) where - -import GhcPrelude - -import Control.Applicative - -import Control.Monad -import Control.Monad.Fail as MonadFail - -------------------------------------------------------------------------- --- | A monad transformer for performing backtracking computations --- layered over another monad 'm' -newtype ListT m a = - ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r } - -select :: Monad m => [a] -> ListT m a -select xs = foldr (<|>) mzero (map pure xs) - -fold :: ListT m a -> (a -> m r -> m r) -> m r -> m r -fold = runListT - -------------------------------------------------------------------------- --- | Runs a ListT computation with the specified initial success and --- failure continuations. -runListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r -runListT = unListT - -instance Functor (ListT f) where - fmap f lt = ListT $ \sk fk -> unListT lt (sk . f) fk - -instance Applicative (ListT f) where - pure a = ListT $ \sk fk -> sk a fk - f <*> a = ListT $ \sk fk -> unListT f (\g fk' -> unListT a (sk . g) fk') fk - -instance Alternative (ListT f) where - empty = ListT $ \_ fk -> fk - f1 <|> f2 = ListT $ \sk fk -> unListT f1 sk (unListT f2 sk fk) - -instance Monad (ListT m) where - m >>= f = ListT $ \sk fk -> unListT m (\a fk' -> unListT (f a) sk fk') fk -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail (ListT m) where - fail _ = ListT $ \_ fk -> fk - -instance MonadPlus (ListT m) where - mzero = ListT $ \_ fk -> fk - m1 `mplus` m2 = ListT $ \sk fk -> unListT m1 sk (unListT m2 sk fk) ===================================== docs/users_guide/glasgow_exts.rst ===================================== @@ -15420,49 +15420,6 @@ the user must provide a type signature. :: foo :: [a] -> Int foo T = 5 -.. _multiple-complete-pragmas: - -Disambiguating between multiple ``COMPLETE`` pragmas ----------------------------------------------------- - -What should happen if there are multiple ``COMPLETE`` sets that apply to a -single set of patterns? Consider this example: :: - - data T = MkT1 | MkT2 | MkT2Internal - {-# COMPLETE MkT1, MkT2 #-} - {-# COMPLETE MkT1, MkT2Internal #-} - - f :: T -> Bool - f MkT1 = True - f MkT2 = False - -Which ``COMPLETE`` pragma should be used when checking the coverage of the -patterns in ``f``? If we pick the ``COMPLETE`` set that covers ``MkT1`` and -``MkT2``, then ``f`` is exhaustive, but if we pick the other ``COMPLETE`` set -that covers ``MkT1`` and ``MkT2Internal``, then ``f`` is *not* exhaustive, -since it fails to match ``MkT2Internal``. An intuitive way to solve this -dilemma is to recognize that picking the former ``COMPLETE`` set produces the -fewest number of uncovered pattern clauses, and thus is the better choice. - -GHC disambiguates between multiple ``COMPLETE`` sets based on this rationale. -To make things more formal, when the pattern-match checker requests a set of -constructors for some data type constructor ``T``, the checker returns: - -* The original set of data constructors for ``T`` -* Any ``COMPLETE`` sets of type ``T`` - -GHC then checks for pattern coverage using each of these sets. If any of these -sets passes the pattern coverage checker with no warnings, then we are done. If -each set produces at least one warning, then GHC must pick one of the sets of -warnings depending on how good the results are. The results are prioritized in -this order: - -1. Fewest uncovered clauses -2. Fewest redundant clauses -3. Fewest inaccessible clauses -4. Whether the match comes from the original set of data constructors or from a - ``COMPLETE`` pragma (prioritizing the former over the latter) - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/perf/compiler/ManyAlternatives.hs ===================================== @@ -0,0 +1,2005 @@ +module ManyAlternatives where + +data A1000 = A0 + | A0001 + | A0002 + | A0003 + | A0004 + | A0005 + | A0006 + | A0007 + | A0008 + | A0009 + | A0010 + | A0011 + | A0012 + | A0013 + | A0014 + | A0015 + | A0016 + | A0017 + | A0018 + | A0019 + | A0020 + | A0021 + | A0022 + | A0023 + | A0024 + | A0025 + | A0026 + | A0027 + | A0028 + | A0029 + | A0030 + | A0031 + | A0032 + | A0033 + | A0034 + | A0035 + | A0036 + | A0037 + | A0038 + | A0039 + | A0040 + | A0041 + | A0042 + | A0043 + | A0044 + | A0045 + | A0046 + | A0047 + | A0048 + | A0049 + | A0050 + | A0051 + | A0052 + | A0053 + | A0054 + | A0055 + | A0056 + | A0057 + | A0058 + | A0059 + | A0060 + | A0061 + | A0062 + | A0063 + | A0064 + | A0065 + | A0066 + | A0067 + | A0068 + | A0069 + | A0070 + | A0071 + | A0072 + | A0073 + | A0074 + | A0075 + | A0076 + | A0077 + | A0078 + | A0079 + | A0080 + | A0081 + | A0082 + | A0083 + | A0084 + | A0085 + | A0086 + | A0087 + | A0088 + | A0089 + | A0090 + | A0091 + | A0092 + | A0093 + | A0094 + | A0095 + | A0096 + | A0097 + | A0098 + | A0099 + | A0100 + | A0101 + | A0102 + | A0103 + | A0104 + | A0105 + | A0106 + | A0107 + | A0108 + | A0109 + | A0110 + | A0111 + | A0112 + | A0113 + | A0114 + | A0115 + | A0116 + | A0117 + | A0118 + | A0119 + | A0120 + | A0121 + | A0122 + | A0123 + | A0124 + | A0125 + | A0126 + | A0127 + | A0128 + | A0129 + | A0130 + | A0131 + | A0132 + | A0133 + | A0134 + | A0135 + | A0136 + | A0137 + | A0138 + | A0139 + | A0140 + | A0141 + | A0142 + | A0143 + | A0144 + | A0145 + | A0146 + | A0147 + | A0148 + | A0149 + | A0150 + | A0151 + | A0152 + | A0153 + | A0154 + | A0155 + | A0156 + | A0157 + | A0158 + | A0159 + | A0160 + | A0161 + | A0162 + | A0163 + | A0164 + | A0165 + | A0166 + | A0167 + | A0168 + | A0169 + | A0170 + | A0171 + | A0172 + | A0173 + | A0174 + | A0175 + | A0176 + | A0177 + | A0178 + | A0179 + | A0180 + | A0181 + | A0182 + | A0183 + | A0184 + | A0185 + | A0186 + | A0187 + | A0188 + | A0189 + | A0190 + | A0191 + | A0192 + | A0193 + | A0194 + | A0195 + | A0196 + | A0197 + | A0198 + | A0199 + | A0200 + | A0201 + | A0202 + | A0203 + | A0204 + | A0205 + | A0206 + | A0207 + | A0208 + | A0209 + | A0210 + | A0211 + | A0212 + | A0213 + | A0214 + | A0215 + | A0216 + | A0217 + | A0218 + | A0219 + | A0220 + | A0221 + | A0222 + | A0223 + | A0224 + | A0225 + | A0226 + | A0227 + | A0228 + | A0229 + | A0230 + | A0231 + | A0232 + | A0233 + | A0234 + | A0235 + | A0236 + | A0237 + | A0238 + | A0239 + | A0240 + | A0241 + | A0242 + | A0243 + | A0244 + | A0245 + | A0246 + | A0247 + | A0248 + | A0249 + | A0250 + | A0251 + | A0252 + | A0253 + | A0254 + | A0255 + | A0256 + | A0257 + | A0258 + | A0259 + | A0260 + | A0261 + | A0262 + | A0263 + | A0264 + | A0265 + | A0266 + | A0267 + | A0268 + | A0269 + | A0270 + | A0271 + | A0272 + | A0273 + | A0274 + | A0275 + | A0276 + | A0277 + | A0278 + | A0279 + | A0280 + | A0281 + | A0282 + | A0283 + | A0284 + | A0285 + | A0286 + | A0287 + | A0288 + | A0289 + | A0290 + | A0291 + | A0292 + | A0293 + | A0294 + | A0295 + | A0296 + | A0297 + | A0298 + | A0299 + | A0300 + | A0301 + | A0302 + | A0303 + | A0304 + | A0305 + | A0306 + | A0307 + | A0308 + | A0309 + | A0310 + | A0311 + | A0312 + | A0313 + | A0314 + | A0315 + | A0316 + | A0317 + | A0318 + | A0319 + | A0320 + | A0321 + | A0322 + | A0323 + | A0324 + | A0325 + | A0326 + | A0327 + | A0328 + | A0329 + | A0330 + | A0331 + | A0332 + | A0333 + | A0334 + | A0335 + | A0336 + | A0337 + | A0338 + | A0339 + | A0340 + | A0341 + | A0342 + | A0343 + | A0344 + | A0345 + | A0346 + | A0347 + | A0348 + | A0349 + | A0350 + | A0351 + | A0352 + | A0353 + | A0354 + | A0355 + | A0356 + | A0357 + | A0358 + | A0359 + | A0360 + | A0361 + | A0362 + | A0363 + | A0364 + | A0365 + | A0366 + | A0367 + | A0368 + | A0369 + | A0370 + | A0371 + | A0372 + | A0373 + | A0374 + | A0375 + | A0376 + | A0377 + | A0378 + | A0379 + | A0380 + | A0381 + | A0382 + | A0383 + | A0384 + | A0385 + | A0386 + | A0387 + | A0388 + | A0389 + | A0390 + | A0391 + | A0392 + | A0393 + | A0394 + | A0395 + | A0396 + | A0397 + | A0398 + | A0399 + | A0400 + | A0401 + | A0402 + | A0403 + | A0404 + | A0405 + | A0406 + | A0407 + | A0408 + | A0409 + | A0410 + | A0411 + | A0412 + | A0413 + | A0414 + | A0415 + | A0416 + | A0417 + | A0418 + | A0419 + | A0420 + | A0421 + | A0422 + | A0423 + | A0424 + | A0425 + | A0426 + | A0427 + | A0428 + | A0429 + | A0430 + | A0431 + | A0432 + | A0433 + | A0434 + | A0435 + | A0436 + | A0437 + | A0438 + | A0439 + | A0440 + | A0441 + | A0442 + | A0443 + | A0444 + | A0445 + | A0446 + | A0447 + | A0448 + | A0449 + | A0450 + | A0451 + | A0452 + | A0453 + | A0454 + | A0455 + | A0456 + | A0457 + | A0458 + | A0459 + | A0460 + | A0461 + | A0462 + | A0463 + | A0464 + | A0465 + | A0466 + | A0467 + | A0468 + | A0469 + | A0470 + | A0471 + | A0472 + | A0473 + | A0474 + | A0475 + | A0476 + | A0477 + | A0478 + | A0479 + | A0480 + | A0481 + | A0482 + | A0483 + | A0484 + | A0485 + | A0486 + | A0487 + | A0488 + | A0489 + | A0490 + | A0491 + | A0492 + | A0493 + | A0494 + | A0495 + | A0496 + | A0497 + | A0498 + | A0499 + | A0500 + | A0501 + | A0502 + | A0503 + | A0504 + | A0505 + | A0506 + | A0507 + | A0508 + | A0509 + | A0510 + | A0511 + | A0512 + | A0513 + | A0514 + | A0515 + | A0516 + | A0517 + | A0518 + | A0519 + | A0520 + | A0521 + | A0522 + | A0523 + | A0524 + | A0525 + | A0526 + | A0527 + | A0528 + | A0529 + | A0530 + | A0531 + | A0532 + | A0533 + | A0534 + | A0535 + | A0536 + | A0537 + | A0538 + | A0539 + | A0540 + | A0541 + | A0542 + | A0543 + | A0544 + | A0545 + | A0546 + | A0547 + | A0548 + | A0549 + | A0550 + | A0551 + | A0552 + | A0553 + | A0554 + | A0555 + | A0556 + | A0557 + | A0558 + | A0559 + | A0560 + | A0561 + | A0562 + | A0563 + | A0564 + | A0565 + | A0566 + | A0567 + | A0568 + | A0569 + | A0570 + | A0571 + | A0572 + | A0573 + | A0574 + | A0575 + | A0576 + | A0577 + | A0578 + | A0579 + | A0580 + | A0581 + | A0582 + | A0583 + | A0584 + | A0585 + | A0586 + | A0587 + | A0588 + | A0589 + | A0590 + | A0591 + | A0592 + | A0593 + | A0594 + | A0595 + | A0596 + | A0597 + | A0598 + | A0599 + | A0600 + | A0601 + | A0602 + | A0603 + | A0604 + | A0605 + | A0606 + | A0607 + | A0608 + | A0609 + | A0610 + | A0611 + | A0612 + | A0613 + | A0614 + | A0615 + | A0616 + | A0617 + | A0618 + | A0619 + | A0620 + | A0621 + | A0622 + | A0623 + | A0624 + | A0625 + | A0626 + | A0627 + | A0628 + | A0629 + | A0630 + | A0631 + | A0632 + | A0633 + | A0634 + | A0635 + | A0636 + | A0637 + | A0638 + | A0639 + | A0640 + | A0641 + | A0642 + | A0643 + | A0644 + | A0645 + | A0646 + | A0647 + | A0648 + | A0649 + | A0650 + | A0651 + | A0652 + | A0653 + | A0654 + | A0655 + | A0656 + | A0657 + | A0658 + | A0659 + | A0660 + | A0661 + | A0662 + | A0663 + | A0664 + | A0665 + | A0666 + | A0667 + | A0668 + | A0669 + | A0670 + | A0671 + | A0672 + | A0673 + | A0674 + | A0675 + | A0676 + | A0677 + | A0678 + | A0679 + | A0680 + | A0681 + | A0682 + | A0683 + | A0684 + | A0685 + | A0686 + | A0687 + | A0688 + | A0689 + | A0690 + | A0691 + | A0692 + | A0693 + | A0694 + | A0695 + | A0696 + | A0697 + | A0698 + | A0699 + | A0700 + | A0701 + | A0702 + | A0703 + | A0704 + | A0705 + | A0706 + | A0707 + | A0708 + | A0709 + | A0710 + | A0711 + | A0712 + | A0713 + | A0714 + | A0715 + | A0716 + | A0717 + | A0718 + | A0719 + | A0720 + | A0721 + | A0722 + | A0723 + | A0724 + | A0725 + | A0726 + | A0727 + | A0728 + | A0729 + | A0730 + | A0731 + | A0732 + | A0733 + | A0734 + | A0735 + | A0736 + | A0737 + | A0738 + | A0739 + | A0740 + | A0741 + | A0742 + | A0743 + | A0744 + | A0745 + | A0746 + | A0747 + | A0748 + | A0749 + | A0750 + | A0751 + | A0752 + | A0753 + | A0754 + | A0755 + | A0756 + | A0757 + | A0758 + | A0759 + | A0760 + | A0761 + | A0762 + | A0763 + | A0764 + | A0765 + | A0766 + | A0767 + | A0768 + | A0769 + | A0770 + | A0771 + | A0772 + | A0773 + | A0774 + | A0775 + | A0776 + | A0777 + | A0778 + | A0779 + | A0780 + | A0781 + | A0782 + | A0783 + | A0784 + | A0785 + | A0786 + | A0787 + | A0788 + | A0789 + | A0790 + | A0791 + | A0792 + | A0793 + | A0794 + | A0795 + | A0796 + | A0797 + | A0798 + | A0799 + | A0800 + | A0801 + | A0802 + | A0803 + | A0804 + | A0805 + | A0806 + | A0807 + | A0808 + | A0809 + | A0810 + | A0811 + | A0812 + | A0813 + | A0814 + | A0815 + | A0816 + | A0817 + | A0818 + | A0819 + | A0820 + | A0821 + | A0822 + | A0823 + | A0824 + | A0825 + | A0826 + | A0827 + | A0828 + | A0829 + | A0830 + | A0831 + | A0832 + | A0833 + | A0834 + | A0835 + | A0836 + | A0837 + | A0838 + | A0839 + | A0840 + | A0841 + | A0842 + | A0843 + | A0844 + | A0845 + | A0846 + | A0847 + | A0848 + | A0849 + | A0850 + | A0851 + | A0852 + | A0853 + | A0854 + | A0855 + | A0856 + | A0857 + | A0858 + | A0859 + | A0860 + | A0861 + | A0862 + | A0863 + | A0864 + | A0865 + | A0866 + | A0867 + | A0868 + | A0869 + | A0870 + | A0871 + | A0872 + | A0873 + | A0874 + | A0875 + | A0876 + | A0877 + | A0878 + | A0879 + | A0880 + | A0881 + | A0882 + | A0883 + | A0884 + | A0885 + | A0886 + | A0887 + | A0888 + | A0889 + | A0890 + | A0891 + | A0892 + | A0893 + | A0894 + | A0895 + | A0896 + | A0897 + | A0898 + | A0899 + | A0900 + | A0901 + | A0902 + | A0903 + | A0904 + | A0905 + | A0906 + | A0907 + | A0908 + | A0909 + | A0910 + | A0911 + | A0912 + | A0913 + | A0914 + | A0915 + | A0916 + | A0917 + | A0918 + | A0919 + | A0920 + | A0921 + | A0922 + | A0923 + | A0924 + | A0925 + | A0926 + | A0927 + | A0928 + | A0929 + | A0930 + | A0931 + | A0932 + | A0933 + | A0934 + | A0935 + | A0936 + | A0937 + | A0938 + | A0939 + | A0940 + | A0941 + | A0942 + | A0943 + | A0944 + | A0945 + | A0946 + | A0947 + | A0948 + | A0949 + | A0950 + | A0951 + | A0952 + | A0953 + | A0954 + | A0955 + | A0956 + | A0957 + | A0958 + | A0959 + | A0960 + | A0961 + | A0962 + | A0963 + | A0964 + | A0965 + | A0966 + | A0967 + | A0968 + | A0969 + | A0970 + | A0971 + | A0972 + | A0973 + | A0974 + | A0975 + | A0976 + | A0977 + | A0978 + | A0979 + | A0980 + | A0981 + | A0982 + | A0983 + | A0984 + | A0985 + | A0986 + | A0987 + | A0988 + | A0989 + | A0990 + | A0991 + | A0992 + | A0993 + | A0994 + | A0995 + | A0996 + | A0997 + | A0998 + | A0999 + | A1000 + +f :: A1000 -> Int +f A0001 = 1990001 +f A0002 = 1990002 +f A0003 = 1990003 +f A0004 = 1990004 +f A0005 = 1990005 +f A0006 = 1990006 +f A0007 = 1990007 +f A0008 = 1990008 +f A0009 = 1990009 +f A0010 = 1990010 +f A0011 = 1990011 +f A0012 = 1990012 +f A0013 = 1990013 +f A0014 = 1990014 +f A0015 = 1990015 +f A0016 = 1990016 +f A0017 = 1990017 +f A0018 = 1990018 +f A0019 = 1990019 +f A0020 = 1990020 +f A0021 = 1990021 +f A0022 = 1990022 +f A0023 = 1990023 +f A0024 = 1990024 +f A0025 = 1990025 +f A0026 = 1990026 +f A0027 = 1990027 +f A0028 = 1990028 +f A0029 = 1990029 +f A0030 = 1990030 +f A0031 = 1990031 +f A0032 = 1990032 +f A0033 = 1990033 +f A0034 = 1990034 +f A0035 = 1990035 +f A0036 = 1990036 +f A0037 = 1990037 +f A0038 = 1990038 +f A0039 = 1990039 +f A0040 = 1990040 +f A0041 = 1990041 +f A0042 = 1990042 +f A0043 = 1990043 +f A0044 = 1990044 +f A0045 = 1990045 +f A0046 = 1990046 +f A0047 = 1990047 +f A0048 = 1990048 +f A0049 = 1990049 +f A0050 = 1990050 +f A0051 = 1990051 +f A0052 = 1990052 +f A0053 = 1990053 +f A0054 = 1990054 +f A0055 = 1990055 +f A0056 = 1990056 +f A0057 = 1990057 +f A0058 = 1990058 +f A0059 = 1990059 +f A0060 = 1990060 +f A0061 = 1990061 +f A0062 = 1990062 +f A0063 = 1990063 +f A0064 = 1990064 +f A0065 = 1990065 +f A0066 = 1990066 +f A0067 = 1990067 +f A0068 = 1990068 +f A0069 = 1990069 +f A0070 = 1990070 +f A0071 = 1990071 +f A0072 = 1990072 +f A0073 = 1990073 +f A0074 = 1990074 +f A0075 = 1990075 +f A0076 = 1990076 +f A0077 = 1990077 +f A0078 = 1990078 +f A0079 = 1990079 +f A0080 = 1990080 +f A0081 = 1990081 +f A0082 = 1990082 +f A0083 = 1990083 +f A0084 = 1990084 +f A0085 = 1990085 +f A0086 = 1990086 +f A0087 = 1990087 +f A0088 = 1990088 +f A0089 = 1990089 +f A0090 = 1990090 +f A0091 = 1990091 +f A0092 = 1990092 +f A0093 = 1990093 +f A0094 = 1990094 +f A0095 = 1990095 +f A0096 = 1990096 +f A0097 = 1990097 +f A0098 = 1990098 +f A0099 = 1990099 +f A0100 = 1990100 +f A0101 = 1990101 +f A0102 = 1990102 +f A0103 = 1990103 +f A0104 = 1990104 +f A0105 = 1990105 +f A0106 = 1990106 +f A0107 = 1990107 +f A0108 = 1990108 +f A0109 = 1990109 +f A0110 = 1990110 +f A0111 = 1990111 +f A0112 = 1990112 +f A0113 = 1990113 +f A0114 = 1990114 +f A0115 = 1990115 +f A0116 = 1990116 +f A0117 = 1990117 +f A0118 = 1990118 +f A0119 = 1990119 +f A0120 = 1990120 +f A0121 = 1990121 +f A0122 = 1990122 +f A0123 = 1990123 +f A0124 = 1990124 +f A0125 = 1990125 +f A0126 = 1990126 +f A0127 = 1990127 +f A0128 = 1990128 +f A0129 = 1990129 +f A0130 = 1990130 +f A0131 = 1990131 +f A0132 = 1990132 +f A0133 = 1990133 +f A0134 = 1990134 +f A0135 = 1990135 +f A0136 = 1990136 +f A0137 = 1990137 +f A0138 = 1990138 +f A0139 = 1990139 +f A0140 = 1990140 +f A0141 = 1990141 +f A0142 = 1990142 +f A0143 = 1990143 +f A0144 = 1990144 +f A0145 = 1990145 +f A0146 = 1990146 +f A0147 = 1990147 +f A0148 = 1990148 +f A0149 = 1990149 +f A0150 = 1990150 +f A0151 = 1990151 +f A0152 = 1990152 +f A0153 = 1990153 +f A0154 = 1990154 +f A0155 = 1990155 +f A0156 = 1990156 +f A0157 = 1990157 +f A0158 = 1990158 +f A0159 = 1990159 +f A0160 = 1990160 +f A0161 = 1990161 +f A0162 = 1990162 +f A0163 = 1990163 +f A0164 = 1990164 +f A0165 = 1990165 +f A0166 = 1990166 +f A0167 = 1990167 +f A0168 = 1990168 +f A0169 = 1990169 +f A0170 = 1990170 +f A0171 = 1990171 +f A0172 = 1990172 +f A0173 = 1990173 +f A0174 = 1990174 +f A0175 = 1990175 +f A0176 = 1990176 +f A0177 = 1990177 +f A0178 = 1990178 +f A0179 = 1990179 +f A0180 = 1990180 +f A0181 = 1990181 +f A0182 = 1990182 +f A0183 = 1990183 +f A0184 = 1990184 +f A0185 = 1990185 +f A0186 = 1990186 +f A0187 = 1990187 +f A0188 = 1990188 +f A0189 = 1990189 +f A0190 = 1990190 +f A0191 = 1990191 +f A0192 = 1990192 +f A0193 = 1990193 +f A0194 = 1990194 +f A0195 = 1990195 +f A0196 = 1990196 +f A0197 = 1990197 +f A0198 = 1990198 +f A0199 = 1990199 +f A0200 = 1990200 +f A0201 = 1990201 +f A0202 = 1990202 +f A0203 = 1990203 +f A0204 = 1990204 +f A0205 = 1990205 +f A0206 = 1990206 +f A0207 = 1990207 +f A0208 = 1990208 +f A0209 = 1990209 +f A0210 = 1990210 +f A0211 = 1990211 +f A0212 = 1990212 +f A0213 = 1990213 +f A0214 = 1990214 +f A0215 = 1990215 +f A0216 = 1990216 +f A0217 = 1990217 +f A0218 = 1990218 +f A0219 = 1990219 +f A0220 = 1990220 +f A0221 = 1990221 +f A0222 = 1990222 +f A0223 = 1990223 +f A0224 = 1990224 +f A0225 = 1990225 +f A0226 = 1990226 +f A0227 = 1990227 +f A0228 = 1990228 +f A0229 = 1990229 +f A0230 = 1990230 +f A0231 = 1990231 +f A0232 = 1990232 +f A0233 = 1990233 +f A0234 = 1990234 +f A0235 = 1990235 +f A0236 = 1990236 +f A0237 = 1990237 +f A0238 = 1990238 +f A0239 = 1990239 +f A0240 = 1990240 +f A0241 = 1990241 +f A0242 = 1990242 +f A0243 = 1990243 +f A0244 = 1990244 +f A0245 = 1990245 +f A0246 = 1990246 +f A0247 = 1990247 +f A0248 = 1990248 +f A0249 = 1990249 +f A0250 = 1990250 +f A0251 = 1990251 +f A0252 = 1990252 +f A0253 = 1990253 +f A0254 = 1990254 +f A0255 = 1990255 +f A0256 = 1990256 +f A0257 = 1990257 +f A0258 = 1990258 +f A0259 = 1990259 +f A0260 = 1990260 +f A0261 = 1990261 +f A0262 = 1990262 +f A0263 = 1990263 +f A0264 = 1990264 +f A0265 = 1990265 +f A0266 = 1990266 +f A0267 = 1990267 +f A0268 = 1990268 +f A0269 = 1990269 +f A0270 = 1990270 +f A0271 = 1990271 +f A0272 = 1990272 +f A0273 = 1990273 +f A0274 = 1990274 +f A0275 = 1990275 +f A0276 = 1990276 +f A0277 = 1990277 +f A0278 = 1990278 +f A0279 = 1990279 +f A0280 = 1990280 +f A0281 = 1990281 +f A0282 = 1990282 +f A0283 = 1990283 +f A0284 = 1990284 +f A0285 = 1990285 +f A0286 = 1990286 +f A0287 = 1990287 +f A0288 = 1990288 +f A0289 = 1990289 +f A0290 = 1990290 +f A0291 = 1990291 +f A0292 = 1990292 +f A0293 = 1990293 +f A0294 = 1990294 +f A0295 = 1990295 +f A0296 = 1990296 +f A0297 = 1990297 +f A0298 = 1990298 +f A0299 = 1990299 +f A0300 = 1990300 +f A0301 = 1990301 +f A0302 = 1990302 +f A0303 = 1990303 +f A0304 = 1990304 +f A0305 = 1990305 +f A0306 = 1990306 +f A0307 = 1990307 +f A0308 = 1990308 +f A0309 = 1990309 +f A0310 = 1990310 +f A0311 = 1990311 +f A0312 = 1990312 +f A0313 = 1990313 +f A0314 = 1990314 +f A0315 = 1990315 +f A0316 = 1990316 +f A0317 = 1990317 +f A0318 = 1990318 +f A0319 = 1990319 +f A0320 = 1990320 +f A0321 = 1990321 +f A0322 = 1990322 +f A0323 = 1990323 +f A0324 = 1990324 +f A0325 = 1990325 +f A0326 = 1990326 +f A0327 = 1990327 +f A0328 = 1990328 +f A0329 = 1990329 +f A0330 = 1990330 +f A0331 = 1990331 +f A0332 = 1990332 +f A0333 = 1990333 +f A0334 = 1990334 +f A0335 = 1990335 +f A0336 = 1990336 +f A0337 = 1990337 +f A0338 = 1990338 +f A0339 = 1990339 +f A0340 = 1990340 +f A0341 = 1990341 +f A0342 = 1990342 +f A0343 = 1990343 +f A0344 = 1990344 +f A0345 = 1990345 +f A0346 = 1990346 +f A0347 = 1990347 +f A0348 = 1990348 +f A0349 = 1990349 +f A0350 = 1990350 +f A0351 = 1990351 +f A0352 = 1990352 +f A0353 = 1990353 +f A0354 = 1990354 +f A0355 = 1990355 +f A0356 = 1990356 +f A0357 = 1990357 +f A0358 = 1990358 +f A0359 = 1990359 +f A0360 = 1990360 +f A0361 = 1990361 +f A0362 = 1990362 +f A0363 = 1990363 +f A0364 = 1990364 +f A0365 = 1990365 +f A0366 = 1990366 +f A0367 = 1990367 +f A0368 = 1990368 +f A0369 = 1990369 +f A0370 = 1990370 +f A0371 = 1990371 +f A0372 = 1990372 +f A0373 = 1990373 +f A0374 = 1990374 +f A0375 = 1990375 +f A0376 = 1990376 +f A0377 = 1990377 +f A0378 = 1990378 +f A0379 = 1990379 +f A0380 = 1990380 +f A0381 = 1990381 +f A0382 = 1990382 +f A0383 = 1990383 +f A0384 = 1990384 +f A0385 = 1990385 +f A0386 = 1990386 +f A0387 = 1990387 +f A0388 = 1990388 +f A0389 = 1990389 +f A0390 = 1990390 +f A0391 = 1990391 +f A0392 = 1990392 +f A0393 = 1990393 +f A0394 = 1990394 +f A0395 = 1990395 +f A0396 = 1990396 +f A0397 = 1990397 +f A0398 = 1990398 +f A0399 = 1990399 +f A0400 = 1990400 +f A0401 = 1990401 +f A0402 = 1990402 +f A0403 = 1990403 +f A0404 = 1990404 +f A0405 = 1990405 +f A0406 = 1990406 +f A0407 = 1990407 +f A0408 = 1990408 +f A0409 = 1990409 +f A0410 = 1990410 +f A0411 = 1990411 +f A0412 = 1990412 +f A0413 = 1990413 +f A0414 = 1990414 +f A0415 = 1990415 +f A0416 = 1990416 +f A0417 = 1990417 +f A0418 = 1990418 +f A0419 = 1990419 +f A0420 = 1990420 +f A0421 = 1990421 +f A0422 = 1990422 +f A0423 = 1990423 +f A0424 = 1990424 +f A0425 = 1990425 +f A0426 = 1990426 +f A0427 = 1990427 +f A0428 = 1990428 +f A0429 = 1990429 +f A0430 = 1990430 +f A0431 = 1990431 +f A0432 = 1990432 +f A0433 = 1990433 +f A0434 = 1990434 +f A0435 = 1990435 +f A0436 = 1990436 +f A0437 = 1990437 +f A0438 = 1990438 +f A0439 = 1990439 +f A0440 = 1990440 +f A0441 = 1990441 +f A0442 = 1990442 +f A0443 = 1990443 +f A0444 = 1990444 +f A0445 = 1990445 +f A0446 = 1990446 +f A0447 = 1990447 +f A0448 = 1990448 +f A0449 = 1990449 +f A0450 = 1990450 +f A0451 = 1990451 +f A0452 = 1990452 +f A0453 = 1990453 +f A0454 = 1990454 +f A0455 = 1990455 +f A0456 = 1990456 +f A0457 = 1990457 +f A0458 = 1990458 +f A0459 = 1990459 +f A0460 = 1990460 +f A0461 = 1990461 +f A0462 = 1990462 +f A0463 = 1990463 +f A0464 = 1990464 +f A0465 = 1990465 +f A0466 = 1990466 +f A0467 = 1990467 +f A0468 = 1990468 +f A0469 = 1990469 +f A0470 = 1990470 +f A0471 = 1990471 +f A0472 = 1990472 +f A0473 = 1990473 +f A0474 = 1990474 +f A0475 = 1990475 +f A0476 = 1990476 +f A0477 = 1990477 +f A0478 = 1990478 +f A0479 = 1990479 +f A0480 = 1990480 +f A0481 = 1990481 +f A0482 = 1990482 +f A0483 = 1990483 +f A0484 = 1990484 +f A0485 = 1990485 +f A0486 = 1990486 +f A0487 = 1990487 +f A0488 = 1990488 +f A0489 = 1990489 +f A0490 = 1990490 +f A0491 = 1990491 +f A0492 = 1990492 +f A0493 = 1990493 +f A0494 = 1990494 +f A0495 = 1990495 +f A0496 = 1990496 +f A0497 = 1990497 +f A0498 = 1990498 +f A0499 = 1990499 +f A0500 = 1990500 +f A0501 = 1990501 +f A0502 = 1990502 +f A0503 = 1990503 +f A0504 = 1990504 +f A0505 = 1990505 +f A0506 = 1990506 +f A0507 = 1990507 +f A0508 = 1990508 +f A0509 = 1990509 +f A0510 = 1990510 +f A0511 = 1990511 +f A0512 = 1990512 +f A0513 = 1990513 +f A0514 = 1990514 +f A0515 = 1990515 +f A0516 = 1990516 +f A0517 = 1990517 +f A0518 = 1990518 +f A0519 = 1990519 +f A0520 = 1990520 +f A0521 = 1990521 +f A0522 = 1990522 +f A0523 = 1990523 +f A0524 = 1990524 +f A0525 = 1990525 +f A0526 = 1990526 +f A0527 = 1990527 +f A0528 = 1990528 +f A0529 = 1990529 +f A0530 = 1990530 +f A0531 = 1990531 +f A0532 = 1990532 +f A0533 = 1990533 +f A0534 = 1990534 +f A0535 = 1990535 +f A0536 = 1990536 +f A0537 = 1990537 +f A0538 = 1990538 +f A0539 = 1990539 +f A0540 = 1990540 +f A0541 = 1990541 +f A0542 = 1990542 +f A0543 = 1990543 +f A0544 = 1990544 +f A0545 = 1990545 +f A0546 = 1990546 +f A0547 = 1990547 +f A0548 = 1990548 +f A0549 = 1990549 +f A0550 = 1990550 +f A0551 = 1990551 +f A0552 = 1990552 +f A0553 = 1990553 +f A0554 = 1990554 +f A0555 = 1990555 +f A0556 = 1990556 +f A0557 = 1990557 +f A0558 = 1990558 +f A0559 = 1990559 +f A0560 = 1990560 +f A0561 = 1990561 +f A0562 = 1990562 +f A0563 = 1990563 +f A0564 = 1990564 +f A0565 = 1990565 +f A0566 = 1990566 +f A0567 = 1990567 +f A0568 = 1990568 +f A0569 = 1990569 +f A0570 = 1990570 +f A0571 = 1990571 +f A0572 = 1990572 +f A0573 = 1990573 +f A0574 = 1990574 +f A0575 = 1990575 +f A0576 = 1990576 +f A0577 = 1990577 +f A0578 = 1990578 +f A0579 = 1990579 +f A0580 = 1990580 +f A0581 = 1990581 +f A0582 = 1990582 +f A0583 = 1990583 +f A0584 = 1990584 +f A0585 = 1990585 +f A0586 = 1990586 +f A0587 = 1990587 +f A0588 = 1990588 +f A0589 = 1990589 +f A0590 = 1990590 +f A0591 = 1990591 +f A0592 = 1990592 +f A0593 = 1990593 +f A0594 = 1990594 +f A0595 = 1990595 +f A0596 = 1990596 +f A0597 = 1990597 +f A0598 = 1990598 +f A0599 = 1990599 +f A0600 = 1990600 +f A0601 = 1990601 +f A0602 = 1990602 +f A0603 = 1990603 +f A0604 = 1990604 +f A0605 = 1990605 +f A0606 = 1990606 +f A0607 = 1990607 +f A0608 = 1990608 +f A0609 = 1990609 +f A0610 = 1990610 +f A0611 = 1990611 +f A0612 = 1990612 +f A0613 = 1990613 +f A0614 = 1990614 +f A0615 = 1990615 +f A0616 = 1990616 +f A0617 = 1990617 +f A0618 = 1990618 +f A0619 = 1990619 +f A0620 = 1990620 +f A0621 = 1990621 +f A0622 = 1990622 +f A0623 = 1990623 +f A0624 = 1990624 +f A0625 = 1990625 +f A0626 = 1990626 +f A0627 = 1990627 +f A0628 = 1990628 +f A0629 = 1990629 +f A0630 = 1990630 +f A0631 = 1990631 +f A0632 = 1990632 +f A0633 = 1990633 +f A0634 = 1990634 +f A0635 = 1990635 +f A0636 = 1990636 +f A0637 = 1990637 +f A0638 = 1990638 +f A0639 = 1990639 +f A0640 = 1990640 +f A0641 = 1990641 +f A0642 = 1990642 +f A0643 = 1990643 +f A0644 = 1990644 +f A0645 = 1990645 +f A0646 = 1990646 +f A0647 = 1990647 +f A0648 = 1990648 +f A0649 = 1990649 +f A0650 = 1990650 +f A0651 = 1990651 +f A0652 = 1990652 +f A0653 = 1990653 +f A0654 = 1990654 +f A0655 = 1990655 +f A0656 = 1990656 +f A0657 = 1990657 +f A0658 = 1990658 +f A0659 = 1990659 +f A0660 = 1990660 +f A0661 = 1990661 +f A0662 = 1990662 +f A0663 = 1990663 +f A0664 = 1990664 +f A0665 = 1990665 +f A0666 = 1990666 +f A0667 = 1990667 +f A0668 = 1990668 +f A0669 = 1990669 +f A0670 = 1990670 +f A0671 = 1990671 +f A0672 = 1990672 +f A0673 = 1990673 +f A0674 = 1990674 +f A0675 = 1990675 +f A0676 = 1990676 +f A0677 = 1990677 +f A0678 = 1990678 +f A0679 = 1990679 +f A0680 = 1990680 +f A0681 = 1990681 +f A0682 = 1990682 +f A0683 = 1990683 +f A0684 = 1990684 +f A0685 = 1990685 +f A0686 = 1990686 +f A0687 = 1990687 +f A0688 = 1990688 +f A0689 = 1990689 +f A0690 = 1990690 +f A0691 = 1990691 +f A0692 = 1990692 +f A0693 = 1990693 +f A0694 = 1990694 +f A0695 = 1990695 +f A0696 = 1990696 +f A0697 = 1990697 +f A0698 = 1990698 +f A0699 = 1990699 +f A0700 = 1990700 +f A0701 = 1990701 +f A0702 = 1990702 +f A0703 = 1990703 +f A0704 = 1990704 +f A0705 = 1990705 +f A0706 = 1990706 +f A0707 = 1990707 +f A0708 = 1990708 +f A0709 = 1990709 +f A0710 = 1990710 +f A0711 = 1990711 +f A0712 = 1990712 +f A0713 = 1990713 +f A0714 = 1990714 +f A0715 = 1990715 +f A0716 = 1990716 +f A0717 = 1990717 +f A0718 = 1990718 +f A0719 = 1990719 +f A0720 = 1990720 +f A0721 = 1990721 +f A0722 = 1990722 +f A0723 = 1990723 +f A0724 = 1990724 +f A0725 = 1990725 +f A0726 = 1990726 +f A0727 = 1990727 +f A0728 = 1990728 +f A0729 = 1990729 +f A0730 = 1990730 +f A0731 = 1990731 +f A0732 = 1990732 +f A0733 = 1990733 +f A0734 = 1990734 +f A0735 = 1990735 +f A0736 = 1990736 +f A0737 = 1990737 +f A0738 = 1990738 +f A0739 = 1990739 +f A0740 = 1990740 +f A0741 = 1990741 +f A0742 = 1990742 +f A0743 = 1990743 +f A0744 = 1990744 +f A0745 = 1990745 +f A0746 = 1990746 +f A0747 = 1990747 +f A0748 = 1990748 +f A0749 = 1990749 +f A0750 = 1990750 +f A0751 = 1990751 +f A0752 = 1990752 +f A0753 = 1990753 +f A0754 = 1990754 +f A0755 = 1990755 +f A0756 = 1990756 +f A0757 = 1990757 +f A0758 = 1990758 +f A0759 = 1990759 +f A0760 = 1990760 +f A0761 = 1990761 +f A0762 = 1990762 +f A0763 = 1990763 +f A0764 = 1990764 +f A0765 = 1990765 +f A0766 = 1990766 +f A0767 = 1990767 +f A0768 = 1990768 +f A0769 = 1990769 +f A0770 = 1990770 +f A0771 = 1990771 +f A0772 = 1990772 +f A0773 = 1990773 +f A0774 = 1990774 +f A0775 = 1990775 +f A0776 = 1990776 +f A0777 = 1990777 +f A0778 = 1990778 +f A0779 = 1990779 +f A0780 = 1990780 +f A0781 = 1990781 +f A0782 = 1990782 +f A0783 = 1990783 +f A0784 = 1990784 +f A0785 = 1990785 +f A0786 = 1990786 +f A0787 = 1990787 +f A0788 = 1990788 +f A0789 = 1990789 +f A0790 = 1990790 +f A0791 = 1990791 +f A0792 = 1990792 +f A0793 = 1990793 +f A0794 = 1990794 +f A0795 = 1990795 +f A0796 = 1990796 +f A0797 = 1990797 +f A0798 = 1990798 +f A0799 = 1990799 +f A0800 = 1990800 +f A0801 = 1990801 +f A0802 = 1990802 +f A0803 = 1990803 +f A0804 = 1990804 +f A0805 = 1990805 +f A0806 = 1990806 +f A0807 = 1990807 +f A0808 = 1990808 +f A0809 = 1990809 +f A0810 = 1990810 +f A0811 = 1990811 +f A0812 = 1990812 +f A0813 = 1990813 +f A0814 = 1990814 +f A0815 = 1990815 +f A0816 = 1990816 +f A0817 = 1990817 +f A0818 = 1990818 +f A0819 = 1990819 +f A0820 = 1990820 +f A0821 = 1990821 +f A0822 = 1990822 +f A0823 = 1990823 +f A0824 = 1990824 +f A0825 = 1990825 +f A0826 = 1990826 +f A0827 = 1990827 +f A0828 = 1990828 +f A0829 = 1990829 +f A0830 = 1990830 +f A0831 = 1990831 +f A0832 = 1990832 +f A0833 = 1990833 +f A0834 = 1990834 +f A0835 = 1990835 +f A0836 = 1990836 +f A0837 = 1990837 +f A0838 = 1990838 +f A0839 = 1990839 +f A0840 = 1990840 +f A0841 = 1990841 +f A0842 = 1990842 +f A0843 = 1990843 +f A0844 = 1990844 +f A0845 = 1990845 +f A0846 = 1990846 +f A0847 = 1990847 +f A0848 = 1990848 +f A0849 = 1990849 +f A0850 = 1990850 +f A0851 = 1990851 +f A0852 = 1990852 +f A0853 = 1990853 +f A0854 = 1990854 +f A0855 = 1990855 +f A0856 = 1990856 +f A0857 = 1990857 +f A0858 = 1990858 +f A0859 = 1990859 +f A0860 = 1990860 +f A0861 = 1990861 +f A0862 = 1990862 +f A0863 = 1990863 +f A0864 = 1990864 +f A0865 = 1990865 +f A0866 = 1990866 +f A0867 = 1990867 +f A0868 = 1990868 +f A0869 = 1990869 +f A0870 = 1990870 +f A0871 = 1990871 +f A0872 = 1990872 +f A0873 = 1990873 +f A0874 = 1990874 +f A0875 = 1990875 +f A0876 = 1990876 +f A0877 = 1990877 +f A0878 = 1990878 +f A0879 = 1990879 +f A0880 = 1990880 +f A0881 = 1990881 +f A0882 = 1990882 +f A0883 = 1990883 +f A0884 = 1990884 +f A0885 = 1990885 +f A0886 = 1990886 +f A0887 = 1990887 +f A0888 = 1990888 +f A0889 = 1990889 +f A0890 = 1990890 +f A0891 = 1990891 +f A0892 = 1990892 +f A0893 = 1990893 +f A0894 = 1990894 +f A0895 = 1990895 +f A0896 = 1990896 +f A0897 = 1990897 +f A0898 = 1990898 +f A0899 = 1990899 +f A0900 = 1990900 +f A0901 = 1990901 +f A0902 = 1990902 +f A0903 = 1990903 +f A0904 = 1990904 +f A0905 = 1990905 +f A0906 = 1990906 +f A0907 = 1990907 +f A0908 = 1990908 +f A0909 = 1990909 +f A0910 = 1990910 +f A0911 = 1990911 +f A0912 = 1990912 +f A0913 = 1990913 +f A0914 = 1990914 +f A0915 = 1990915 +f A0916 = 1990916 +f A0917 = 1990917 +f A0918 = 1990918 +f A0919 = 1990919 +f A0920 = 1990920 +f A0921 = 1990921 +f A0922 = 1990922 +f A0923 = 1990923 +f A0924 = 1990924 +f A0925 = 1990925 +f A0926 = 1990926 +f A0927 = 1990927 +f A0928 = 1990928 +f A0929 = 1990929 +f A0930 = 1990930 +f A0931 = 1990931 +f A0932 = 1990932 +f A0933 = 1990933 +f A0934 = 1990934 +f A0935 = 1990935 +f A0936 = 1990936 +f A0937 = 1990937 +f A0938 = 1990938 +f A0939 = 1990939 +f A0940 = 1990940 +f A0941 = 1990941 +f A0942 = 1990942 +f A0943 = 1990943 +f A0944 = 1990944 +f A0945 = 1990945 +f A0946 = 1990946 +f A0947 = 1990947 +f A0948 = 1990948 +f A0949 = 1990949 +f A0950 = 1990950 +f A0951 = 1990951 +f A0952 = 1990952 +f A0953 = 1990953 +f A0954 = 1990954 +f A0955 = 1990955 +f A0956 = 1990956 +f A0957 = 1990957 +f A0958 = 1990958 +f A0959 = 1990959 +f A0960 = 1990960 +f A0961 = 1990961 +f A0962 = 1990962 +f A0963 = 1990963 +f A0964 = 1990964 +f A0965 = 1990965 +f A0966 = 1990966 +f A0967 = 1990967 +f A0968 = 1990968 +f A0969 = 1990969 +f A0970 = 1990970 +f A0971 = 1990971 +f A0972 = 1990972 +f A0973 = 1990973 +f A0974 = 1990974 +f A0975 = 1990975 +f A0976 = 1990976 +f A0977 = 1990977 +f A0978 = 1990978 +f A0979 = 1990979 +f A0980 = 1990980 +f A0981 = 1990981 +f A0982 = 1990982 +f A0983 = 1990983 +f A0984 = 1990984 +f A0985 = 1990985 +f A0986 = 1990986 +f A0987 = 1990987 +f A0988 = 1990988 +f A0989 = 1990989 +f A0990 = 1990990 +f A0991 = 1990991 +f A0992 = 1990992 +f A0993 = 1990993 +f A0994 = 1990994 +f A0995 = 1990995 +f A0996 = 1990996 +f A0997 = 1990997 +f A0998 = 1990998 +f A0999 = 1990999 +f A1000 = 1991000 ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data Boolean = F | T + deriving Eq + +pattern TooGoodToBeTrue :: Boolean +pattern TooGoodToBeTrue = T +{-# COMPLETE F, TooGoodToBeTrue #-} + +catchAll :: Boolean -> Int +catchAll F = 0 +catchAll TooGoodToBeTrue = 1 +catchAll _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363a.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363a.hs:15:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `catchAll': catchAll _ = ... + | +14 | catchAll _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +data T = A | B | C + deriving Eq + +pattern BC :: T +pattern BC = C + +{-# COMPLETE A, BC #-} + +f A = 1 +f B = 2 +f BC = 3 +f _ = error "impossible" ===================================== testsuite/tests/pmcheck/complete_sigs/T13363b.stderr ===================================== @@ -0,0 +1,7 @@ + +testsuite/tests/pmcheck/complete_sigs/T13363b.hs:16:1: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for `f': f _ = ... + | +16 | f _ = error "impossible" + | ^^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -14,4 +14,6 @@ test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) test('T14059a', normal, compile, ['']) -test('T14253', expect_broken(14253), compile, ['']) +test('T14253', normal, compile, ['']) +test('T13363a', normal, compile, ['-Wall']) +test('T13363b', normal, compile, ['-Wall']) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -92,6 +92,14 @@ test('pmc006', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('pmc007', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc008', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc009', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc010', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('pmc011', reqlib('ghc'), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11245', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T12949', [], compile, ['-fwarn-overlapping-patterns']) ===================================== testsuite/tests/pmcheck/should_compile/pmc008.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module PMC008 where + +-- complete match, but because of the guard, the information that `x` is not +-- `Just` has to flow through the term oracle. +foo :: Maybe Int -> Int +foo x | Just y <- x = y +foo Nothing = 43 ===================================== testsuite/tests/pmcheck/should_compile/pmc009.hs ===================================== @@ -0,0 +1,7 @@ +module Lib where + +data D = A | B + +f :: D -> D -> D +f A A = A +f B B = B ===================================== testsuite/tests/pmcheck/should_compile/pmc010.hs ===================================== @@ -0,0 +1,9 @@ +module Lib where + +data D = A | B | C | D + +f :: D -> D -> D +f A A = A +f B B = B +f C C = C +f D D = D ===================================== testsuite/tests/pmcheck/should_compile/pmc011.hs ===================================== @@ -0,0 +1,12 @@ +module HsUtils where +import HsBinds +import SrcLoc + + +-- | We have to be careful to normalise @SrcSpanLess (LHsBind)@ to +-- @LHsBindLR l r@ before passing the representative of @unLoc bind@ on to +-- @mkOneConFull@, otherwise this triggers a panic in @zipTvSubst at . +addPatSynSelector:: LHsBind p -> [a] +addPatSynSelector bind + | PatSynBind _ _ <- unLoc bind + = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f41c8c4bffe9b9992e23fa18e3fc3e985d29f571 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f41c8c4bffe9b9992e23fa18e3fc3e985d29f571 You're receiving 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 Jun 11 16:09:57 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 12:09:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Warn about unused packages Message-ID: <5cffd2551b186_6f73fe5f7f88eec22420a3@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e2e82e7a by Yuras Shumovich at 2019-06-11T16:09:40Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 09c1c9bb by Alp Mestanogullari at 2019-06-11T16:09:42Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - d9d03b1a by Alec Theriault at 2019-06-11T16:09:44Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - d3475c61 by Alp Mestanogullari at 2019-06-11T16:09:45Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 60c9be3d by Alp Mestanogullari at 2019-06-11T16:09:47Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - 0667d9de by Ben Gamari at 2019-06-11T16:09:47Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 575332f9 by Ben Gamari at 2019-06-11T16:09:47Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 437629b6 by Ömer Sinan Ağacan at 2019-06-11T16:09:49Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - e25ff26d by Alp Mestanogullari at 2019-06-11T16:09:50Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 30 changed files: - compiler/ghc.cabal.in - compiler/ghci/GHCi.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplCore.hs - compiler/typecheck/TcAnnotations.hs - compiler/typecheck/TcPluginM.hs - compiler/utils/Util.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/phases.rst - docs/users_guide/using-warnings.rst - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Packages.hs - includes/rts/Config.h - libraries/ghci/GHCi/BreakArray.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/ghci.cabal.in - rts/CheckUnload.c - rts/Linker.c - rts/RtsFlags.c - rts/linker/Elf.c - testsuite/mk/boilerplate.mk - testsuite/tests/codeGen/should_compile/jmp_tbl.hs - testsuite/tests/haddock/haddock_testsuite/Makefile - testsuite/tests/haddock/haddock_testsuite/all.T - + testsuite/tests/warnings/should_compile/UnusedPackages.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/13d8adec0022b018696a26b65df775a99e641701...e25ff26d89a0b89103d8905ef126dea0973dd78b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/13d8adec0022b018696a26b65df775a99e641701...e25ff26d89a0b89103d8905ef126dea0973dd78b You're receiving 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 Jun 11 16:35:08 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 12:35:08 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-arm-relocs] Apply suggestion to rts/linker/elf_got.c Message-ID: <5cffd83cd3f70_6f73fe5f7bd778022600b6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/angerman/fix-arm-relocs at Glasgow Haskell Compiler / GHC Commits: dd40bcac by Ben Gamari at 2019-06-11T16:35:07Z Apply suggestion to rts/linker/elf_got.c - - - - - 1 changed file: - rts/linker/elf_got.c Changes: ===================================== rts/linker/elf_got.c ===================================== @@ -1,4 +1,5 @@ #include "elf_got.h" +#include #if defined(OBJFORMAT_ELF) /* * Check if we need a global offset table slot for a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dd40bcac812264e31ede0d3e2aba6cd6a0a0b120 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dd40bcac812264e31ede0d3e2aba6cd6a0a0b120 You're receiving 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 Jun 11 16:35:13 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 12:35:13 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-arm-relocs] Apply suggestion to rts/linker/Elf.c Message-ID: <5cffd8417e6e4_6f73fe5f7bd77802260771@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/angerman/fix-arm-relocs at Glasgow Haskell Compiler / GHC Commits: 4a014433 by Ben Gamari at 2019-06-11T16:35:12Z Apply suggestion to rts/linker/Elf.c - - - - - 1 changed file: - rts/linker/Elf.c Changes: ===================================== rts/linker/Elf.c ===================================== @@ -1034,6 +1034,9 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, * - GOT_ORG is the addressing origin of the Global Offset Table (the indirection table for imported data addresses). * This value must always be word-aligned. See §4.6.1.8, Proxy generating relocations. * - GOT(S) is the address of the GOT entry for the symbol S. + * + * See the ELF for "ARM Specification" for details: + * https://developer.arm.com/architectures/system-architectures/software-standards/abi */ for (j = 0; j < nent; j++) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a014433f0b0b9995005e03fdb737a1aa09047d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4a014433f0b0b9995005e03fdb737a1aa09047d0 You're receiving 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 Jun 11 17:11:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 13:11:29 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 5 commits: testsuite: Fix T8602 on musl Message-ID: <5cffe0c120b69_6f73fe6054f39242264326@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 44db05be by Ben Gamari at 2019-06-11T16:45:24Z testsuite: Fix T8602 on musl Musl wants hash-bangs on all executables. - - - - - 19fdfe44 by Ben Gamari at 2019-06-11T16:48:32Z testsuite: Ensure T5423 flushes C output buffer Previously T5423 would fail to flush the printf output buffer. Consequently it was platform-dependent whether the C or Haskell print output would be emitted first. - - - - - 0a9d247b by Ben Gamari at 2019-06-11T16:56:53Z testsuite: Fix escaping in uses of grep Relying on grep's default mode is dangerous since it seems different systems differ in their defaults. Explicitly use `grep -e` to avoid this. - - - - - 381d696d by Ben Gamari at 2019-06-11T17:04:05Z testsuite: Flush conc059's printf buffer Otherwise it the order out the Haskell and C output will be system-dependent. - - - - - 81dd0eaa by Ben Gamari at 2019-06-11T17:09:55Z testsuite: Ensure that ffi005 output order is predictable The libc output buffer wasn't being flushed, making the order system-depedent. - - - - - 8 changed files: - testsuite/tests/concurrent/should_run/conc059.stdout - testsuite/tests/concurrent/should_run/conc059_c.c - testsuite/tests/driver/T8602/T8602.script - testsuite/tests/ffi/should_run/ffi005.hs - testsuite/tests/numeric/should_run/Makefile - testsuite/tests/numeric/should_run/T7014.primops - testsuite/tests/rts/T5423_cmm.cmm - testsuite/tests/simplCore/should_compile/Makefile Changes: ===================================== testsuite/tests/concurrent/should_run/conc059.stdout ===================================== @@ -1,3 +1,3 @@ -500000 exiting... +500000 exited. ===================================== testsuite/tests/concurrent/should_run/conc059_c.c ===================================== @@ -16,6 +16,7 @@ int main(int argc, char *argv[]) usleep(100000); #endif printf("exiting...\n"); + fflush(stdout); hs_exit(); printf("exited.\n"); #if mingw32_HOST_OS ===================================== testsuite/tests/driver/T8602/T8602.script ===================================== @@ -1,3 +1,4 @@ +:! echo '#!/bin/sh' >> t8602.sh :! echo 'echo $4 $5 $6; exit 1' > t8602.sh :! chmod +x t8602.sh :load A ===================================== testsuite/tests/ffi/should_run/ffi005.hs ===================================== @@ -21,6 +21,7 @@ main = do putStrLn "\nTesting puts (and withString)" withCString "Test successful" puts + c_fflush c_stdout putStrLn "\nTesting peekArray0" s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0')) @@ -71,6 +72,8 @@ withBuffer sz m = do return s foreign import ccall puts :: CString -> IO CInt +foreign import ccall "fflush" c_fflush :: Ptr () -> IO CInt +foreign import ccall "stdio.h stdout" c_stdout :: Ptr () -- foreign import ccall "open" open' :: CString -> CInt -> IO CInt -- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt ===================================== testsuite/tests/numeric/should_run/Makefile ===================================== @@ -6,5 +6,5 @@ include $(TOP)/mk/test.mk T7014: rm -f T7014.simpl T7014.o T7014.hi '$(TEST_HC)' -Wall -v0 -O --make T7014.hs -fforce-recomp -ddump-simpl > T7014.simpl - ! grep -q -f T7014.primops T7014.simpl + ! grep -e -q -f T7014.primops T7014.simpl ./T7014 ===================================== testsuite/tests/numeric/should_run/T7014.primops ===================================== @@ -1,9 +1,9 @@ and# or# uncheckedShift.*# -\+# -\-# -\*# ++# +-# +*# quotInt# remInt# plusFloat# ===================================== testsuite/tests/rts/T5423_cmm.cmm ===================================== @@ -12,5 +12,6 @@ test (W_ r1, { foreign "C" printf("%d %d %d %d %d %d %d %d %d %d\n", r1, r2, r3, r4, r5, r6, r7, r8, r9, r10); + foreign "C" fflush(stdout); return (r10); } ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -233,7 +233,7 @@ str-rules: # g should have been collapsed into one defininition by CSE. .PHONY: T13340 T13340: - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -c '\+#' + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -e -c '+#' # We expect to see all dictionaries specialized away. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b6b8202744b8aea160fae39d977b04ad32f4f3a5...81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b6b8202744b8aea160fae39d977b04ad32f4f3a5...81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6 You're receiving 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 Jun 11 17:21:57 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 13:21:57 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] 354 commits: Hadrian: Bump Shake to 0.17.6 Message-ID: <5cffe3352595c_6f73fe61e8b62c8226552b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: ab41c1b4 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: Bump Shake to 0.17.6 The new release of Shake comes with these relevant features: * use symlinks for --shared * add --compact for a Bazel/Buck style output - - - - - 646f2e79 by Andrey Mokhov at 2019-03-27T11:20:03Z Hadrian: trace the execution of expensive Cabal calls We use Cabal to parse, configure, register and copy packages, which are expensive operations that are currently not visible to Shake's profiling infrastructure. By using `traced` we tell Shake to add these IO actions to the profiling report, helping us to identify performance bottlenecks. We use short tracing keys, as recommended in Shake docs: the name of the current target is already available in the rest of the profiling information. - - - - - fb12f53c by Alp Mestanogullari at 2019-03-27T11:20:05Z Hadrian: introduce an easy way for users to build with -split-sections Any user can now trivially build any number of Haskell packages with `-split-sections` by using `splitSections`/`splitSectionsIf` on any existing or new flavour: -- build all packages but the ghc library with -split-sections splitSections :: Flavour -> Flavour -- build all packages that satisfy the given predicate -- with --split-sections splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour See the new section in `doc/user-settings.md`. - - - - - 3dec527a by David Eichmann at 2019-03-27T11:20:09Z Hadrian: don't use -zorigin on darwin. - - - - - 5730f863 by Ömer Sinan Ağacan at 2019-03-27T11:20:10Z Minor refactoring in copy array primops: - `emitCopySmallArray` now checks size before generating code and doesn't generate any code when size is 0. `emitCopyArray` already does this so this makes small/large array cases the same in argument checking. - In both `emitCopySmallArray` and `emitCopyArray` read the `dflags` after checking the argument. - - - - - 4acdb769 by Chaitanya Koparkar at 2019-03-27T11:20:11Z Fix a few broken Trac links [skip ci] This patch only attempts to fix links that don't automatically re-direct to the correct URL. - - - - - 97ad5cfb by Artem Pelenitsyn at 2019-03-29T18:18:12Z Add some tips to the Troubleshooting section of README - - - - - 8a20bfc2 by Michael Peyton Jones at 2019-03-29T18:18:14Z Visibility: handle multiple units with the same name Fixes #16228. The included test case is adapted from the reproduction in the issue, and fails without this patch. ------ We compute an initial visilibity mapping for units based on what is present in the package databases. To seed this, we compute a set of all the package configs to add visibilities for. However, this set was keyed off the unit's *package name*. This is correct, since we compare packages across databases by version. However, we would only ever consider a single, most-preferable unit from the database in which it was found. The effect of this was that only one of the libraries in a Cabal package would be added to this initial set. This would cause attempts to use modules from the omitted libraries to fail, claiming that the package was hidden (even though `ghc-pkg` would correctly show it as visible). A solution is to do the selection of the most preferable packages separately, and then be sure to consider exposing all units in the same package in the same package db. We can do this by picking a most-preferable unit for each package name, and then considering exposing all units that are equi-preferable with that unit. ------ Why wasn't this bug apparent to all people trying to use sub-libraries in Cabal? The answer is that Cabal explicitly passes `-package` and `-package-id` flags for all the packages it wants to use, rather than relying on the state of the package database. So this bug only really affects people who are trying to use package databases produced by Cabal outside of Cabal itself. One particular example of this is the way that the Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these are equipped with a package database containing all the needed package dependencies, and the user is not expected to pass `-package` flags explicitly. - - - - - 754b5455 by Artem Pelenitsyn at 2019-03-29T18:18:20Z docs: make nfib compute the Fibonacci sequence [skipci] - - - - - 1a567133 by Ben Gamari at 2019-03-29T18:18:20Z ci: Check that changelogs don't contain "TBA" This ensures that the release dates in the library changelogs are properly set. - - - - - 6e15ca54 by Ben Gamari at 2019-03-29T18:18:22Z Bump transformers to 0.5.6.2 See #16199. - - - - - 6f7115df by Ben Gamari at 2019-03-30T11:42:38Z ci: Ensure index.html is preserved in documentation tarball - - - - - 33173a51 by Alexandre at 2019-04-01T07:32:28Z Add support for bitreverse primop This commit includes the necessary changes in code and documentation to support a primop that reverses a word's bits. It also includes a test. - - - - - a3971b4e by Alexandre at 2019-04-01T07:32:28Z Bump ghc-prim's version where needed - - - - - 061276ea by Michael Sloan at 2019-04-01T07:32:30Z Remove unnecessary uses of UnboxedTuples pragma (see #13101 / #15454) Also removes a couple unnecessary MagicHash pragmas - - - - - e468c613 by David Eichmann at 2019-04-01T07:32:34Z Support Shake's --lint-fsatrace feature. Using this feature requires fsatrace (e.g. https://github.com/jacereda/fsatrace). Simply use the `--lint-fsatrace` option when running hadrian. Shake version >= 0.17.7 is required to support linting out of tree build dirs. - - - - - 1e9e4197 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add merge request template for backports for 8.8 - - - - - 55650d14 by Ben Gamari at 2019-04-01T07:32:34Z gitlab: Add some simply issue templates - - - - - 27b99ed8 by Takenobu Tani at 2019-04-01T07:32:36Z Clean up URLs to point to GitLab This moves URL references to old Trac to their corresponding GitLab counterparts. This patch does not update the submodule library, such as libraries/Cabal. See also !539, !606, !618 [ci skip] - - - - - 18d1555d by Adam Sandberg Eriksson at 2019-04-01T07:32:38Z configure: document the use of the LD variable - - - - - 10352efa by Ben Gamari at 2019-04-01T22:22:34Z gitlab: Add feature request MR template - - - - - 1e52054b by Ben Gamari at 2019-04-01T23:16:21Z gitlab: Move feature request template to issue_templates Whoops. - - - - - e5c21ca9 by Ben Gamari at 2019-04-01T23:16:25Z gitlab: Mention ~"user facing" label - - - - - 39282422 by Ryan Scott at 2019-04-02T00:01:38Z Bump array submodule This bumps `array` to version 0.5.4.0 so that we can distinguish it with `MIN_VERSION_array` (as it introduces some changes to the `Show` instance for `UArray`). - - - - - 7cf5ba3d by Michal Terepeta at 2019-04-02T00:07:49Z Improve performance of newSmallArray# This: - Hoists part of the condition outside of the initialization loop in `stg_newSmallArrayzh`. - Annotates one of the unlikely branches as unlikely, also in `stg_newSmallArrayzh`. - Adds a couple of annotations to `allocateMightFail` indicating which branches are likely to be taken. Together this gives about 5% improvement. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - dd9c82ef by David Eichmann at 2019-04-02T00:13:55Z Hadrian: correct deps for ghc builder. Previously, when needing ghc as a builder, the ghcDeps (Files the GHC binary depends on) for the current stage were needed. This is incorrect as the previous stage's ghc is used for building. This commit fixes the issue, needing the previous stage's ghcDeps. - - - - - 345306d3 by Alexandre Baldé at 2019-04-02T16:34:30Z Fix formatting issue in ghc-prim's changelog [skip ci] - - - - - f54b5124 by David Eichmann at 2019-04-02T16:40:39Z Hadrian: traceAllow deep dependencies when compilling haskell object files. - - - - - d132b30a by David Eichmann at 2019-04-02T16:40:39Z Hadrian: lint ignore autom4te and ghc-pkg cache files. - - - - - bf734195 by Simon Marlow at 2019-04-02T16:46:46Z Add myself to libraries/ghci - - - - - 5a75ccd0 by klebinger.andreas at gmx.at at 2019-04-03T04:34:57Z Fix faulty substitutions in StgCse (#11532). `substBndr` should rename bindings which shadow existing ids. However while it was renaming the bindings it was not adding proper substitutions for renamed bindings. Instead of adding a substitution of the form `old -> new` for renamed bindings it mistakenly added `old -> old` if no replacement had taken place while adding none if `old` had been renamed. As a byproduct this should improve performance, as we no longer add useless substitutions for unshadowed bindings. - - - - - 2ec749b5 by Nathan Collins at 2019-04-03T04:41:05Z users-guide: Fix typo - - - - - ea192a09 by Andrew Martin at 2019-04-03T04:41:05Z base: Add documentation that liftA2 used to not be a typeclass method - - - - - 733f1b52 by Frank Steffahn at 2019-04-03T04:41:05Z users-guide: Typo in Users Guide, Glasgow Exts - - - - - 3364def0 by Ben Gamari at 2019-04-03T04:41:05Z integer-gmp: Write friendlier documentation for Integer - - - - - dd3a3d08 by Ben Gamari at 2019-04-03T04:41:05Z integer-simple: Add documentation for Integer type - - - - - 722fdddf by Chris Martin at 2019-04-03T04:41:05Z Correct two misspellings of "separately" - - - - - bf6dbe3d by Chris Martin at 2019-04-03T04:41:05Z Inline the definition of 'ap' in the Monad laws The law as it is currently written is meaningless, because nowhere have we defined the implementation of 'ap'. The reader of the Control.Monad documentation is provided with only a type signature, > ap :: Monad m => m (a -> b) -> m a -> m b an informal description, > In many situations, the liftM operations can be replaced by uses of > ap, which promotes function application. and a relationship between 'ap' and the 'liftM' functions > return f `ap` x1 `ap` ... `ap` xn > is equivalent to > liftMn f x1 x2 ... xn Without knowing how 'ap' is defined, a law involving 'ap' cannot provide any guidance for how to write a lawful Monad instance, nor can we conclude anything from the law. I suspect that a reader equipped with the understanding that 'ap' was defined prior to the invention of the Applicative class could deduce that 'ap' must be defined in terms of (>>=), but nowhere as far as I can tell have we written this down explicitly for readers without the benefit of historical context. If the law is meant to express a relationship among (<*>), (>>=), and 'return', it seems that it is better off making this statement directly, sidestepping 'ap' altogether. - - - - - 7b090b53 by Ben Gamari at 2019-04-03T07:57:40Z configure: Always use AC_LINK_ELSEIF when testing against assembler This fixes #16440, where the build system incorrectly concluded that the `.subsections_via_symbols` assembler directive was supported on a Linux system. This was caused by the fact that gcc was invoked with `-flto`; when so-configured gcc does not call the assembler but rather simply serialises its AST for compilation during the final link. This is described in Note [autoconf assembler checks and -flto]. - - - - - 4626cf21 by Sebastian Graf at 2019-04-03T08:03:47Z Fix Uncovered set of literal patterns Issues #16289 and #15713 are proof that the pattern match checker did an unsound job of estimating the value set abstraction corresponding to the uncovered set. The reason is that the fix from #11303 introducing `NLit` was incomplete: The `LitCon` case desugared to `Var` rather than `LitVar`, which would have done the necessary case splitting analogous to the `ConVar` case. This patch rectifies that by introducing the fresh unification variable in `LitCon` in value abstraction position rather than pattern postition, recording a constraint equating it to the constructor expression rather than the literal. Fixes #16289 and #15713. - - - - - 6f13e7b1 by Ben Gamari at 2019-04-03T12:12:26Z gitlab-ci: Build hyperlinked sources for releases Fixes #16445. - - - - - 895394c2 by Ben Gamari at 2019-04-03T12:15:06Z gitlab: Fix label names in issue templates - - - - - 75abaaea by Yuriy Syrovetskiy at 2019-04-04T08:23:19Z Replace git.haskell.org with gitlab.haskell.org (#16196) - - - - - 25c02ea1 by Ryan Scott at 2019-04-04T08:29:29Z Fix #16518 with some more kind-splitting smarts This patch corrects two simple oversights that led to #16518: 1. `HsUtils.typeToLHsType` was taking visibility into account in the `TyConApp` case, but not the `AppTy` case. I've factored out the visibility-related logic into its own `go_app` function and now invoke `go_app` from both the `TyConApp` and `AppTy` cases. 2. `Type.fun_kind_arg_flags` did not properly split kinds with nested `forall`s, such as `(forall k. k -> Type) -> (forall k. k -> Type)`. This was simply because `fun_kind_arg_flags`'s `FunTy` case always bailed out and assumed all subsequent arguments were `Required`, which clearly isn't the case for nested `forall`s. I tweaked the `FunTy` case to recur on the result kind. - - - - - 51fd3571 by Ryan Scott at 2019-04-04T08:35:39Z Use funPrec, not topPrec, to parenthesize GADT argument types A simple oversight. Fixes #16527. - - - - - 6c0dd085 by Ben Gamari at 2019-04-04T12:12:24Z testsuite: Add testcase for #16111 - - - - - cbb88865 by klebinger.andreas at gmx.at at 2019-04-04T12:12:25Z Restore Xmm registers properly in StgCRun.c This fixes #16514: Xmm6-15 was restored based off rax instead of rsp. The code was introduced in the fix for #14619. - - - - - 33b0a291 by Ryan Scott at 2019-04-04T12:12:28Z Tweak error messages for narrowly-kinded assoc default decls This program, from #13971, currently has a rather confusing error message: ```hs class C a where type T a :: k type T a = Int ``` ``` • Kind mis-match on LHS of default declaration for ‘T’ • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` It's not at all obvious why GHC is complaining about the LHS until you realize that the default, when printed with `-fprint-explicit-kinds`, is actually `type T @{k} @* a = Int`. That is to say, the kind of `a` is being instantiated to `Type`, whereas it ought to be a kind variable. The primary thrust of this patch is to weak the error message to make this connection more obvious: ``` • Illegal argument ‘*’ in: ‘type T @{k} @* a = Int’ The arguments to ‘T’ must all be type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ``` Along the way, I performed some code cleanup suggested by @rae in https://gitlab.haskell.org/ghc/ghc/issues/13971#note_191287. Before, we were creating a substitution from the default declaration's type variables to the type family tycon's type variables by way of `tcMatchTys`. But this is overkill, since we already know (from the aforementioned validity checking) that all the arguments in a default declaration must be type variables anyway. Therefore, creating the substitution is as simple as using `zipTvSubst`. I took the opportunity to perform this refactoring while I was in town. Fixes #13971. - - - - - 3a38ea44 by Eric Crockett at 2019-04-07T19:21:59Z Fix #16282. Previously, -W(all-)missed-specs was created with 'NoReason', so no information about the flag was printed along with the warning. Now, -Wall-missed-specs is listed as the Reason if it was set, otherwise -Wmissed-specs is listed as the reason. - - - - - 63b7d5fb by Michal Terepeta at 2019-04-08T18:29:34Z Generate straightline code for inline array allocation GHC has an optimization for allocating arrays when the size is statically known -- it'll generate the code allocating and initializing the array inline (instead of a call to a procedure from `rts/PrimOps.cmm`). However, the generated code uses a loop to do the initialization. Since we already check that the requested size is small (we check against `maxInlineAllocSize`), we can generate faster straightline code instead. This brings about 15% improvement for `newSmallArray#` in my testing and slightly simplifies the code in GHC. Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - 2b3f4718 by Phuong Trinh at 2019-04-08T18:35:43Z Fix #16500: look for interface files in -hidir flag in OneShot mode We are currently ignoring options set in the hiDir field of hsc_dflags when looking for interface files while compiling in OneShot mode. This is inconsistent with the behaviour of other directory redirecting fields (such as objectDir or hieDir). It is also inconsistent with the behaviour of compilation in CompManager mode (a.k.a `ghc --make`) which looks for interface files in the directory set in hidir flag. This changes Finder.hs so that we use the value of hiDir while looking for interface in OneShot mode. - - - - - 97502be8 by Yuriy Syrovetskiy at 2019-04-08T18:41:51Z Add `-optcxx` option (#16477) - - - - - 97d3d546 by Ben Gamari at 2019-04-08T18:47:54Z testsuite: Unmark T16190 as broken Was broken via #16389 yet strangely it has started passing despite the fact that the suggested root cause has not changed. - - - - - a42d206a by Yuriy Syrovetskiy at 2019-04-08T18:54:02Z Fix whitespace style - - - - - 4dda2270 by Matthew Pickering at 2019-04-08T19:00:08Z Use ./hadrian/ghci.sh in .ghcid - - - - - d236d9d0 by Sebastian Graf at 2019-04-08T19:06:15Z Make `singleConstructor` cope with pattern synonyms Previously, `singleConstructor` didn't handle singleton `COMPLETE` sets of a single pattern synonym, resulting in incomplete pattern warnings in #15753. This is fixed by making `singleConstructor` (now named `singleMatchConstructor`) query `allCompleteMatches`, necessarily making it effectful. As a result, most of this patch is concerned with threading the side-effect through to `singleMatchConstructor`. Unfortunately, this is not enough to completely fix the original reproduction from #15753 and #15884, which are related to function applications in pattern guards being translated too conservatively. - - - - - 1085090e by Ömer Sinan Ağacan at 2019-04-08T19:12:22Z Skip test ArithInt16 and ArithWord16 in GHCi way These tests use unboxed tuples, which GHCi doesn't support - - - - - 7287bb9e by Ömer Sinan Ağacan at 2019-04-08T19:18:33Z testsuite: Show exit code of GHCi tests on failure - - - - - f5604d37 by John Ericson at 2019-04-08T19:24:43Z settings.in: Reformat We're might be about to switch to generating it in Hadrian/Make. This reformat makes it easier to programmingmatically generate and end up with the exact same thing, which is good for diffing to ensure no regressions. I had this as part of !712, but given the difficulty of satisfying CI, I figured I should break things up even further. - - - - - cf9e1837 by Ryan Scott at 2019-04-08T19:30:51Z Bump hpc submodule Currently, the `hpc` submodule is pinned against the `wip/final-mfp` branch, not against `master`. This pins it back against `master`. - - - - - 36d38047 by Ben Gamari at 2019-04-09T14:23:47Z users-guide: Document how to disable package environments As noted in #16309 this somehow went undocumented. - - - - - af4cea7f by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: fix memset unroll for small bytearrays, add 64-bit sets Fixes #16052 When the offset in `setByteArray#` is statically known, we can provide better alignment guarantees then just 1 byte. Also, memset can now do 64-bit wide sets. The current memset intrinsic is not optimal however and can be improved for the case when we know that we deal with (baseAddress at known alignment) + offset For instance, on 64-bit `setByteArray# s 1# 23# 0#` given that bytearray is 8 bytes aligned could be unrolled into `movb, movw, movl, movq, movq`; but currently it is `movb x23` since alignment of 1 is all we can embed into MO_Memset op. - - - - - bd2de4f0 by Artem Pyanykh at 2019-04-09T14:30:13Z codegen: use newtype for Alignment in BasicTypes - - - - - 14a78707 by Artem Pyanykh at 2019-04-09T14:30:13Z docs: add a note about changes in memset unrolling to 8.10.1-notes - - - - - fe40ddd9 by Sylvain Henry at 2019-04-09T16:50:15Z Hadrian: fix library install paths in bindist Makefile (#16498) GHC now works out-of-the-box (i.e. without any wrapper script) by assuming that @bin@ and @lib@ directories sit next to each other. In particular, its RUNPATH uses $ORIGIN-based relative path to find the libraries. However, to be good citizens we want to support the case where @bin@ and @lib@ directories (respectively BINDIR and LIBDIR) don't sit next to each other or are renamed. To do that the install script simply creates GHC specific @bin@ and @lib@ siblings directories into: LIBDIR/ghc-VERSION/{bin,lib} Then it installs wrapper scripts into BINDIR that call the appropriate programs into LIBDIR/ghc-VERSION/bin/. The issue fixed by this patch is that libraries were not installed into LIBDIR/ghc-VERSION/lib but directly into LIBDIR. - - - - - 9acdc4c0 by Ben Gamari at 2019-04-09T16:56:38Z gitlab: Bump cabal-install version used by Windows builds to 2.4 Hopefully fixes Windows Hadrian build. - - - - - fc3f421b by Joachim Breitner at 2019-04-10T03:17:37Z GHC no longer ever defines TABLES_NEXT_TO_CODE on its own It should be entirely the responsibility of make/Hadrian to ensure that everything that needs this flag gets it. GHC shouldn't be hardcoded to assist with bootstrapping since it builds other things besides itself. Reviewers: Subscribers: TerrorJack, rwbarton, carter GHC Trac Issues: #15548 -- progress towards but not fix Differential Revision: https://phabricator.haskell.org/D5082 -- extract from that - - - - - be0dde8e by Ryan Scott at 2019-04-10T03:23:50Z Use ghc-prim < 0.7, not <= 0.6.1, as upper version bounds Using `ghc-prim <= 0.6.1` is somewhat dodgy from a PVP point of view, as it makes it awkward to support new minor releases of `ghc-prim`. Let's instead use `< 0.7`, which is the idiomatic way of expressing PVP-compliant upper version bounds. - - - - - 42504f4a by Carter Schonwald at 2019-04-11T00:28:41Z removing x87 register support from native code gen * simplifies registers to have GPR, Float and Double, by removing the SSE2 and X87 Constructors * makes -msse2 assumed/default for x86 platforms, fixing a long standing nondeterminism in rounding behavior in 32bit haskell code * removes the 80bit floating point representation from the supported float sizes * theres still 1 tiny bit of x87 support needed, for handling float and double return values in FFI calls wrt the C ABI on x86_32, but this one piece does not leak into the rest of NCG. * Lots of code thats not been touched in a long time got deleted as a consequence of all of this all in all, this change paves the way towards a lot of future further improvements in how GHC handles floating point computations, along with making the native code gen more accessible to a larger pool of contributors. - - - - - c401f8a4 by Sylvain Henry at 2019-04-11T23:51:24Z Hadrian: fix binary-dir with --docs=none Hadrian's "binary-dist" target must check that the "docs" directory exists (it may not since we can disable docs generation). - - - - - 091195a4 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Remove unused remilestoning script - - - - - fa0ccbb8 by Ömer Sinan Ağacan at 2019-04-11T23:57:38Z Update a panic message Point users to the right URL - - - - - beaa07d2 by Sylvain Henry at 2019-04-12T17:17:21Z Hadrian: fix ghci wrapper script generation (#16508) - - - - - e05df3e1 by Ben Gamari at 2019-04-12T17:23:30Z gitlab-ci: Ensure that version number has three components - - - - - 885d2e04 by klebinger.andreas at gmx.at at 2019-04-12T18:40:04Z Add -ddump-stg-final to dump stg as it is used for codegen. Intermediate STG does not contain free variables which can be useful sometimes. So adding a flag to dump that info. - - - - - 3c759ced by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: add a --test-accept/-a flag, to mimic 'make accept' When -a or --test-accept is passed, and if one runs the 'test' target, then any test failing because of mismatching output and which is not expected to fail will have its expected output adjusted by the test driver, effectively considering the new output correct from now on. When this flag is passed, hadrian's 'test' target becomes sensitive to the PLATFORM and OS environment variable, just like the Make build system: - when the PLATFORM env var is set to "YES", when accepting a result, accept it for the current platform; - when the OS env var is set to "YES", when accepting a result, accept it for all wordsizes of the current operating system. This can all be combined with `--only="..."` and `TEST="..." to only accept the new output of a subset of tests. - - - - - f4b5a6c0 by Alp Mestanogullari at 2019-04-12T18:46:54Z Hadrian: document -a/--test-accept - - - - - 30a0988d by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Disable windows-hadrian job Not only is it reliably failing due to #16574 but all of the quickly failing builds also causes the Windows runners to run out of disk space. - - - - - 8870a51b by Ben Gamari at 2019-04-12T19:41:07Z gitlab: Don't run lint-submods job on Marge branches This broke Marge by creating a second pipeline (consisting of only the `lint-submods` job). Marge then looked at this pipeline and concluded that CI for her merge branch passed. However, this is ignores the fact that the majority of the CI jobs are triggered on `merge_request` and are therefore in another pipeline. - - - - - 7876d088 by Ben Gamari at 2019-04-13T13:51:59Z linters: Fix check-version-number This should have used `grep -E`, not `grep -e` - - - - - 2e7b2e55 by Ara Adkins at 2019-04-13T14:00:02Z [skip ci] Update CI badge in readme This trivial MR updates the CI badge in the readme to point to the new CI on gitlab, rather than the very out-of-date badge from Travis. - - - - - 40848a43 by Ben Gamari at 2019-04-13T14:02:36Z base: Better document implementation implications of Data.Timeout As noted in #16546 timeout uses asynchronous exceptions internally, an implementation detail which can leak out in surprising ways. Note this fact. Also expose the `Timeout` tycon. [skip ci] - - - - - 5f183081 by David Eichmann at 2019-04-14T05:08:15Z Hadrian: add rts shared library symlinks for backwards compatability Fixes test T3807 when building with Hadrian. Trac #16370 - - - - - 9b142c53 by Sylvain Henry at 2019-04-14T05:14:23Z Hadrian: add binary-dist-dir target This patch adds an Hadrian target "binary-dist-dir". Compared to "binary-dist", it only builds a binary distribution directory without creating the Tar archive. It makes the use/test of the bindist installation script easier. - - - - - 6febc444 by Krzysztof Gogolewski at 2019-04-14T05:20:29Z Fix assertion failures reported in #16533 - - - - - edcef7b3 by Artem Pyanykh at 2019-04-14T05:26:35Z codegen: unroll memcpy calls for small bytearrays - - - - - 6094d43f by Artem Pyanykh at 2019-04-14T05:26:35Z docs: mention memcpy optimization for ByteArrays in 8.10.1-notes - - - - - d2271fe4 by Simon Jakobi at 2019-04-14T12:43:17Z Ord docs: Add explanation on 'min' and 'max' operator interactions [ci skip] - - - - - e7cad16c by Krzysztof Gogolewski at 2019-04-14T12:49:23Z Add a safeguard to Core Lint Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad allows to handle an unrecoverable failure. In case of such a failure, the error should be added to the second component of the pair. If this is not done, Lint will silently accept bad programs. This situation actually happened during development of linear types. This adds a safeguard. - - - - - c54a093f by Ben Gamari at 2019-04-14T12:55:29Z CODEOWNERS: Add simonmar as owner of rts/linker I suspect this is why @simonmar wasn't notified of !706. [skip ci] - - - - - 1825f50d by Alp Mestanogullari at 2019-04-14T13:01:38Z Hadrian: don't accept p_dyn for executables, to fix --flavour=prof - - - - - b024e289 by Giles Anderson at 2019-04-15T10:20:29Z Document how -O3 is handled by GHC -O2 is the highest value of optimization. -O3 will be reverted to -O2. - - - - - 4b1ef06d by Giles Anderson at 2019-04-15T10:20:29Z Apply suggestion to docs/users_guide/using-optimisation.rst - - - - - 71cf94db by Fraser Tweedale at 2019-04-15T10:26:37Z GHCi: fix load order of .ghci files Directives in .ghci files in the current directory ("local .ghci") can be overridden by global files. Change the order in which the configs are loaded: global and $HOME/.ghci first, then local. Also introduce a new field to GHCiState to control whether local .ghci gets sourced or ignored. This commit does not add a way to set this value (a subsequent commit will add this), but the .ghci sourcing routine respects its value. Fixes: https://gitlab.haskell.org/ghc/ghc/issues/14689 Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - 5c06b60d by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: update startup script order Update users guide to match the new startup script order. Also clarify that -ignore-dot-ghci does not apply to scripts specified via the -ghci-script option. Part of: https://gitlab.haskell.org/ghc/ghc/issues/14689 - - - - - aa490b35 by Fraser Tweedale at 2019-04-15T10:26:38Z GHCi: add 'local-config' setting Add the ':set local-config { source | ignore }' setting to control whether .ghci file in current directory will be sourced or not. The directive can be set in global config or $HOME/.ghci, which are processed before local .ghci files. The default is "source", preserving current behaviour. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - ed94d345 by Fraser Tweedale at 2019-04-15T10:26:38Z users-guide: document :set local-config Document the ':set local-config' command and add a warning about sourcing untrusted local .ghci scripts. Related: https://gitlab.haskell.org/ghc/ghc/issues/6017 Related: https://gitlab.haskell.org/ghc/ghc/issues/14250 - - - - - be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z asm-emit-time IND_STATIC elimination When a new closure identifier is being established to a local or exported closure already emitted into the same module, refrain from adding an IND_STATIC closure, and instead emit an assembly-language alias. Inter-module IND_STATIC objects still remain, and need to be addressed by other measures. Binary-size savings on nofib are around 0.1%. - - - - - 57eb5bc6 by erthalion at 2019-04-16T19:40:36Z Show dynamic object files (#16062) Closes #16062. When -dynamic-too is specified, reflect that in the progress message, like: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o, Main.dyn_o ) instead of: $ ghc Main.hs -dynamic-too [1 of 1] Compiling Lib ( Main.hs, Main.o ) - - - - - 894ec447 by Andrey Mokhov at 2019-04-16T19:46:44Z Hadrian: Generate GHC wrapper scripts This is a temporary workaround for #16534. We generate wrapper scripts <build-root>/ghc-stage1 and <build-root>/ghc-stage2 that can be used to run Stage1 and Stage2 GHCs with the right arguments. See https://gitlab.haskell.org/ghc/ghc/issues/16534. - - - - - e142ec99 by Sven Tennie at 2019-04-18T03:19:00Z Typeset Big-O complexities with Tex-style notation (#16090) E.g. use `\(\mathcal{O}(n^2)\)` instead of `/O(n^2)/`. - - - - - f0f495f0 by klebinger.andreas at gmx.at at 2019-04-18T03:25:10Z Add an Outputable instance for SDoc with ppr = id. When printf debugging this can be helpful. - - - - - e28706ea by Sylvain Henry at 2019-04-18T12:12:07Z Gitlab: allow execution of CI pipeline from the web interface [skip ci] - - - - - 4c8a67a4 by Alp Mestanogullari at 2019-04-18T12:18:18Z Hadrian: fix ghcDebugged and document it - - - - - 5988f17a by Alp Mestanogullari at 2019-04-19T02:46:12Z Hadrian: fix the value we pass to the test driver for config.compiler_debugged We used to pass YES/NO, while that particular field is set to True/False. This happens to fix an unexpected pass, T9208. - - - - - 57cf1133 by Alec Theriault at 2019-04-19T02:52:25Z TH: make `Lift` and `TExp` levity-polymorphic Besides the obvious benefits of being able to manipulate `TExp`'s of unboxed types, this also simplified `-XDeriveLift` all while making it more capable. * `ghc-prim` is explicitly depended upon by `template-haskell` * The following TH things are parametrized over `RuntimeRep`: - `TExp(..)` - `unTypeQ` - `unsafeTExpCoerce` - `Lift(..)` * The following instances have been added to `Lift`: - `Int#`, `Word#`, `Float#`, `Double#`, `Char#`, `Addr#` - unboxed tuples of lifted types up to arity 7 - unboxed sums of lifted types up to arity 7 Ideally we would have levity-polymorphic _instances_ of unboxed tuples and sums. * The code generated by `-XDeriveLift` uses expression quotes instead of generating large amounts of TH code and having special hard-coded cases for some unboxed types. - - - - - fdfd9731 by Alec Theriault at 2019-04-19T02:52:25Z Add test case for #16384 Now that `TExp` accepts unlifted types, #16384 is fixed. Since the real issue there was GHC letting through an ill-kinded type which `-dcore-lint` rightly rejected, a reasonable regression test is that the program from #16384 can now be accepted without `-dcore-lint` complaining. - - - - - eb2a4df8 by Michal Terepeta at 2019-04-20T03:32:08Z StgCmmPrim: remove an unnecessary instruction in doNewArrayOp Previously we would generate a local variable pointing after the array header and use it to initialize the array elements. But we already use stores with offset, so it's easy to just add the header to those offsets during compilation and avoid generating the local variable (which would become a LEA instruction when using native codegen; LLVM already optimizes it away). Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com> - - - - - fcef26b6 by klebinger.andreas at gmx.at at 2019-04-20T03:38:16Z Don't indent single alternative case expressions for STG. Makes the width of STG dumps slightly saner. Especially for things like unboxing. Fixes #16580 - - - - - e7280c93 by Vladislav Zavialov at 2019-04-20T03:44:24Z Tagless final encoding of ExpCmdI in the parser Before this change, we used a roundabout encoding: 1. a GADT (ExpCmdG) 2. a class to pass it around (ExpCmdI) 3. helpers to match on it (ecHsApp, ecHsIf, ecHsCase, ...) It is more straightforward to turn these helpers into class methods, removing the need for a GADT. - - - - - 99dd5d6b by Alec Theriault at 2019-04-20T03:50:29Z Haddock: support strict GADT args with docs Rather than massaging the output of the parser to re-arrange docs and bangs, it is simpler to patch the two places in which the strictness info is needed (to accept that the `HsBangTy` may be inside an `HsDocTy`). Fixes #16585. - - - - - 10776562 by Andrey Mokhov at 2019-04-20T03:56:38Z Hadrian: Drop old/unused CI scripts - - - - - 37b1a6da by Ben Gamari at 2019-04-20T15:55:20Z gitlab-ci: Improve error message on failure of doc-tarball job Previously the failure was quite nondescript. - - - - - e3fe2601 by Ben Gamari at 2019-04-20T15:55:35Z gitlab-ci: Allow doc-tarball job to fail Due to allowed failure of Windows job. - - - - - bd3872df by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Only run release notes lint on release tags - - - - - 2145b738 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Add centos7 release job - - - - - 983c53c3 by Ben Gamari at 2019-04-20T15:55:38Z gitlab-ci: Do not build profiled libraries on 32-bit Windows Due to #15934. - - - - - 5cf771f3 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add pretty to package list - - - - - 6ac5da78 by Ben Gamari at 2019-04-21T13:07:13Z users-guide: Add libraries section to 8.10.1 release notes - - - - - 3e963de3 by Andrew Martin at 2019-04-21T13:13:20Z improve docs for casArray and casSmallArray - - - - - 98bffb07 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] say "machine words" instead of "Int units" in the primops docs - - - - - 3aefc14a by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct formatting of casArray# in docs for casSmallArray# - - - - - 0e96d120 by Andrew Martin at 2019-04-21T13:13:20Z [skip ci] correct the docs for casArray a little more. clarify that the returned element may be two different things - - - - - 687152f2 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: move tests related to linker under tests/rts/linker - - - - - 36e51406 by Artem Pyanykh at 2019-04-21T13:19:29Z testsuite: fix ifdef lint errors under tests/rts/linker - - - - - 1a7a329b by Matthew Pickering at 2019-04-22T18:37:30Z Correct off by one error in ghci +c Fixes #16569 - - - - - 51655fd8 by Alp Mestanogullari at 2019-04-22T18:44:11Z Hadrian: use the testsuite driver's config.haddock arg more correctly 4 haddock tests assume that .haddock files have been produced, by using the 'req_haddock' modifier. The testsuite driver assumes that this condition is satisfied if 'config.haddock' is non-empty, but before this patch Hadrian was always passing the path to where the haddock executable should be, regardless of whether it is actually there or not. Instead, we now pass an empty config.haddock when we can't find all of <build root>/docs/html/libraries/<pkg>/<pkg>.haddock>, where <pkg> ranges over array, base, ghc-prim, process and template-haskell, and pass the path to haddock when all those file exists. This has the (desired) effect of skipping the 4 tests (marked as 'missing library') when the docs haven't been built, and running the haddock tests when they have. - - - - - 1959bad3 by Vladislav Zavialov at 2019-04-22T18:50:18Z Stop misusing EWildPat in pattern match coverage checking EWildPat is a constructor of HsExpr used in the parser to represent wildcards in ambiguous positions: * in expression context, EWildPat is turned into hsHoleExpr (see rnExpr) * in pattern context, EWildPat is turned into WildPat (see checkPattern) Since EWildPat exists solely for the needs of the parser, we could remove it by improving the parser. However, EWildPat has also been used for a different purpose since 8a50610: to represent patterns that the coverage checker cannot handle. Not only this is a misuse of EWildPat, it also stymies the removal of EWildPat. - - - - - 6a491726 by Fraser Tweedale at 2019-04-23T13:27:30Z osReserveHeapMemory: handle signed rlim_t rlim_t is a signed type on FreeBSD, and the build fails with a sign-compare error. Add explicit (unsigned) cast to handle this case. - - - - - ab9b3ace by Alexandre Baldé at 2019-04-23T13:33:37Z Fix error message for './configure' regarding '--with-ghc' [skip ci] - - - - - 465f8f48 by Ben Gamari at 2019-04-24T16:19:24Z gitlab-ci: source-tarball job should have no dependencies - - - - - 0fc69416 by Vladislav Zavialov at 2019-04-25T18:28:56Z Introduce MonadP, make PV a newtype Previously we defined type PV = P, this had the downside that if we wanted to change PV, we would have to modify P as well. Now PV is free to evolve independently from P. The common operations addError, addFatalError, getBit, addAnnsAt, were abstracted into a class called MonadP. - - - - - f85efdec by Vladislav Zavialov at 2019-04-25T18:28:56Z checkPattern error hint is PV context There is a hint added to error messages reported in checkPattern. Instead of passing it manually, we put it in a ReaderT environment inside PV. - - - - - 4e228267 by Ömer Sinan Ağacan at 2019-04-25T18:35:09Z Minor RTS refactoring: - Remove redundant casting in evacuate_static_object - Remove redundant parens in STATIC_LINK - Fix a typo in GC.c - - - - - faa94d47 by Ben Gamari at 2019-04-25T21:16:21Z update-autoconf: Initial commit - - - - - 4811cd39 by Ben Gamari at 2019-04-25T21:16:21Z Update autoconf scripts Scripts taken from autoconf a8d79c3130da83c7cacd6fee31b9acc53799c406 - - - - - 0040af59 by Ben Gamari at 2019-04-25T21:16:21Z gitlab-ci: Reintroduce DWARF-enabled bindists It seems that this was inadvertently dropped in 1285d6b95fbae7858abbc4722bc2301d7fe40425. - - - - - 2c115085 by Wojciech Baranowski at 2019-04-30T01:02:38Z rename: hadle type signatures with typos When encountering type signatures for unknown names, suggest similar alternatives. This fixes issue #16504 - - - - - fb9408dd by Wojciech Baranowski at 2019-04-30T01:02:38Z Print suggestions in a single message - - - - - e8bf8834 by Wojciech Baranowski at 2019-04-30T01:02:38Z osa1's patch: consistent suggestion message - - - - - 1deb2bb0 by Wojciech Baranowski at 2019-04-30T01:02:38Z Comment on 'candidates' function - - - - - 8ee47432 by Wojciech Baranowski at 2019-04-30T01:02:38Z Suggest only local candidates from global env - - - - - e23f78ba by Wojciech Baranowski at 2019-04-30T01:02:38Z Use pp_item - - - - - 1abb76ab by Ben Gamari at 2019-04-30T01:08:45Z ghci: Ensure that system libffi include path is searched Previously hsc2hs failed when building against a system FFI. - - - - - 014ed644 by Sebastian Graf at 2019-05-01T00:23:21Z Compute demand signatures assuming idArity This does four things: 1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp 2. Compute the strictness signature in LetDown assuming at least `idArity` incoming arguments 3. Remove the special case for trivial RHSs, which is subsumed by 2 4. Don't perform the W/W split when doing so would eta expand a binding. Otherwise we would eta expand PAPs, causing unnecessary churn in the Simplifier. NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- fannkuch-redux +0.3% 0.0% gg -0.0% -0.1% maillist +0.2% +0.2% minimax 0.0% +0.8% pretty 0.0% -0.1% reptile -0.0% -1.2% -------------------------------------------------------------------------------- Min -0.0% -1.2% Max +0.3% +0.8% Geometric Mean +0.0% -0.0% - - - - - d37d91e9 by John Ericson at 2019-05-01T00:29:31Z Generate settings by make/hadrian instead of configure This allows it to eventually become stage-specific - - - - - 53d1cd96 by John Ericson at 2019-05-01T00:29:31Z Remove settings.in It is no longer needed - - - - - 2988ef5e by John Ericson at 2019-05-01T00:29:31Z Move cGHC_UNLIT_PGM to be "unlit command" in settings The bulk of the work was done in #712, making settings be make/Hadrian controlled. This commit then just moves the unlit command rules in make/Hadrian from the `Config.hs` generator to the `settings` generator in each build system. I think this is a good change because the crucial benefit is *settings* don't affect the build: ghc gets one baby step closer to being a regular cabal executable, and make/Hadrian just maintains settings as part of bootstrapping. - - - - - 37a4fd97 by Alp Mestanogullari at 2019-05-01T00:35:35Z Build Hadrian with -Werror in the 'ghc-in-ghci' CI job - - - - - 1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z ErrUtils: Emit progress messages to eventlog - - - - - ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z Emit GHC timing events to eventlog - - - - - 4186b410 by Sven Tennie at 2019-05-03T17:40:36Z Typeset Big-O complexities with Tex-style notation (#16090) Use `\min` instead of `min` to typeset it as an operator. - - - - - 9047f184 by Shayne Fletcher at 2019-05-03T18:54:50Z Make Extension derive Bounded - - - - - 0dde64f2 by Ben Gamari at 2019-05-03T18:54:50Z testsuite: Mark concprog001 as fragile Due to #16604. - - - - - 8f929388 by Alp Mestanogullari at 2019-05-03T18:54:50Z Hadrian: generate JUnit testsuite report in Linux CI job We also keep it as an artifact, like we do for non-Hadrian jobs, and list it as a junit report, so that the test results are reported in the GitLab UI for merge requests. - - - - - 52fc2719 by Vladislav Zavialov at 2019-05-03T18:54:50Z Pattern/expression ambiguity resolution This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat' from 'HsExpr' by using the ambiguity resolution system introduced earlier for the command/expression ambiguity. Problem: there are places in the grammar where we do not know whether we are parsing an expression or a pattern, for example: do { Con a b <- x } -- 'Con a b' is a pattern do { Con a b } -- 'Con a b' is an expression Until we encounter binding syntax (<-) we don't know whether to parse 'Con a b' as an expression or a pattern. The old solution was to parse as HsExpr always, and rejig later: checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs) This meant polluting 'HsExpr' with pattern-related constructors. In other words, limitations of the parser were affecting the AST, and all other code (the renamer, the typechecker) had to deal with these extra constructors. We fix this abstraction leak by parsing into an overloaded representation: class DisambECP b where ... newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) } See Note [Ambiguous syntactic categories] for details. Now the intricacies of parsing have no effect on the hsSyn AST when it comes to the expression/pattern ambiguity. - - - - - 9b59e126 by Ningning Xie at 2019-05-03T18:54:50Z Only skip decls with CUSKs with PolyKinds on (fix #16609) - - - - - 87bc954a by Ömer Sinan Ağacan at 2019-05-03T18:54:50Z Fix interface version number printing in --show-iface Before Version: Wanted [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5], got [8, 0, 9, 0, 2, 0, 1, 9, 0, 4, 2, 5] After Version: Wanted 809020190425, got 809020190425 - - - - - cc495d57 by Ryan Scott at 2019-05-03T18:54:50Z Make equality constraints in kinds invisible Issues #12102 and #15872 revealed something strange about the way GHC handles equality constraints in kinds: it treats them as _visible_ arguments! This causes a litany of strange effects, from strange error messages (https://gitlab.haskell.org/ghc/ghc/issues/12102#note_169035) to bizarre `Eq#`-related things leaking through to GHCi output, even without any special flags enabled. This patch is an attempt to contain some of this strangeness. In particular: * In `TcHsType.etaExpandAlgTyCon`, we propagate through the `AnonArgFlag`s of any `Anon` binders. Previously, we were always hard-coding them to `VisArg`, which meant that invisible binders (like those whose kinds were equality constraint) would mistakenly get flagged as visible. * In `ToIface.toIfaceAppArgsX`, we previously assumed that the argument to a `FunTy` always corresponding to a `Required` argument. We now dispatch on the `FunTy`'s `AnonArgFlag` and map `VisArg` to `Required` and `InvisArg` to `Inferred`. As a consequence, the iface pretty-printer correctly recognizes that equality coercions are inferred arguments, and as a result, only displays them in `-fprint-explicit-kinds` is enabled. * Speaking of iface pretty-printing, `Anon InvisArg` binders were previously being pretty-printed like `T (a :: b ~ c)`, as if they were required. This seemed inconsistent with other invisible arguments (that are printed like `T @{d}`), so I decided to switch this to `T @{a :: b ~ c}`. Along the way, I also cleaned up a minor inaccuracy in the users' guide section for constraints in kinds that was spotted in https://gitlab.haskell.org/ghc/ghc/issues/12102#note_136220. Fixes #12102 and #15872. - - - - - f862963b by Ömer Sinan Ağacan at 2019-05-04T00:50:03Z rts: Properly free the RTSSummaryStats structure `stat_exit` always allocates a `RTSSummaryStats` but only sometimes frees it, which casues leaks. With this patch we unconditionally free the structure, fixing the leak. Fixes #16584 - - - - - 0af93d16 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z StgCmmMonad: remove emitProc_, don't export emitProc - - - - - 0a3e4db3 by Ömer Sinan Ağacan at 2019-05-04T00:56:18Z PrimOps.cmm: remove unused stuff - - - - - 63150b9e by iustin at 2019-05-04T21:54:23Z Fix typo in 8.8.1 notes related to traceBinaryEvent - fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think) - fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString. - - - - - dc8a5868 by gallais at 2019-05-04T22:00:30Z [ typo ] 'castFloatToWord32' -> 'castFloatToWord64' Probably due to a copy/paste gone wrong. - - - - - 615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z Fix #16593 by having only one definition of -fprint-explicit-runtime-reps [skip ci] - - - - - ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z 'warnSpaceAfterBang' only in patterns (#16619) - - - - - 27941064 by John Ericson at 2019-05-06T18:59:29Z Remove cGhcEnableTablesNextToCode Get "Tables next to code" from the settings file instead. - - - - - 821fa9e8 by Takenobu Tani at 2019-05-06T19:05:36Z Remove `$(TOP)/ANNOUNCE` file Remove `$(TOP)/ANNOUNCE` because maintaining this file is expensive for each release. Currently, release announcements of ghc are made on ghc blogs and wikis. [skip ci] - - - - - e172a6d1 by Alp Mestanogullari at 2019-05-06T19:11:43Z Enable external interpreter when TH is requested but no internal interpreter is available - - - - - ba0aed2e by Alp Mestanogullari at 2019-05-06T21:32:56Z Hadrian: override $(ghc-config-mk), to prevent redundant config generation This required making the 'ghc-config-mk' variable overridable in testsuite/mk/boilerplate.mk, and then making use of this in hadrian to point to '<build root>/test/ghcconfig' instead, which is where we always put the test config. Previously, we would build ghc-config and run it against the GHC to be tested, a second time, while we're running the tests, because some include testsuite/mk/boilerplate.mk. This was causing unexpected output failures. - - - - - 96197961 by Ryan Scott at 2019-05-07T10:35:58Z Add /includes/dist to .gitignore As of commit d37d91e9a444a7822eef1558198d21511558515e, the GHC build now autogenerates a `includes/dist/build/settings` file. To avoid dirtying the current `git` status, this adds `includes/dist` to `.gitignore`. [ci skip] - - - - - 78a5c4ce by Ryan Scott at 2019-05-07T21:03:04Z Check for duplicate variables in associated default equations A follow-up to !696's, which attempted to clean up the error messages for ill formed associated type family default equations. The previous attempt, !696, forgot to account for the possibility of duplicate kind variable arguments, as in the following example: ```hs class C (a :: j) where type T (a :: j) (b :: k) type T (a :: k) (b :: k) = k ``` This patch addresses this shortcoming by adding an additional check for this. Fixes #13971 (hopefully for good this time). - - - - - f58ea556 by Kevin Buhr at 2019-05-07T21:09:13Z Add regression test for old typechecking issue #505 - - - - - 786e665b by Ryan Scott at 2019-05-08T05:55:45Z Fix #16603 by documenting some important changes in changelogs This addresses some glaring omissions from `libraries/base/changelog.md` and `docs/users_guide/8.8.1-notes.rst`, fixing #16603 in the process. - - - - - 0eeb4cfa by Ryan Scott at 2019-05-08T06:01:54Z Fix #16632 by using the correct SrcSpan in checkTyClHdr `checkTyClHdr`'s case for `HsTyVar` was grabbing the wrong `SrcSpan`, which lead to error messages pointing to the wrong location. Easily fixed. - - - - - ed5f858b by Shayne Fletcher at 2019-05-08T19:29:01Z Implement ImportQualifiedPost - - - - - d9bdff60 by Kevin Buhr at 2019-05-08T19:35:13Z stg_floatToWord32zh: zero-extend the Word32 (#16617) The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting in weird negative Word32s. Zero-extend them instead. Closes #16617. - - - - - 9a3acac9 by Ömer Sinan Ağacan at 2019-05-08T19:41:17Z Print PAP object address in stg_PAP_info entry code Continuation to ce23451c - - - - - 4c86187c by Richard Eisenberg at 2019-05-08T19:47:33Z Regression test for #16627. test: typecheck/should_fail/T16627 - - - - - 93f34bbd by John Ericson at 2019-05-08T19:53:40Z Purge TargetPlatform_NAME and cTargetPlatformString - - - - - 9d9af0ee by Kevin Buhr at 2019-05-08T19:59:46Z Add regression test for old issue #507 - - - - - 396e01b4 by Vladislav Zavialov at 2019-05-08T20:05:52Z Add a regression test for #14548 - - - - - 5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z Add Generic tuple instances up to 15-tuple Why 15? Because we have Eq instances up to 15. Metric Increase: T9630 haddock.base - - - - - c7913f71 by Roland Senn at 2019-05-10T20:32:38Z Fix bugs and documentation for #13456 - - - - - bfcd986d by David Eichmann at 2019-05-10T20:38:57Z Hadrian: programs need registered ghc-pkg libraries In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e. _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so Add the corresponding `need`s for these library files and the subsequent rules. - - - - - 10f579ad by Ben Gamari at 2019-05-10T20:45:05Z gitlab-ci: Disable cleanup job on Windows As discussed in the Note, we now have a cron job to handle this and the cleanup job itself is quite fragile. [skip ci] - - - - - 6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z Add regression test case for old issue #493 - - - - - 4e25bf46 by Giles Anderson at 2019-05-13T23:01:52Z Change GHC.hs to Packages.hs in Hadrian user-settings.md ... "all packages that are currently built as part of the GHC are defined in src/Packages.hs" - - - - - 357be128 by Kevin Buhr at 2019-05-14T20:41:19Z Add regression test for old parser issue #504 - - - - - 015a21b8 by John Ericson at 2019-05-14T20:41:19Z hadrian: Make settings stage specific - - - - - f9e4ea40 by John Ericson at 2019-05-14T20:41:19Z Dont refer to `cLeadingUnderscore` in test Can't use this config entry because it's about to go away - - - - - e529c65e by John Ericson at 2019-05-14T20:41:19Z Remove all target-specific portions of Config.hs 1. If GHC is to be multi-target, these cannot be baked in at compile time. 2. Compile-time flags have a higher maintenance than run-time flags. 3. The old way makes build system implementation (various bootstrapping details) with the thing being built. E.g. GHC doesn't need to care about which integer library *will* be used---this is purely a crutch so the build system doesn't need to pass flags later when using that library. 4. Experience with cross compilation in Nixpkgs has shown things work nicer when compiler's can *optionally* delegate the bootstrapping the package manager. The package manager knows the entire end-goal build plan, and thus can make top-down decisions on bootstrapping. GHC can just worry about GHC, not even core library like base and ghc-prim! - - - - - 5cf8032e by Oleg Grenrus at 2019-05-14T20:41:19Z Update terminal title while running test-suite Useful progress indicator even when `make test VERBOSE=1`, and when you do something else, but have terminal title visible. - - - - - c72c369b by Vladislav Zavialov at 2019-05-14T20:41:19Z Add a minimized regression test for #12928 - - - - - a5fdd185 by Vladislav Zavialov at 2019-05-14T20:41:19Z Guard CUSKs behind a language pragma GHC Proposal #36 describes a transition plan away from CUSKs and to top-level kind signatures: 1. Introduce a new extension, -XCUSKs, on by default, that detects CUSKs as they currently exist. 2. We turn off the -XCUSKs extension in a few releases and remove it sometime thereafter. This patch implements phase 1 of this plan, introducing a new language extension to control whether CUSKs are enabled. When top-level kind signatures are implemented, we can transition to phase 2. - - - - - 684dc290 by Vladislav Zavialov at 2019-05-14T20:41:19Z Restore the --coerce option in 'happy' configuration happy-1.19.10 has been released with a fix for --coerce in the presence of higher rank types. This should result in about 10% performance improvement in the parser. - - - - - a416ae26 by Alp Mestanogullari at 2019-05-14T20:41:20Z Hadrian: 'need' source files for various docs in Rules.Documentation Previously, changing one of the .rst files from the user guide would not cause the user guide to be rebuilt. This patch take a first stab at declaring the documentation source files that our documentation rules depend on, focusing on the .rst files only for now. We eventually might want to rebuild docs when we, say, change the haddock style file, but this level of tracking isn't really necessary for now. This fixes #16645. - - - - - 7105fb66 by Ben Gamari at 2019-05-16T16:47:59Z rts: Explicit state that CONSTR tag field is zero-based This was a bit unclear as we use both one-based and zero-based tags in GHC. [skip ci] - - - - - 5bb80cf2 by David Eichmann at 2019-05-20T14:41:55Z Improve test runner logging when calculating performance metric baseline #16662 We attempt to get 75 commit hashes via `git log`, but this only gave 10 hashes in a CI run (see #16662). Better logging may help solve this error if it occurs again in the future. - - - - - b46efa2b by David Eichmann at 2019-05-20T18:45:56Z Recalculate Performance Test Baseline T9630 #16680 Metric Decrease: T9630 - - - - - 54095bbd by Takenobu Tani at 2019-05-21T20:54:00Z users-guide: Fix directive errors on 8.10 The following sections are not displayed due to a directive error: * -Wunused-record-wildcards * -Wredundant-record-wildcards I changed the location of the `since` directive. [skip ci] - - - - - 8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z Include CPP preprocessor dependencies in -M output Issue #16521 - - - - - 0af519ac by David Eichmann at 2019-05-21T21:01:16Z Refactor Libffi and RTS rules This removes a hack that copies libffi files to the rts build directory. This was done in a libffi rule, but now an rts rule correctly needs and copies the relevant files from the libffi build dir to the rts build dir. Issues: #16272 #16304 - - - - - 9342b1fa by Kirill Elagin at 2019-05-21T21:04:54Z users-guide: Fix -rtsopts default - - - - - d0142f21 by Javran Cheng at 2019-05-21T21:08:29Z Fix doc for Data.Function.fix. Doc-only change. - - - - - ddd905b4 by Shayne Fletcher at 2019-05-21T21:12:07Z Update resolver for for happy 1.19.10 - - - - - e32c30ca by Alp Mestanogullari at 2019-05-21T21:15:45Z distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone Otherwise, when `./configure`ing a GHC bindist, produced by either Make or Hadrian, we would try to generate the `settings` file from the `settings.in` template that we used to have around but which has been gone since d37d91e9. That commit generates the settings file using the build systems instead, but forgot to remove this mention to the `settings` file. - - - - - 4a6c8436 by Ryan Scott at 2019-05-21T21:19:22Z Fix #16666 by parenthesizing contexts in Convert Most places where we convert contexts in `Convert` are actually in positions that are to the left of some `=>`, such as in superclasses and instance contexts. Accordingly, these contexts need to be parenthesized at `funPrec`. To accomplish this, this patch changes `cvtContext` to require a precedence argument for the purposes of calling `parenthesizeHsContext` and adjusts all `cvtContext` call sites accordingly. - - - - - c32f64e5 by Ben Gamari at 2019-05-21T21:23:01Z gitlab-ci: Allow Windows Hadrian build to fail Due to #16574. - - - - - 412a1f39 by Ben Gamari at 2019-05-21T21:23:01Z Update .gitlab-ci.yml - - - - - 0dc79856 by Julian Leviston at 2019-05-22T00:55:44Z Allow for multiple linker instances. Fixes Haskell portion of #3372. - - - - - 21272670 by Michael Sloan at 2019-05-22T20:37:57Z Have GHCi use object code for UnboxedTuples modules #15454 The idea is to automatically enable -fobject-code for modules that use UnboxedTuples, along with all the modules they depend on. When looking into how to solve this, I was pleased to find that there was already highly similar logic for enabling code generation when -fno-code is specified but TemplateHaskell is used. The state before this patch was that if you used unboxed tuples then you had to enable `-fobject-code` globally rather than on a per module basis. - - - - - ddae344e by Michael Sloan at 2019-05-22T20:41:31Z Use datatype for unboxed returns when loading ghc into ghci See #13101 and #15454 - - - - - 78c3f330 by Kevin Buhr at 2019-05-22T20:45:08Z Add regression test for old Word32 arithmetic issue (#497) - - - - - ecc9366a by Alec Theriault at 2019-05-22T20:48:45Z RTS: Fix restrictive cast Commit e75a9afd2989e0460f9b49fa07c1667299d93ee9 added an `unsigned` cast to account for OSes that have signed `rlim_t` signed. Unfortunately, the `unsigned` cast has the unintended effect of narrowing `rlim_t` to only 4 bytes. This leads to some spurious out of memory crashes (in particular: Haddock crashes with OOM whenn building docs of `ghc`-the-library). In this case, `W_` is a better type to cast to: we know it will be unsigned too and it has the same type as `*len` (so we don't suffer from accidental narrowing). - - - - - 2c15b85e by Alp Mestanogullari at 2019-05-22T20:52:22Z Hadrian: add --test-root-dirs, to only run specific directories of tests We can specify several of those, by using the flag multiple times or just once but combining the directories with ':'. Along the way, this patch also fixes the testsuite-related --only flag, so that we can use it many times instead of being force to specify a space-separated list of test in a single --only flag. - - - - - 6efe04de by Ryan Scott at 2019-05-22T20:56:01Z Use HsTyPats in associated type family defaults Associated type family default declarations behave strangely in a couple of ways: 1. If one tries to bind the type variables with an explicit `forall`, the `forall`'d part will simply be ignored. (#16110) 2. One cannot use visible kind application syntax on the left-hand sides of associated default equations, unlike every other form of type family equation. (#16356) Both of these issues have a common solution. Instead of using `LHsQTyVars` to represent the left-hand side arguments of an associated default equation, we instead use `HsTyPats`, which is what other forms of type family equations use. In particular, here are some highlights of this patch: * `FamEqn` is no longer parameterized by a `pats` type variable, as the `feqn_pats` field is now always `HsTyPats`. * The new design for `FamEqn` in chronicled in `Note [Type family instance declarations in HsSyn]`. * `TyFamDefltEqn` now becomes the same thing as `TyFamInstEqn`. This means that many of `TyFamDefltEqn`'s code paths can now reuse the code paths for `TyFamInstEqn`, resulting in substantial simplifications to various parts of the code dealing with associated type family defaults. Fixes #16110 and #16356. - - - - - 4ba73e00 by Luite Stegeman at 2019-05-22T20:59:39Z fix Template Haskell cross compilation on 64 bit compiler with 32 bit target - - - - - 535a26c9 by David Eichmann at 2019-05-23T17:26:37Z Revert "Add Generic tuple instances up to 15-tuple" #16688 This reverts commit 5eb9445444c4099fc9ee0803ba45db390900a80f. It has caused an increase in variance of performance test T9630, causing CI to fail. - - - - - 04b4b984 by Alp Mestanogullari at 2019-05-24T02:32:15Z add an --hadrian mode to ./validate When the '--hadrian' flag is passed to the validate script, we use hadrian to build GHC, package it up in a binary distribution and later on run GHC's testsuite against the said bindist, which gets installed locally in the process. Along the way, this commit fixes a typo, an omission (build iserv binaries before producing the bindist archive) and moves the Makefile that enables 'make install' on those bindists from being a list of strings in the code to an actual file (it was becoming increasingly annoying to work with). Finally, the Settings.Builders.Ghc part of this patch is necessary for being able to use the installed binary distribution, in 'validate'. - - - - - 0b449d34 by Ömer Sinan Ağacan at 2019-05-24T02:35:54Z Add a test for #16597 - - - - - 59f4cb6f by Iavor Diatchki at 2019-05-24T02:39:35Z Add a `NOINLINE` pragma on `someNatVal` (#16586) This fixes #16586, see `Note [NOINLINE someNatVal]` for details. - - - - - 6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z Some forall-related cleanup in deriving code * Tweak the parser to allow `deriving` clauses to mention explicit `forall`s or kind signatures without gratuitous parentheses. (This fixes #14332 as a consequence.) * Allow Haddock comments on `deriving` clauses with explicit `forall`s. This requires corresponding changes in Haddock. - - - - - c931f256 by David Eichmann at 2019-05-24T10:22:29Z Allow metric change after reverting "Add Generic tuple instances up to 15-tuple" #16688 Metrics increased on commit 5eb9445444c4099fc9ee0803ba45db390900a80f and decreased on revert commit 535a26c90f458801aeb1e941a3f541200d171e8f. Metric Decrease: T9630 haddock.base - - - - - d9dfbde3 by Michael Sloan at 2019-05-24T15:55:07Z Add PlainPanic for throwing exceptions without depending on pprint This commit splits out a subset of GhcException which do not depend on pretty printing (SDoc), as a new datatype called PlainGhcException. These exceptions can be caught as GhcException, because 'fromException' will convert them. The motivation for this change is that that the Panic module transitively depends on many modules, primarily due to pretty printing code. It's on the order of about 130 modules. This large set of dependencies has a few implications: 1. To avoid cycles / use of boot files, these dependencies cannot throw GhcException. 2. There are some utility modules that use UnboxedTuples and also use `panic`. This means that when loading GHC into GHCi, about 130 additional modules would need to be compiled instead of interpreted. Splitting the non-pprint exception throwing into a new module resolves this issue. See #13101 - - - - - 70c24471 by Moritz Angermann at 2019-05-25T21:51:30Z Add `keepCAFs` to RtsSymbols - - - - - 9be1749d by David Eichmann at 2019-05-25T21:55:05Z Hadrian: Add Mising Libffi Dependencies #16653 Libffi is ultimately built from a single archive file (e.g. libffi-tarballs/libffi-3.99999+git20171002+77e130c.tar.gz). The file can be seen as the shallow dependency for the whole libffi build. Hence, in all libffi rules, the archive is `need`ed and the build directory is `trackAllow`ed. - - - - - 2d0cf625 by Sandy Maguire at 2019-05-26T12:57:20Z Let the specialiser work on dicts under lambdas Following the discussion under #16473, this change allows the specializer to work on any dicts in a lambda, not just those that occur at the beginning. For example, if you use data types which contain dictionaries and higher-rank functions then once these are erased by the optimiser you end up with functions such as: ``` go_s4K9 Int# -> forall (m :: * -> *). Monad m => (forall x. Union '[State (Sum Int)] x -> m x) -> m () ``` The dictionary argument is after the Int# value argument, this patch allows `go` to be specialised. - - - - - 4b228768 by Moritz Angermann at 2019-05-27T05:19:49Z Lowercase windows imports While windows and macOS are currently on case-insensitive file systems, this poses no issue on those. When cross compiling from linux with a case sensitive file system and mingw providing only lowercase headers, this in fact produces an issue. As such we just lowercase the import headers, which should still work fine on a case insensitive file system and also enable mingw's headers to be usable porperly. - - - - - 01f8e390 by Alp Mestanogullari at 2019-05-27T14:06:26Z Hadrian: Fix problem with unlit path in settings file e529c65e introduced a problem in the logic for generating the path to the unlit command in the settings file, and this patches fixes it. This fixes many tests, the simplest of which is: > _build/stage1/bin/ghc testsuite/tests/parser/should_fail/T8430.lhs which failed because of a wrong path for unlit, and now fails for the right reason, with the error message expected for this test. This addresses #16659. - - - - - dcd843ac by mizunashi_mana at 2019-05-27T14:06:27Z Fix typo of primop format - - - - - 3f6e5b97 by Joshua Price at 2019-05-27T14:06:28Z Correct the large tuples section in user's guide Fixes #16644. - - - - - 1f51aad6 by Krzysztof Gogolewski at 2019-05-27T14:06:28Z Fix tcfail158 (#15899) As described in #15899, this test was broken, but now it's back to normal. - - - - - 723216e3 by Sebastian Graf at 2019-05-27T14:06:29Z Add a pprTraceWith function - - - - - 6d188dd5 by Simon Jakobi at 2019-05-27T14:06:31Z base: Include (<$) in all exports of Functor Previously the haddocks for Control.Monad and Data.Functor gave the impression that `fmap` was the only Functor method. Fixes #16681. - - - - - 95b79173 by Jasper Van der Jeugt at 2019-05-27T14:06:32Z Fix padding of entries in .prof files When the number of entries of a cost centre reaches 11 digits, it takes up the whole space reserved for it and the prof file ends up looking like: ... no. entries %time %alloc %time %alloc ... ... 120918 978250 0.0 0.0 0.0 0.0 ... 118891 0 0.0 0.0 73.3 80.8 ... 11890229702412351 8.9 13.5 73.3 80.8 ... 118903 153799689 0.0 0.1 0.0 0.1 ... This results in tooling not being able to parse the .prof file. I realise we have the JSON output as well now, but still it'd be good to fix this little weirdness. Original bug report and full prof file can be seen here: <https://github.com/jaspervdj/profiteur/issues/28>. - - - - - f80d3afd by John Ericson at 2019-05-27T14:06:33Z hadrian: Fix generation of settings I jumbled some lines in e529c65eacf595006dd5358491d28c202d673732, messing up the leading underscores and rts ways settings. This broke at least stage1 linking on macOS, but probably loads of other things too. Should fix #16685 and #16658. - - - - - db8e3275 by Ömer Sinan Ağacan at 2019-05-27T14:06:37Z Add missing opening braces in Cmm dumps Previously -ddump-cmm was generating code with unbalanced curly braces: stg_atomically_entry() // [R1] { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, <---- OPENING BRACE MISSING After this patch: stg_atomically_entry() { // [R1] <---- MISSING OPENING BRACE HERE { info_tbls: [(cfl, label: stg_atomically_info rep: tag:16 HeapRep 1 ptrs { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset cfl: // cfk unwind Sp = Just Sp + 0; _cfk::P64 = R1; //tick src<rts/PrimOps.cmm:(1243,1)-(1245,1)> R1 = I64[_cfk::P64 + 8 + 8 + 0 * 8]; call stg_atomicallyzh(R1) args: 8, res: 0, upd: 8; } }, - - - - - 9334467f by Richard Eisenberg at 2019-05-28T04:24:50Z Improve comments around injectivity checks - - - - - c8380a4a by Krzysztof Gogolewski at 2019-05-29T14:35:50Z Handle hs-boot files in -Wmissing-home-modules (#16551) - - - - - 7a75a094 by Alp Mestanogullari at 2019-05-29T14:36:35Z testsuite: introduce 'static_stats' tests They are a particular type of perf tests. This patch introduces a 'stats_files_dir' configuration field in the testsuite driver where all haddock timing files (and possibly others in the future) are assumed to live. We also change both the Make and Hadrian build systems to pass respectively $(TOP)/testsuite/tests/perf/haddock/ and <build root>/stage1/haddock-timing-files/ as the value of that new configuration field, and to generate the timing files in those directories in the first place while generating documentation with haddock. This new test type can be seen as one dedicated to examining stats files that are generated while building a GHC distribution. This also lets us get rid of the 'extra_files' directives in the all.T entries for haddock.base, haddock.Cabal and haddock.compiler. - - - - - 32acecc2 by P.C. Shyamshankar at 2019-05-29T14:37:16Z Minor spelling fixes to users guide. - - - - - b58b389b by Oleg Grenrus at 2019-05-29T14:37:54Z Remove stale 8.2.1-notes - - - - - 5bfd28f5 by Oleg Grenrus at 2019-05-29T14:37:54Z Fix some warnings in users_guide (incl #16640) - short underline - :ghc-flag:, not :ghc-flags: - :since: have to be separate - newline before code block - workaround anchor generation so - pragma:SPECIALISE - pragma:SPECIALIZE-INLINE - pragma:SPECIALIZE-inline are different anchors, not all the same `pragma:SPECIALIZE` - - - - - a5b14ad4 by Kevin Buhr at 2019-05-29T14:38:30Z Add test for old issue displaying unboxed tuples in error messages (#502) - - - - - f9d61ebb by Krzysztof Gogolewski at 2019-05-29T14:39:05Z In hole fits, don't show VTA for inferred variables (#16456) We fetch the ArgFlag for every argument by using splitForAllVarBndrs instead of splitForAllTys in unwrapTypeVars. - - - - - 69b16331 by Krzysztof Gogolewski at 2019-05-29T14:39:43Z Fix missing unboxed tuple RuntimeReps (#16565) Unboxed tuples and sums take extra RuntimeRep arguments, which must be manually passed in a few places. This was not done in deSugar/Check. This error was hidden because zipping functions in TyCoRep ignored lists with mismatching length. This is now fixed; the lengths are now checked by calling zipEqual. As suggested in #16565, I moved checking for isTyVar and isCoVar to zipTyEnv and zipCoEnv. - - - - - 9062b625 by Nathan Collins at 2019-05-29T14:40:21Z Don't lose parentheses in show SomeAsyncException - - - - - cc0d05a7 by Daniel Gröber at 2019-05-29T14:41:02Z Add hPutStringBuffer utility - - - - - 5b90e0a1 by Daniel Gröber at 2019-05-29T14:41:02Z Allow using tagetContents for modules needing preprocessing This allows GHC API clients, most notably tooling such as Haskell-IDE-Engine, to pass unsaved files to GHC more easily. Currently when targetContents is used but the module requires preprocessing 'preprocessFile' simply throws an error because the pipeline does not support passing a buffer. This change extends `runPipeline` to allow passing the input buffer into the pipeline. Before proceeding with the actual pipeline loop the input buffer is immediately written out to a new tempfile. I briefly considered refactoring the pipeline at large to pass around in-memory buffers instead of files, but this seems needlessly complicated since no pipeline stages other than Hsc could really support this at the moment. - - - - - fb26d467 by Daniel Gröber at 2019-05-29T14:41:02Z downsweep: Allow TargetFile not to exist when a buffer is given Currently 'getRootSummary' will fail with an exception if a 'TargetFile' is given but it does not exist even if an input buffer is passed along for this target. In this case it is not necessary for the file to exist since the buffer will be used as input for the compilation pipeline instead of the file anyways. - - - - - 4d51e0d8 by Ömer Sinan Ağacan at 2019-05-29T14:41:44Z CNF.c: Move debug functions behind ifdef - - - - - ae968d41 by Vladislav Zavialov at 2019-05-29T14:42:20Z tcMatchesFun s/rho/sigma #16692 - - - - - 2d2aa203 by Josh Meredith at 2019-05-29T14:43:03Z Provide details in `plusSimplCount` errors - - - - - ace2e335 by John Ericson at 2019-05-29T20:06:45Z Break up `Settings` into smaller structs As far as I can tell, the fields within `Settings` aren't *intrinsicly* related. They just happen to be initialized the same way (in particular prior to the rest of `DynFlags`), and that is why they are grouped together. Within `Settings`, however, there are groups of settings that clearly do share something in common, regardless of how they anything is initialized. In the spirit of GHC being a library, where the end cosumer may choose to initialize this configuration in arbitrary ways, I made some new data types for thoses groups internal to `Settings`, and used them to define `Settings` instead. Hopefully this is a baby step towards a general decoupling of the stateful and stateless parts of GHC. - - - - - bfccd832 by John Ericson at 2019-05-29T20:06:45Z Inline `Settings` into `DynFlags` After the previous commit, `Settings` is just a thin wrapper around other groups of settings. While `Settings` is used by GHC-the-executable to initalize `DynFlags`, in principle another consumer of GHC-the-library could initialize `DynFlags` a different way. It therefore doesn't make sense for `DynFlags` itself (library code) to separate the settings that typically come from `Settings` from the settings that typically don't. - - - - - a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z Hadrian: Add note about Libffi's Indicating Inputs #16653 [skip ci] - - - - - 3aa71a22 by Alp Mestanogullari at 2019-05-30T11:28:32Z Hadrian: always generate the libffi dynlibs manifest with globbing Instead of trying to deduce which dynlibs are expected to be found (and then copied to the RTS's build dir) in libffi's build directory, with some OS specific logic, we now always just use `getDirectoryFilesIO` to look for those dynlibs and record their names in the manifest. The previous logic ended up causing problems on Windows, where we don't build dynlibs at all for now but the manifest file's logic didn't take that into account because it was only partially reproducing the criterions that determine whether or not we will be building shared libraries. This patch also re-enables the Hadrian/Windows CI job, which was failing to build GHC precisely because of libffi shared libraries and the aforementionned duplicated logic. - - - - - ade53ce2 by Ben Gamari at 2019-05-30T11:29:10Z CODEOWNERS: Use correct username for Richard Eisenberg In !980 Richard noted that he could not approve the MR. This mis-spelling was the reason. [skip ci] - - - - - 4ad37a32 by Ben Gamari at 2019-05-30T11:29:47Z rts: Handle zero-sized mappings in MachO linker As noted in #16701, it is possible that we will find that an object has no segments needing to be mapped. Previously this would result in mmap being called for a zero-length mapping, which would fail. We now simply skip the mmap call in this case; the rest of the logic just works. - - - - - f81f3964 by Phuong Trinh at 2019-05-30T20:43:31Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. - - - - - 42129180 by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 8e42e98e by Trịnh Tuấn Phương at 2019-05-30T20:43:31Z Apply suggestion to rts/CheckUnload.c - - - - - 70afa539 by Daniel Gröber at 2019-05-30T20:44:08Z Export GhcMake.downsweep This is to enable #10887 as well as to make it possible to test downsweep on its own in the testsuite. - - - - - a8de5c5a by Daniel Gröber at 2019-05-30T20:44:08Z Add failing test for #10887 - - - - - 8906bd66 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor downsweep to allow returning multiple errors per module - - - - - 8e85ebf7 by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to reduce code duplication - - - - - 76c86fca by Daniel Gröber at 2019-05-30T20:44:08Z Refactor summarise{File,Module} to extract checkSummaryTimestamp This introduces a slight change of behaviour in the interrest of keeping the code simple: Previously summariseModule would not call addHomeModuleToFinder for summaries that are being re-used but now we do. We're forced to to do this in summariseFile because the file being summarised might not even be on the regular search path! So if GHC is to find it at all we have to pre-populate the cache with its location. For modules however the finder cache is really just a cache so we don't have to pre-populate it with the module's location. As straightforward as that seems I did almost manage to introduce a bug (or so I thought) because the call to addHomeModuleToFinder I copied from summariseFile used to use `ms_location old_summary` instead of the `location` argument to checkSummaryTimestamp. If this call were to overwrite the existing entry in the cache that would have resulted in us using the old location of any module even if it was, say, moved to a different directory between calls to 'depanal'. However it turns out the cache just ignores the location if the module is already in the cache. Since summariseModule has to search for the module, which has the side effect of populating the cache, everything would have been fine either way. Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs. - - - - - 18d3f01d by Daniel Gröber at 2019-05-30T20:44:08Z Make downsweep return all errors per-module instead of throwing some This enables API clients to handle such errors instead of immideately crashing in the face of some kinds of user errors, which is arguably quite bad UX. Fixes #10887 - - - - - 99e72769 by Daniel Gröber at 2019-05-30T20:44:08Z Catch preprocessor errors in downsweep This changes the way preprocessor failures are presented to the user. Previously the user would simply get an unlocated message on stderr such as: `gcc' failed in phase `C pre-processor'. (Exit code: 1) Now at the problematic source file is mentioned: A.hs:1:1: error: `gcc' failed in phase `C pre-processor'. (Exit code: 1) This also makes live easier for GHC API clients as the preprocessor error is now thrown as a SourceError exception. - - - - - b7ca94fd by Daniel Gröber at 2019-05-30T20:44:08Z PartialDownsweep: Add test for import errors - - - - - 98e39818 by Daniel Gröber at 2019-05-30T20:44:08Z Add depanalPartial to make getting a partial modgraph easier As per @mpickering's suggestion on IRC this is to make the partial module-graph more easily accessible for API clients which don't intend to re-implementing depanal. - - - - - d2784771 by Daniel Gröber at 2019-05-30T20:44:08Z Improve targetContents code docs - - - - - 424e85b2 by Ben Gamari at 2019-05-30T20:44:43Z testsuite: Compile T9630 with +RTS -G1 For the reasons described in Note [residency] we run programs with -G1 when we care about the max_bytes_used metric. - - - - - 4879d7af by Matthew Pickering at 2019-05-31T05:56:16Z Eventlog: Document the fact timestamps are nanoseconds [skip ci] - - - - - 0b01a354 by Takenobu Tani at 2019-05-31T05:56:54Z Update `$(TOP)/*.md` documents I updated the top documents to the latest status: - HACKING.md: - Modify Phabricator to GitLab infomation - Remove old Trac information - Add link to GitLab activity - MAKEHELP.md: - Add link to hadrian wiki - Fix markdown format - INSTALL.md: - Modify boot command to remove python3 - Fix markdown format - README.md: - Modify tarball file suffix - Fix markdown format I checked the page display on the GitHub and GitLab web. [skip ci] - - - - - 973077ac by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix 64-bit comparison (#16465) On powerpc32 64-bit comparison code generated dangling target labels. This caused ghc build failure as: $ ./configure --target=powerpc-unknown-linux-gnu && make ... SCCs aren't in reverse dependent order bad blockId n3U This happened because condIntCode' in PPC codegen generated label name but did not place the label into `cmp_lo` code block. The change adds the `cmp_lo` label into the case of negative comparison. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - bb2ee86a by Sergei Trofimovich at 2019-05-31T05:57:31Z powerpc32: fix stack allocation code generation When ghc was built for powerpc32 built failed as: It's a fallout of commit 3f46cffcc2850e68405a1 ("PPC NCG: Refactor stack allocation code") where word size used to be II32/II64 and changed to II8/panic "no width for given number of bytes" widthFromBytes ((platformWordSize platform) `quot` 8) The change restores initial behaviour by removing extra division. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 08b4c813 by Matthew Pickering at 2019-05-31T05:58:08Z Use types already in AST when making .hie file These were meant to be added in !214 but for some reason wasn't included in the patch. Update Haddock submodule for new Types.hs hyperlinker output - - - - - 284cca51 by David Hewson at 2019-05-31T05:58:47Z support small arrays and CONSTR_NOCAF in ghc-heap - - - - - f071576c by Neil Mitchell at 2019-05-31T05:59:24Z Expose doCpp - - - - - c70d039e by Ömer Sinan Ağacan at 2019-05-31T06:00:02Z Remove unused RTS function 'unmark' - - - - - bb929009 by Ömer Sinan Ağacan at 2019-05-31T06:00:40Z Fix arity type of coerced types in CoreArity Previously if we had f |> co where `f` had arity type `ABot N` and `co` had arity M and M < N, `arityType` would return `ABot M` which is wrong, because `f` is only known to diverge when applied to `N` args, as described in Note [ArityType]: If at = ABot n, then (f x1..xn) definitely diverges. Partial applications to fewer than n args may *or may not* diverge. This caused incorrect eta expansion in the simplifier, causing #16066. We now return `ATop M` for the same expression so the simplifier can't assume partial applications of `f |> co` is divergent. A regression test T16066 is also added. - - - - - e32786df by Ryan Scott at 2019-05-31T06:01:18Z Put COMPLETE sigs into ModDetails with -fno-code (#16682) `mkBootModDetailsTc`, which creates a special `ModDetails` when `-fno-code` is enabled, was not properly filling in the `COMPLETE` signatures from the `TcGblEnv`, resulting in incorrect pattern-match coverage warnings. Easily fixed. Fixes #16682. - - - - - 0c6f7f7e by Simon Jakobi at 2019-05-31T06:01:55Z Implement (Functor.<$) for Array - - - - - 495a65cb by Simon Jakobi at 2019-05-31T06:02:33Z Implement (Functor.<$) for Data.Functor.{Compose,Product,Sum} This allows us to make use of the (<$) implementations of the underlying functors. - - - - - 0e0d87da by Zubin Duggal at 2019-05-31T06:34:57Z Fix and enforce validation of header for .hie files Implements #16686 The files version is automatically generated from the current GHC version in the same manner as normal interface files. This means that clients can first read the version and then decide how to read the rest of the file. - - - - - 1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z Improve ThreadId Show instance By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`. - - - - - 45f88494 by Ryan Scott at 2019-06-01T03:56:27Z Reject nested foralls in foreign imports (#16702) This replaces a panic observed in #16702 with a simple error message stating that nested `forall`s simply aren't allowed in the type signature of a `foreign import` (at least, not at present). Fixes #16702. - - - - - 76e58890 by Ryan Scott at 2019-06-01T03:57:05Z Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. - - - - - 1503da32 by Ömer Sinan Ağacan at 2019-06-01T15:18:57Z Fix rewriting invalid shifts to errors Fixes #16449. 5341edf3 removed a code in rewrite rules for bit shifts, which broke the "silly shift guard", causing generating invalid bit shifts or heap overflow in compile time while trying to evaluate those invalid bit shifts. The "guard" is explained in Note [Guarding against silly shifts] in PrelRules.hs. More specifically, this was the breaking change: --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -474,12 +474,11 @@ shiftRule shift_op ; case e1 of _ | shift_len == 0 -> return e1 - | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length" ++ show shift_len)) This patch reverts this change. Two new tests added: - T16449_1: The original reproducer in #16449. This was previously casing a heap overflow in compile time when CmmOpt tries to evaluate the large (invalid) bit shift in compile time, using `Integer` as the result type. Now it builds as expected. We now generate an error for the shift as expected. - T16449_2: Tests code generator for large (invalid) bit shifts. - - - - - 2e297b36 by Ömer Sinan Ağacan at 2019-06-01T15:19:35Z rts: Remove unused decls from CNF.h - - - - - 33e37d06 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. - - - - - 43a39c3c by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. - - - - - c4f94320 by Takenobu Tani at 2019-06-03T02:54:43Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. - - - - - 799b1d26 by Ben Gamari at 2019-06-03T02:55:18Z gitlab-ci: Use GHC 8.6.5 for Windows CI builds - - - - - 286827be by David Eichmann at 2019-06-04T05:09:05Z TestRunner: Added --chart to display a chart of performance tests This uses the Chart.js javascript library. Everything is put into a standalone .html file and opened with the default browser. I also simplified the text output to use the same data as the chart. You can now use a commit range with git's ".." syntax. The --ci option will use results from CI (you'll need to fetch them first): $ git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/ci/perf $ python3 testsuite/driver/perf_notes.py --ci --chart --test-env x86_64-darwin --test-name T9630 master~500..master - - - - - db78ac6f by Andrew Martin at 2019-06-04T05:09:43Z Use a better strategy for determining the offset applied to foreign function arguments that have an unlifted boxed type. We used to use the type of the argument. We now use the type of the foreign function. Add a test to confirm that the roundtrip conversion between an unlifted boxed type and Any is sound in the presence of a foreign function call. - - - - - 114b014f by Alp Mestanogullari at 2019-06-04T05:10:20Z Hadrian: fix OSX build failure and add an OSX/Hadrian CI job The OSX build failure introduced in 3aa71a22 was due to a change in the glob we use to collect libffi shared libraries in hadrian/src/Rules/Libffi.hs. This commit fixes the problem and adds an OSX CI job that builds GHC with Hadrian, to make sure we don't break it again. - - - - - 002594b7 by Xavier Denis at 2019-06-04T18:41:29Z Add GHCi :instances command This commit adds the `:instances` command to ghci following proosal number 41. This makes it possible to query which instances are available to a given type. The output of this command is all the possible instances with type variables and constraints instantiated. - - - - - 3ecc03df by Ben Gamari at 2019-06-04T18:42:04Z gitlab-ci: Run bindisttest during CI - - - - - c16f3297 by Ben Gamari at 2019-06-04T18:42:04Z make: Fix bindist installation This fixes a few vestigial references to `settings` left over from !655. Fixes #16715. - - - - - ba4e3934 by Alp Mestanogullari at 2019-06-04T18:43:17Z Hadrian: profiling and debug enabled ways support -eventlog too - - - - - 567894b4 by Matthew Pickering at 2019-06-07T08:36:32Z gitlab-ci: Disable darwin hadrian job See #16771 We don't have enough capacity for the two jobs currently. [skip ci] - - - - - d3915b30 by Andrew Martin at 2019-06-07T14:20:42Z [skip ci] Improve the documentation of the CNF primops. In this context, the term "size" is ambiguous and is now avoided. Additionally, the distinction between a CNF and the blocks that comprise it has been emphasize. The vocabulary has been made more consistent with the vocabulary in the C source for CNF. - - - - - e963beb5 by Sebastian Graf at 2019-06-07T14:21:21Z TmOracle: Replace negative term equalities by refutable PmAltCons The `PmExprEq` business was a huge hack and was at the same time vastly too powerful and not powerful enough to encode negative term equalities, i.e. facts of the form "forall y. x ≁ Just y". This patch introduces the concept of 'refutable shapes': What matters for the pattern match checker is being able to encode knowledge of the kind "x can no longer be the literal 5". We encode this knowledge in a `PmRefutEnv`, mapping a set of newly introduced `PmAltCon`s (which are just `PmLit`s at the moment) to each variable denoting above inequalities. So, say we have `x ≁ 42 ∈ refuts` in the term oracle context and try to solve an equality like `x ~ 42`. The entry in the refutable environment will immediately lead to a contradiction. This machinery renders the whole `PmExprEq` and `ComplexEq` business unnecessary, getting rid of a lot of (mostly dead) code. See the Note [Refutable shapes] in TmOracle for a place to start. Metric Decrease: T11195 - - - - - 0b7372f6 by Matthew Pickering at 2019-06-07T14:21:57Z Add HEAP_PROF_SAMPLE_END event to mark end of samples This allows a user to observe how long a sampling period lasts so that the time taken can be removed from the profiling output. Fixes #16697 - - - - - d1dc0ed7 by Roland Senn at 2019-06-07T14:22:47Z Fix #16700: Tiny errors in output of GHCi commands :forward and :info `:info Coercible` now outputs the correct section number of the GHCi User's guide together with the secion title. `:forward x` gives the correct syntax hint. - - - - - 387050d0 by John Ericson at 2019-06-07T14:23:23Z Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. - - - - - da26ffe7 by Simon Peyton Jones at 2019-06-07T14:24:00Z Preserve ShadowInfo when rewriting evidence When the canonicaliser rewrites evidence of a Wanted, it should preserve the ShadowInfo (ctev_nosh) field. That is, a WDerive should rewrite to WDerive, and WOnly to WOnly. Previously we were unconditionally making a WDeriv, thereby rewriting WOnly to WDeriv. This bit Nick Frisby (issue #16735) in the context of his plugin, but we don't have a compact test case. The fix is simple, but does involve a bit more plumbing, to pass the old ShadowInfo around, to use when building the new Wanted. - - - - - 9bb58799 by Ben Gamari at 2019-06-07T14:24:38Z Hadrian: Delete target symlink in createFileLinkUntracked Previously createFileLinkUntracked would fail if the symlink already existed. - - - - - be63d299 by Simon Jakobi at 2019-06-07T14:25:16Z Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs Previously the `integer-gmp` variant of `isValidNatural` would fail to detect values `<= maxBound::Word` that were incorrectly encoded using the `NatJ#` constructor. - - - - - e87b9f87 by Moritz Angermann at 2019-06-07T14:26:04Z llvm-targets: Add x86_64 android layout - - - - - 60db142b by code5hot at 2019-06-07T14:26:46Z Update Traversable.hs with a note about an intuitive law - - - - - f11aca52 by code5hot at 2019-06-07T14:26:46Z Used terminology from a paper. Added it as a reference. - - - - - 13b3d45d by code5hot at 2019-06-07T14:26:46Z remove backticks from markup - it doesn't mean what I think it means - - - - - cfd3e0f1 by Zejun Wu at 2019-06-07T14:27:34Z Pass preprocessor options to C compiler when building foreign C files (#16737) - - - - - 5991d877 by Ben Gamari at 2019-06-07T14:28:09Z base: Export Finalizers As requested in #16750. - - - - - 3d97bad6 by Alp Mestanogullari at 2019-06-07T14:28:47Z Hadrian: use deb9 Docker images instead of deb8 for CI jobs This should fix #16739, where we seem to be getting extra carets in a test's output because of the gcc that ships with the deb8 image, whule we're not observing those extra carets in the deb9-based (Make) jobs. - - - - - 1afb4995 by Ben Gamari at 2019-06-07T14:29:23Z gitlab-ci: Create index.html in documentation deployment Otherwise navigating to https://ghc.gitlab.haskell.org/ghc will result in a 404. - - - - - 07dc79c3 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Linters, don't allow to fail Ben disabled them in cd85f8a71bb56cff332560e1d571b3406789fb71 but didn't say how or why they were broken. - - - - - fd840b64 by Matthew Pickering at 2019-06-08T17:34:18Z gitlab-ci: Don't run two submodule checking jobs on Marge jobs - - - - - 310d0c4c by Matthew Pickering at 2019-06-08T17:34:18Z Fix two lint failures in rts/linker/MachO.c - - - - - fe965316 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Use --unshallow when fetching for linters GitLab creates a shallow clone. However, this means that we may not have the base commit of an MR when linting, causing `git merge-base` to fail. Fix this by passing `--unshallow` to `git fetch`, ensuring that we have the entire history. - - - - - f58234ea by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: Fix submodule linter The job script didn't even try to compute the base commit to lint with respect to. - - - - - c392f987 by Ben Gamari at 2019-06-08T17:34:18Z gitlab-ci: A few clarifying comments - - - - - 709290b0 by Matthew Pickering at 2019-06-08T17:38:15Z Remove trailing whitespace [skip ci] This should really be caught by the linters! (#16711) - - - - - b2f106f5 by Ben Gamari at 2019-06-08T18:02:02Z gitlab-ci: Disable shallow clones Previously we were passing `--unshallow` to `git fetch` in the linting rules to ensure that the base commit which we were linting with respect to was available. However, this breaks due to GitLab's re-use of working directories since `git fetch --unshallow` fails on a repository which is not currently shallow. Given that `git fetch --unshallow` circumvents the efficiencies provided by shallow clones anyways, let's just disable them entirely. There is no documented way to do disable shallow clones but on checking the GitLab implementation it seems that setting `GIT_DEPTH=0` should do the trick. - - - - - 4a72259d by Ben Gamari at 2019-06-08T18:40:55Z gitlab-ci: Fix submodule linting of commits There is no notion of a base commit when we aren't checking a merge request. Just check the HEAD commit. - - - - - 87540029 by Ben Gamari at 2019-06-08T20:44:55Z gitlab-ci: Ensure that all commits on a branch are submodule-linted The previous commit reworked things such that the submodule linter would only run on the head commit. However, the linter only checks the submodules which are touched by the commits it is asked to lint. Consequently it would be possible for a bad submodule to sneak through. Thankfully, we can use the handy CI_COMMIT_BEFORE_SHA attribute to find the base commit of the push. - - - - - 0462b0e0 by Alexandre Baldé at 2019-06-09T15:48:34Z Explain that 'mappend' and '(<>)' should be the same [skip ci] - - - - - 970e4802 by Matthew Pickering at 2019-06-09T15:49:09Z hadrian: Properly partition options in sourceArgs Previously if you build the `ghc` package then it would has the default opts and the library opts. This is different behaviour to make where the library opts are only reserved for things in the `libraries` subdirectory (I believe) Fixes #16716 - - - - - a018c3a8 by Ben Gamari at 2019-06-09T15:49:44Z testsuite: Suppress ticks in T4918 output As noted in #16741, this test otherwise breaks when `base` is compiled with `-g`. - - - - - f7370333 by chessai at 2019-06-09T22:41:02Z Introduce log1p and expm1 primops Previously log and exp were primitives yet log1p and expm1 were FFI calls. Fix this non-uniformity. - - - - - 41bf4045 by Ben Gamari at 2019-06-09T22:41:38Z testsuite: Add test for #16514 - - - - - b9fe91fc by Simon Jakobi at 2019-06-09T22:42:21Z Small refactorings in ExtractDocs - - - - - 9d238791 by Kevin Buhr at 2019-06-09T22:42:57Z Handle trailing path separator in package DB names (#16360) Package DB directories with trailing separator (provided via GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of ${pkgroot} substitution variable. Keep the trailing separator while resolving as directory or file, but remove it before dropping the last path component with takeDirectory. Closes #16360. - - - - - a22e51ea by Richard Eisenberg at 2019-06-09T22:43:38Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 - - - - - 10452959 by Roland Senn at 2019-06-09T22:44:18Z Add disable/enable commands to ghci debugger #2215 This patch adds two new commands `:enable` and `:disable` to the GHCi debugger. Opposite to `:set stop <n> :continue` a breakpoint disabled with `:disable` will not loose its previously set stop command. A new field breakEnabled is added to the BreakLocation data structure to track the enable/disable state. When a breakpoint is disabled with a `:disable` command, the following happens: The corresponding BreakLocation data element is searched dictionary of the `breaks` field of the GHCiStateMonad. If the break point is found and not already in the disabled state, the breakpoint is removed from bytecode. The BreakLocation data structure is kept in the breaks list and the new breakEnabled field is set to false. The `:enable` command works similar. The breaks field in the GHCiStateMonad was changed from an association list to int `IntMap`. - - - - - 13572480 by Ben Gamari at 2019-06-09T22:44:54Z rts: Separate population of eventTypes from initial event generation Previously these two orthogonal concerns were both implemented in postHeaderEvents which made it difficult to send header events after RTS initialization. - - - - - ed20412a by nineonine at 2019-06-09T22:45:31Z Do not report error if Name in pragma is unbound - - - - - 8a48a8a4 by Ben Gamari at 2019-06-09T22:46:08Z testsuite: Add test for #16509 - - - - - 69c58f8a by David Eichmann at 2019-06-09T22:46:46Z Hadrian: need CPP preprocessor dependencies #16660 Use the new -include-cpp-deps ghc option (#16521) when generating .dependencies files in hadrian. This is version gated as -include-cpp-deps is a relatively new option. - - - - - 1c7bb03d by Richard Eisenberg at 2019-06-09T22:47:24Z Comments only: document tcdDataCusk better. - - - - - 5023adce by John Ericson at 2019-06-09T22:47:59Z Remove CPP ensuring word size is 32 or 64 bits around Addr# <-> int# primops It shouldn't be needed these days, and those primops are "highly deprecated" anyways. This fits with my plans because it removes one bit of target-dependence of the builtin primops, and this is the hardest part of GHC to make multi-target. CC @carter - - - - - 8e60e3f0 by Daniel Gröber at 2019-06-09T22:48:38Z rts: Fix RetainerProfile early return with TREC_CHUNK When pop() returns with `*c == NULL` retainerProfile will immediately return. All other code paths is pop() continue with the next stackElement when this happens so it seems weird to me that TREC_CHUNK we would suddenly abort everything even though the stack might still have elements left to process. - - - - - 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 8cee0f98 by Ben Gamari at 2019-06-11T17:21:49Z Hello - - - - - 466677c2 by Ben Gamari at 2019-06-11T17:21:49Z Fixes - - - - - 30 changed files: - .circleci/prepare-system.sh - .ghcid - .gitignore - .gitlab-ci.yml - + .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/feature_request.md - + .gitlab/linters/check-version-number.sh - + .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/merge_request_templates/merge-request.md - .gitlab/win32-init.sh - − ANNOUNCE - CODEOWNERS - HACKING.md - INSTALL.md - MAKEHELP.md - README.md - aclocal.m4 - boot - compiler/backpack/DriverBkp.hs - compiler/basicTypes/BasicTypes.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/MkId.hs - compiler/basicTypes/NameEnv.hs - compiler/basicTypes/UniqSupply.hs - compiler/basicTypes/Var.hs - compiler/basicTypes/VarSet.hs - compiler/cmm/CLabel.hs - compiler/cmm/CmmCallConv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79761c0e856487137fcfdd21727c2ed71cf2b592...466677c2e0faacdfec621ec57b1d6f90a3cce6c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/79761c0e856487137fcfdd21727c2ed71cf2b592...466677c2e0faacdfec621ec57b1d6f90a3cce6c7 You're receiving 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 Jun 11 18:05:09 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 14:05:09 -0400 Subject: [Git][ghc/ghc][wip/memory-barriers] Drop unnecessary (and seemingly incorrect) changes in Compact.cmm Message-ID: <5cffed5562c17_6f7a3b0efc22698c9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/memory-barriers at Glasgow Haskell Compiler / GHC Commits: ee6ba25b by Ben Gamari at 2019-06-11T18:04:51Z Drop unnecessary (and seemingly incorrect) changes in Compact.cmm - - - - - 1 changed file: - rts/Compact.cmm Changes: ===================================== rts/Compact.cmm ===================================== @@ -53,6 +53,9 @@ import CLOSURE base_GHCziIOziException_cannotCompactPinned_closure; // data structure. It takes the location to store the address of the // compacted object as an argument, so that it can be tail-recursive. // +// N.B. No memory barrier (see Note [Heap memory barriers] in SMP.h) is needed +// here since this is essentially an allocation of a new object which won't +// be visible to other cores until after we return. stg_compactAddWorkerzh ( P_ compact, // The Compact# object P_ p, // The object to compact @@ -169,6 +172,7 @@ eval: cards = SIZEOF_StgMutArrPtrs + WDS(ptrs); ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag); P_[pp] = tag | to; + SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); StgMutArrPtrs_ptrs(to) = ptrs; StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p); prim %memcpy(to + cards, p + cards , size - cards, 1); @@ -182,7 +186,6 @@ eval: i = i + 1; goto loop0; } - SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); return(); } @@ -199,6 +202,7 @@ eval: ptrs = StgSmallMutArrPtrs_ptrs(p); ALLOCATE(compact, BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + ptrs, p, to, tag); P_[pp] = tag | to; + SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); StgSmallMutArrPtrs_ptrs(to) = ptrs; i = 0; loop1: @@ -210,7 +214,6 @@ eval: i = i + 1; goto loop1; } - SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); return(); } @@ -236,6 +239,7 @@ eval: ALLOCATE(compact, size, p, to, tag); P_[pp] = tag | to; + SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); // First, copy the non-pointers if (nptrs > 0) { @@ -245,7 +249,6 @@ eval: i = i + 1; if (i < ptrs + nptrs) ( likely: True ) goto loop2; } - SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p)); // Next, recursively compact and copy the pointers if (ptrs == 0) { return(); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ee6ba25b1b407a9516b55b94ea90dad176eb49ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ee6ba25b1b407a9516b55b94ea90dad176eb49ca You're receiving 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 Jun 11 19:28:01 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 15:28:01 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Coercion zapping Message-ID: <5d0000c1d0b99_6f73fe60ccec818227651a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: ea7f96de by Ben Gamari at 2019-06-11T19:27:48Z Coercion zapping - - - - - 20 changed files: - compiler/basicTypes/VarSet.hs - compiler/coreSyn/CoreFVs.hs - compiler/coreSyn/CoreLint.hs - compiler/coreSyn/CoreOpt.hs - compiler/iface/IfaceEnv.hs - compiler/iface/IfaceSyn.hs - compiler/iface/IfaceType.hs - compiler/iface/TcIface.hs - compiler/iface/ToIface.hs - compiler/main/DynFlags.hs - compiler/typecheck/TcFlatten.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcTyDecls.hs - compiler/typecheck/TcType.hs - compiler/types/Coercion.hs - compiler/types/Coercion.hs-boot - compiler/types/FamInstEnv.hs - compiler/types/OptCoercion.hs - compiler/types/TyCoRep.hs - compiler/types/Type.hs Changes: ===================================== compiler/basicTypes/VarSet.hs ===================================== @@ -25,7 +25,7 @@ module VarSet ( pluralVarSet, pprVarSet, -- * Deterministic Var set types - DVarSet, DIdSet, DTyVarSet, DTyCoVarSet, + DVarSet, DIdSet, DTyVarSet, DCoVarSet, DTyCoVarSet, -- ** Manipulating these sets emptyDVarSet, unitDVarSet, mkDVarSet, @@ -225,6 +225,9 @@ type DIdSet = UniqDSet Id -- | Deterministic Type Variable Set type DTyVarSet = UniqDSet TyVar +-- | Deterministic Coercion Variable Set +type DCoVarSet = UniqDSet CoVar + -- | Deterministic Type or Coercion Variable Set type DTyCoVarSet = UniqDSet TyCoVar ===================================== compiler/coreSyn/CoreFVs.hs ===================================== @@ -396,6 +396,9 @@ orphNamesOfProv UnsafeCoerceProv = emptyNameSet orphNamesOfProv (PhantomProv co) = orphNamesOfCo co orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co orphNamesOfProv (PluginProv _) = emptyNameSet +orphNamesOfProv (ZappedProv _) = emptyNameSet + -- [ZappedCoDifference] Zapped coercions refer to no orphan names, even if the + -- original contained such names. orphNamesOfCos :: [Coercion] -> NameSet orphNamesOfCos = orphNamesOfThings orphNamesOfCo ===================================== compiler/coreSyn/CoreLint.hs ===================================== @@ -1788,6 +1788,7 @@ lintCoercion co@(UnivCo prov r ty1 ty2) ; check_kinds kco k1 k2 } PluginProv _ -> return () -- no extra checks + ZappedProv fvs -> mapM_ lintTyCoVarInScope (dVarSetElems fvs) ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) @@ -2014,7 +2015,6 @@ lintCoercion (HoleCo h) = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h ; lintCoercion (CoVarCo (coHoleCoVar h)) } - ---------- lintUnliftedCoVar :: CoVar -> LintM () lintUnliftedCoVar cv ===================================== compiler/coreSyn/CoreOpt.hs ===================================== @@ -1200,13 +1200,15 @@ pushCoTyArg co ty -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 - co1 = mkSymCo (mkNthCo Nominal 0 co) + zap = zapCoercion unsafeGlobalDynFlags + + co1 = zap $ mkSymCo (mkNthCo Nominal 0 co) -- co1 :: k2 ~N k1 -- Note that NthCo can extract a Nominal equality between the -- kinds of the types related by a coercion between forall-types. -- See the NthCo case in CoreLint. - co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) + co2 = zap $ mkInstCo co (mkGReflLeftCo Nominal ty co1) -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] -- Arg of mkInstCo is always nominal, hence mkNomReflCo ===================================== compiler/iface/IfaceEnv.hs ===================================== @@ -226,7 +226,7 @@ tcIfaceLclId occ = do { lcl <- getLclEnv ; case (lookupFsEnv (if_id_env lcl) occ) of Just ty_var -> return ty_var - Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ) + Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ $$ ppr (if_id_env lcl)) } extendIfaceIdEnv :: [Id] -> IfL a -> IfL a ===================================== compiler/iface/IfaceSyn.hs ===================================== @@ -1530,6 +1530,9 @@ freeNamesIfProv IfaceUnsafeCoerceProv = emptyNameSet freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co freeNamesIfProv (IfacePluginProv _) = emptyNameSet +freeNamesIfProv (IfaceZappedProv _ _) = emptyNameSet + -- [ZappedCoDifference]: This won't report top-level names present in the + -- unzapped proof but not its kind. freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr ===================================== compiler/iface/IfaceType.hs ===================================== @@ -335,6 +335,13 @@ data IfaceUnivCoProv | IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String + | IfaceZappedProv [IfLclName] [CoVar] + -- ^ @local cvs, free cvs@ + -- + -- Local variables are those bound in the current IfaceType; free variables + -- are used only when printing open types and are not serialised; see Note + -- [Free tyvars in IfaceType]. + -- See Note [Zapping coercions] in TyCoRep. {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -510,6 +517,9 @@ substIfaceType env ty go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co) go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co) go_prov (IfacePluginProv str) = IfacePluginProv str + go_prov (IfaceZappedProv cvs fCvs) + = IfaceZappedProv + cvs fCvs substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs substIfaceAppArgs env args @@ -1533,6 +1543,11 @@ pprIfaceUnivCoProv (IfaceProofIrrelProv co) = text "irrel" <+> pprParendIfaceCoercion co pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) +pprIfaceUnivCoProv (IfaceZappedProv cvs fCvs) + = text "Zapped" <> brackets (whenPprDebug fvsDoc) + where + fvsDoc = text "free covars:" <+> ppr cvs + $$ text "open free covars:" <+> ppr fCvs ------------------- instance Outputable IfaceTyCon where @@ -1879,6 +1894,11 @@ instance Binary IfaceUnivCoProv where put_ bh (IfacePluginProv a) = do putByte bh 4 put_ bh a + put_ bh (IfaceZappedProv coFvs _) = do + putByte bh 5 + put_ bh coFvs + -- N.B. Free variables aren't serialised; see Note [Free tyvars in + -- IfaceType]. get bh = do tag <- getByte bh @@ -1890,6 +1910,10 @@ instance Binary IfaceUnivCoProv where return $ IfaceProofIrrelProv a 4 -> do a <- get bh return $ IfacePluginProv a + 5 -> do a <- get bh + -- N.B. Free variables aren't serialised; see Note [Free + -- tyvars in IfaceType]. + return $ IfaceZappedProv a [] _ -> panic ("get IfaceUnivCoProv " ++ show tag) ===================================== compiler/iface/TcIface.hs ===================================== @@ -1209,7 +1209,12 @@ tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n) -} tcIfaceCo :: IfaceCoercion -> IfL Coercion -tcIfaceCo = go +tcIfaceCo = \co0 -> do + dflags <- getDynFlags + co <- go co0 + if shouldBuildCoercions dflags + then return co + else return $ zapCoercion dflags co where go_mco IfaceMRefl = pure MRefl go_mco (IfaceMCo co) = MCo <$> (go co) @@ -1250,6 +1255,7 @@ tcIfaceUnivCoProv IfaceUnsafeCoerceProv = return UnsafeCoerceProv tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str +tcIfaceUnivCoProv (IfaceZappedProv coFvs _) = ZappedProv . mkDVarSet <$> mapM tcIfaceLclId coFvs {- ************************************************************************ ===================================== compiler/iface/ToIface.hs ===================================== @@ -275,6 +275,13 @@ toIfaceCoercionX fr co go_prov (PhantomProv co) = IfacePhantomProv (go co) go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co) go_prov (PluginProv str) = IfacePluginProv str + go_prov (ZappedProv fvs) = IfaceZappedProv cvs fCvs + where + (fCvs, cvs) = partitionWith f $ dVarSetElems fvs + isFree = (`elemVarSet` fr) + f v | ASSERT(isCoVar v) + isFree v = Left v + | otherwise = Right $ toIfaceCoVar v toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs toIfaceTcArgs = toIfaceTcArgsX emptyVarSet ===================================== compiler/main/DynFlags.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------- -- @@ -45,6 +46,7 @@ module DynFlags ( DynFlags(..), FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), + DynFlagsEnvM, runDynFlagsEnvM, RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, targetRetainsAllBindings, @@ -63,6 +65,7 @@ module DynFlags ( makeDynFlagsConsistent, shouldUseColor, shouldUseHexWordLiterals, + shouldBuildCoercions, positionIndependent, optimisationFlags, @@ -501,6 +504,7 @@ data GeneralFlag | Opt_D_faststring_stats | Opt_D_dump_minimal_imports | Opt_DoCoreLinting + | Opt_DropCoercions | Opt_DoStgLinting | Opt_DoCmmLinting | Opt_DoAsmLinting @@ -1358,6 +1362,17 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where getDynFlags = lift getDynFlags +-- | A reader monad over 'DynFlags'. +newtype DynFlagsEnvM a = DynFlagsEnvM (Reader DynFlags a) + deriving (Functor, Applicative, Monad) + +instance HasDynFlags DynFlagsEnvM where + getDynFlags = DynFlagsEnvM ask + +runDynFlagsEnvM :: DynFlags -> DynFlagsEnvM a -> a +runDynFlagsEnvM dflags (DynFlagsEnvM m) = runReader m dflags + + class ContainsDynFlags t where extractDynFlags :: t -> DynFlags @@ -1687,6 +1702,14 @@ shouldUseHexWordLiterals :: DynFlags -> Bool shouldUseHexWordLiterals dflags = Opt_HexWordLiterals `EnumSet.member` generalFlags dflags +-- | Should we generate coercions? +-- +-- See Note [Zapping coercions] for details. +shouldBuildCoercions :: DynFlags -> Bool +shouldBuildCoercions dflags = + gopt Opt_DoCoreLinting dflags && not (gopt Opt_DropCoercions dflags) + -- TODO: Add flag to explicitly enable coercion generation without linting? + -- | Are we building with @-fPIE@ or @-fPIC@ enabled? positionIndependent :: DynFlags -> Bool positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags @@ -3463,6 +3486,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_rtti) , make_ord_flag defGhcFlag "dcore-lint" (NoArg (setGeneralFlag Opt_DoCoreLinting)) + , make_ord_flag defGhcFlag "ddrop-coercions" + (NoArg (setGeneralFlag Opt_DropCoercions)) , make_ord_flag defGhcFlag "dstg-lint" (NoArg (setGeneralFlag Opt_DoStgLinting)) , make_ord_flag defGhcFlag "dcmm-lint" ===================================== compiler/typecheck/TcFlatten.hs ===================================== @@ -22,10 +22,12 @@ import Var import VarSet import VarEnv import Outputable +import DynFlags import TcSMonad as TcS import BasicTypes( SwapFlag(..) ) import Util +import Pair import Bag import Control.Monad import MonadUtils ( zipWith3M ) @@ -498,6 +500,9 @@ instance Applicative FlatM where pure x = FlatM $ const (pure x) (<*>) = ap +instance HasDynFlags FlatM where + getDynFlags = liftTcS getDynFlags + liftTcS :: TcS a -> FlatM a liftTcS thing_inside = FlatM $ const thing_inside @@ -1330,7 +1335,7 @@ flatten_exact_fam_app_fully tc tys -- See Note [Reduce type family applications eagerly] -- the following tcTypeKind should never be evaluated, as it's just used in -- casting, and casts by refl are dropped - = do { mOut <- try_to_reduce_nocache tc tys + = do { mOut <- try_to_reduce_nocache tc tys emptyDVarSet ; case mOut of Just out -> pure out Nothing -> do @@ -1374,6 +1379,7 @@ flatten_exact_fam_app_fully tc tys _ -> do { mOut <- try_to_reduce tc xis kind_co + (tyCoVarsOfCoDSet ret_co) (`mkTransCo` ret_co) ; case mOut of Just out -> pure out @@ -1419,11 +1425,18 @@ flatten_exact_fam_app_fully tc tys -- where -- orig_args is what was passed to the outer -- function + -> DTyCoVarSet -- free variables of ret_co -> ( Coercion -- :: (xi |> kind_co) ~ F args -> Coercion ) -- what to return from outer function -> FlatM (Maybe (Xi, Coercion)) - try_to_reduce tc tys kind_co update_co - = do { checkStackDepth (mkTyConApp tc tys) + try_to_reduce tc tys kind_co ret_co_fvs update_co + = do { let fvs = filterDVarSet isCoVar $ tyCoVarsOfTypesDSet tys + `unionDVarSet` tyCoVarsOfCoDSet kind_co + `unionDVarSet` ret_co_fvs + -- See Note [Zapping coercions] in TyCoRep + fam_ty = mkTyConApp tc tys + ; checkStackDepth (mkTyConApp tc tys) + ; dflags <- getDynFlags ; mb_match <- liftTcS $ matchFam tc tys ; case mb_match of -- NB: norm_co will always be homogeneous. All type families @@ -1443,18 +1456,25 @@ flatten_exact_fam_app_fully tc tys ; when (eq_rel == NomEq) $ liftTcS $ extendFlatCache tc tys ( co, xi, flavour ) - ; let role = eqRelRole eq_rel - xi' = xi `mkCastTy` kind_co - co' = update_co $ - mkTcCoherenceLeftCo role xi kind_co (mkSymCo co) - ; return $ Just (xi', co') } + ; let xi' = xi `mkCastTy` kind_co + role = eqRelRole eq_rel + -- See Note [Zapping coercions] + co' = mkZappedCoercion dflags (mkSymCo co) (Pair xi' fam_ty) Nominal fvs + co'' = update_co $ mkTcCoherenceLeftCo role xi kind_co co' + ; return $ Just (xi', co'') } Nothing -> pure Nothing } try_to_reduce_nocache :: TyCon -- F, family tycon -> [Type] -- args, not necessarily flattened + -> DTyCoVarSet -- free variables of ret_co -> FlatM (Maybe (Xi, Coercion)) - try_to_reduce_nocache tc tys - = do { checkStackDepth (mkTyConApp tc tys) + try_to_reduce_nocache tc tys fvs_ret_co + = do { let fvs = filterDVarSet isCoVar $ tyCoVarsOfTypesDSet tys + `unionDVarSet` fvs_ret_co + -- See Note [Zapping coercions] in TyCoRep + fam_ty = mkTyConApp tc tys + ; checkStackDepth fam_ty + ; dflags <- getDynFlags ; mb_match <- liftTcS $ matchFam tc tys ; case mb_match of -- NB: norm_co will always be homogeneous. All type families @@ -1464,7 +1484,8 @@ flatten_exact_fam_app_fully tc tys ; eq_rel <- getEqRel ; let co = mkSymCo (maybeSubCo eq_rel norm_co `mkTransCo` mkSymCo final_co) - ; return $ Just (xi, co) } + co' = mkZappedCoercion dflags co (Pair xi fam_ty) Nominal fvs + ; return $ Just (xi, co') } Nothing -> pure Nothing } {- Note [Reduce type family applications eagerly] ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -65,6 +65,7 @@ module TcHsType ( import GhcPrelude +import DynFlags import HsSyn import TcRnMonad import TcEvidence ===================================== compiler/typecheck/TcTyDecls.hs ===================================== @@ -138,6 +138,9 @@ synonymTyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyNameEnv + go_prov (ZappedProv _) = emptyNameEnv + -- [ZappedCoDifference]: This won't report type synonyms present in the + -- unzapped proof but not its kind. go_tc tc | isTypeSynonymTyCon tc = unitNameEnv (tyConName tc) tc | otherwise = emptyNameEnv ===================================== compiler/typecheck/TcType.hs ===================================== @@ -1020,6 +1020,7 @@ exactTyCoVarsOfType ty goProv (PhantomProv kco) = goCo kco goProv (ProofIrrelProv kco) = goCo kco goProv (PluginProv _) = emptyVarSet + goProv (ZappedProv _) = emptyVarSet -- TODO goVar v = unitVarSet v `unionVarSet` go (varType v) ===================================== compiler/types/Coercion.hs ===================================== @@ -97,6 +97,9 @@ module Coercion ( -- ** Forcing evaluation of coercions seqCo, + -- ** Eliding coercions + zapCoercion, + -- * Pretty-printing pprCo, pprParendCo, pprCoAxiom, pprCoAxBranch, pprCoAxBranchLHS, @@ -970,6 +973,8 @@ mkSymCo :: Coercion -> Coercion mkSymCo co | isReflCo co = co mkSymCo (SymCo co) = co mkSymCo (SubCo (SymCo co)) = SubCo co +mkSymCo (UnivCo (ZappedProv fvs) r t1 t2) = UnivCo (ZappedProv fvs) r t2 t1 +-- TODO: Handle other provenances mkSymCo co = SymCo co -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively. @@ -1114,6 +1119,10 @@ nthCoRole n co (Pair lty _, r) = coercionKindRole co mkLRCo :: LeftOrRight -> Coercion -> Coercion +mkLRCo lr (UnivCo (ZappedProv fvs) r t1 t2) + = UnivCo (ZappedProv fvs) r + (pickLR lr (splitAppTy t1)) + (pickLR lr (splitAppTy t2)) mkLRCo lr co | Just (ty, eq) <- isReflCo_maybe co = mkReflCo eq (pickLR lr (splitAppTy ty)) @@ -1170,6 +1179,7 @@ mkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty) mkKindCo (GRefl _ _ (MCo co)) = co mkKindCo (UnivCo (PhantomProv h) _ _ _) = h mkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h +mkKindCo (UnivCo (ZappedProv fvs) _ ty1 ty2) = mkUnivCo (ZappedProv fvs) Nominal (typeKind ty1) (typeKind ty2) mkKindCo co | Pair ty1 ty2 <- coercionKind co -- generally, calling coercionKind during coercion creation is a bad idea, @@ -1193,6 +1203,7 @@ mkSubCo (FunCo Nominal arg res) = FunCo Representational (downgradeRole Representational Nominal arg) (downgradeRole Representational Nominal res) +mkSubCo (UnivCo (ZappedProv fvs) Nominal t1 t2) = UnivCo (ZappedProv fvs) Representational t1 t2 mkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) ) SubCo co @@ -1293,6 +1304,7 @@ setNominalRole_maybe r co PhantomProv _ -> False -- should always be phantom ProofIrrelProv _ -> True -- it's always safe PluginProv _ -> False -- who knows? This choice is conservative. + ZappedProv _ -> False -- conservatively say no = Just $ UnivCo prov Nominal co1 co2 setNominalRole_maybe_helper _ = Nothing @@ -1400,6 +1412,7 @@ promoteCoercion co = case co of UnivCo (PhantomProv kco) _ _ _ -> kco UnivCo (ProofIrrelProv kco) _ _ _ -> kco UnivCo (PluginProv _) _ _ _ -> mkKindCo co + UnivCo (ZappedProv _) _ _ _ -> mkKindCo co SymCo g -> mkSymCo (promoteCoercion g) @@ -2157,6 +2170,7 @@ seqProv UnsafeCoerceProv = () seqProv (PhantomProv co) = seqCo co seqProv (ProofIrrelProv co) = seqCo co seqProv (PluginProv _) = () +seqProv (ZappedProv fvs) = seqDVarSet fvs seqCos :: [Coercion] -> () seqCos [] = () ===================================== compiler/types/Coercion.hs-boot ===================================== @@ -49,4 +49,5 @@ liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion seqCo :: Coercion -> () coercionKind :: Coercion -> Pair Type +coercionKindRole :: Coercion -> (Pair Type, Role) coercionType :: Coercion -> Type ===================================== compiler/types/FamInstEnv.hs ===================================== @@ -1747,6 +1747,9 @@ allTyCoVarsInTy = go go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyVarSet + go_prov (ZappedProv _) = emptyVarSet + -- We don't track free type variables, only + -- coercion variables. mkFlattenFreshTyName :: Uniquable a => a -> Name mkFlattenFreshTyName unq ===================================== compiler/types/OptCoercion.hs ===================================== @@ -108,8 +108,8 @@ optCoercion :: DynFlags -> TCvSubst -> Coercion -> NormalCo -- ^ optCoercion applies a substitution to a coercion, -- *and* optimises it to reduce its size optCoercion dflags env co - | hasNoOptCoercion dflags = substCo env co - | otherwise = optCoercion' env co + | hasNoOptCoercion dflags = substCo env co + | otherwise = optCoercion' env co optCoercion' :: TCvSubst -> Coercion -> NormalCo optCoercion' env co @@ -497,6 +497,14 @@ opt_univ env sym (PhantomProv h) _r ty1 ty2 ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 +opt_univ env sym (ZappedProv fvs) role ty1 ty2 + | sym = mkUnivCo (ZappedProv fvs') role ty2' ty1' + | otherwise = mkUnivCo (ZappedProv fvs') role ty1' ty2' + where + ty1' = substTy (lcSubstLeft env) ty1 + ty2' = substTy (lcSubstRight env) ty2 + fvs' = substFreeDVarSet (lcTCvSubst env) fvs + opt_univ env sym prov role oty1 oty2 | Just (tc1, tys1) <- splitTyConApp_maybe oty1 , Just (tc2, tys2) <- splitTyConApp_maybe oty2 @@ -557,6 +565,7 @@ opt_univ env sym prov role oty1 oty2 PhantomProv kco -> PhantomProv $ opt_co4_wrap env sym False Nominal kco ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco PluginProv _ -> prov + ZappedProv fvs -> ZappedProv $ substFreeDVarSet (lcTCvSubst env) fvs ------------- opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] @@ -639,6 +648,8 @@ opt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1) opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2) = Just $ ProofIrrelProv $ opt_trans is kco1 kco2 opt_trans_prov (PluginProv str1) (PluginProv str2) | str1 == str2 = Just p1 + opt_trans_prov (ZappedProv fvs1) (ZappedProv fvs2) + = Just $ ZappedProv $ fvs1 `unionDVarSet` fvs2 opt_trans_prov _ _ = Nothing -- Push transitivity down through matching top-level constructors. ===================================== compiler/types/TyCoRep.hs ===================================== @@ -40,6 +40,7 @@ module TyCoRep ( CoercionHole(..), coHoleCoVar, setCoHoleCoVar, CoercionN, CoercionR, CoercionP, KindCoercion, MCoercion(..), MCoercionR, MCoercionN, + mkZappedCoercion, zapCoercion, -- * Functions over types mkTyConTy, mkTyVarTy, mkTyVarTys, @@ -132,6 +133,7 @@ module TyCoRep ( substCoVarBndr, substTyVar, substTyVars, substTyCoVars, substForAllCoBndr, + substFreeDVarSet, substVarBndrUsing, substForAllCoBndrUsing, checkValidSubst, isValidTCvSubst, @@ -162,7 +164,7 @@ import {-# SOURCE #-} Type( isCoercionTy, mkAppTy, mkCastTy , tyCoVarsOfTypeWellScoped , tyCoVarsOfTypesWellScoped , scopedSort - , coreView ) + , coreView, eqType ) -- Transitively pulls in a LOT of stuff, better to break the loop import {-# SOURCE #-} Coercion @@ -197,6 +199,7 @@ import UniqSet -- libraries import qualified Data.Data as Data hiding ( TyCon ) import Data.List +import Data.Maybe ( fromMaybe ) import Data.IORef ( IORef ) -- for CoercionHole {- @@ -1646,6 +1649,11 @@ data UnivCoProvenance | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. + | ZappedProv DVarSet + -- ^ See Note [Zapping coercions]. + -- Free coercion variables must be tracked in 'DVarSet' since + -- they appear in interface files. + deriving Data.Data instance Outputable UnivCoProvenance where @@ -1653,6 +1661,7 @@ instance Outputable UnivCoProvenance where ppr (PhantomProv _) = text "(phantom)" ppr (ProofIrrelProv _) = text "(proof irrel.)" ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) + ppr (ZappedProv fvs) = parens (text "zapped" <+> brackets (ppr fvs)) -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole @@ -1796,8 +1805,232 @@ Here, where co5 :: (a1 ~ Bool) ~ (a2 ~ Bool) co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, ] +-} + +{- +%************************************************************************ +%* * + Zapping coercions into oblivion +%* * +%************************************************************************ +-} + +{- Note [Zapping coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Coercions for even small programs can grow to be quite large (e.g. #8095), +especially when type families are involved. For instance, the case of addition +of inductive naturals can build coercions quadratic in size of the summands. +For instance, consider the type-level addition operation defined on Peano naturals, + + data Nat = Z | Succ Nat + + type family (+) (a :: Nat) (b :: Nat) + type instance (+) Z a = a -- CoAx1 + type instance (+) (Succ a) b = Succ (a + b) -- CoAx2 + +Now consider what is necessary to reduce (S (S (S Z)) + S Z). This +reduction will produce two results: the reduced (i.e. flattened) type, and a +coercion witnessing the reduction. The reduction will proceed as follows: + + S (S (S Z)) + S Z |> Refl + ~> S (S (S Z) + S Z) |> CoAx2 Refl + ~> S (S (S Z + S Z)) |> CoAx2 (CoAx2 Refl) + ~> S (S (S (Z + S Z))) |> CoAx2 (CoAx2 (CoAx2 Refl)) + ~> S (S (S (S (S Z)))) |> CoAx1 (CoAx2 (CoAx2 (CoAx2 Refl))) + +Note that when we are building coercions [TODO] + +Moreover, coercions are really only useful when validating core transformations +(i.e. by the Core Linter). To avoid burdening users who aren't linting with the +cost of maintaining these structures, we replace coercions with placeholders +("zap" them) them unless -dcore-lint is enabled. These placeholders are +represented by UnivCo with ZappedProv provenance. Concretely, a coercion + + co :: t1 ~r t2 + +is replaced by + + UnivCo (ZappedProv fvs) r t1 t2 + +To ensure that such coercions aren't floated out of the scope of proofs they +require, the ZappedProv constructor includes the coercion's set of free coercion +variables (as a DVarSet, since these sets are included in interface files). + + +Zapping during type family reduction +------------------------------------ + +To avoid the quadratic blow-up in coercion size during type family reduction +described above, we zap on every type family reduction step taken by +TcFlatten.flatten_exact_fam_app_fully. When zapping we take care to avoid +looking at the constructed coercion and instead build up a zapped coercion +directly from type being reduced, its free variables, and the result of the +reduction. This allows us to reduce recursive type families in time linear to +the size of the type at the expense of Core Lint's ability to validate the +reduction. + +Note that the free variable set of the zapped coercion is taken to be the free +variable set of the unreduced family application, which is computed once at the +beginning of reduction. This is an important optimisation as it allows us to +avoid recomputing the free variable set (which requires linear work in the size +of the coercion) with every reduction step. Moreover, this gives us the same +result as naively computing the free variables of every reduction: + + * The FV set of the unreduced type cannot be smaller than that of the reduced type + because there is nowhere for extra FVs to come from. Type family equations + are essentially function reduction, which can never introduce new fvs. + + * The FV set of the unreducecd type cannot be larger than that of the reduced + type because the zapped coercion's kind must mention the types these fvs come + from, so the FVs of the zapped coercion must be at least those in the + starting types. + +Thus, the two sets are subsets of each other and are equal. + + +Other places where we zap +------------------------- +Besides during type family reduction, we also zap coercions in a number of other +places (again, only when DynFlags.shouldBuildCoercions is False). This zapping +occurs in zapCoercion, which maps a coercion to its zapped form. However, there +are a few optimisations which we implement: + * We don't zap coercions which are already zapping; this avoids an unnecessary + free variable computation. + + * We don't zap Refl coercions. This is because Refls are actually far more + compact than zapped coercions: the coercion (Refl T) holds only one + reference to T, whereas its zapped equivalent would hold two. While this + makes little difference directly after construction due to sharing, this + sharing will be lost when we substitute or otherwise manipulate the zapped + coercion, resulting in a doubling of the coercions representation size. + +zapCoercion is called in a few places: + + * CoreOpt.pushCoTyArg zaps the coercions it produces to avoid pile-up during + simplification [TODO] + + * TcIface.tcIfaceCo + + * Type.mapCoercion (which is used by zonking) can optionally zap coercions, + although this is currently disabled since it causes compiler allocations to + regress in a few cases. + + * We considered zapping as well in optCoercion, although this too caused + significant allocation regressions. + +The importance of tracking free coercion variables +-------------------------------------------------- + +It is quite important that zapped coercions track their free coercion variables. +To see why, consider this program: + + data T a where + T1 :: Bool -> T Bool + T2 :: T Int + + f :: T a -> a -> Bool + f = /\a (x:T a) (y:a). + case x of + T1 (c : a~Bool) (z : Bool) -> not (y |> c) + T2 -> True + +Now imagine that we zap the coercion `c`, replacing it with a generic UnivCo +between `a` and Bool. If we didn't record the fact that this coercion was +previously free in `c`, we may incorrectly float the expression `not (y |> c)` +out of the case alternative which brings proof of `c` into scope. If this +happened then `f T2 (I# 5)` would try to interpret `y` as a Bool, at +which point we aren't far from a segmentation fault or much worse. + +Note that we don't need to track the coercion's free *type* variables. This +means that we may float past type variables which the original proof had as free +variables. While surprising, this doesn't jeopardise the validity of the +coercion, which only depends upon the scoping relative to the free coercion +variables. + + +Differences between zapped and unzapped coercions +------------------------------------------------- + +Alas, sometimes zapped coercions will behave slightly differently from their +unzapped counterparts. Specifically, we are a bit lax in tracking external names +that are present in the unzapped coercion but not its kind. This manifests in a +few places (these are labelled in the source with the [ZappedCoDifference] +keyword): + + * Since we only track a zapped coercion's free *coercion* variables, the + simplifier may float such coercions farther than it would have if the proof + were present. + + * IfaceSyn.freeNamesIfCoercion will fail to report top-level names present in + the unzapped proof but not its kind. + + * TcTyDecls.synonymTyConsOfType will fail to report type synonyms present in + in the unzapped proof but not its kind. + + * The result of TcValidity.fvCo will contain each free variable of a ZappedCo + only once, even if it would have reported multiple occurrences in the + unzapped coercion. + + * Type.tyConsOfType does not report TyCons which appear only in the unzapped + proof and not its kind. + + * Zapped coercions are represented in interface files as IfaceZappedProv. This + representation only includes local free variables, since these are sufficient + to avoid unsound floating. This means that the free variable lists of zapped + coercions loaded from interface files will lack top-level things (e.g. type + constructors) that appear only in the unzapped proof. + +-} + +-- | Make a zapped coercion if building of coercions is disabled, otherwise +-- return the given un-zapped coercion. +mkZappedCoercion :: HasDebugCallStack + => DynFlags + -> Coercion -- ^ the un-zapped coercion + -> Pair Type -- ^ the kind of the coercion + -> Role -- ^ the role of the coercion + -> DCoVarSet -- ^ the free coercion variables of the coercion + -> Coercion +mkZappedCoercion dflags co (Pair ty1 ty2) role fCvs + | debugIsOn && not is_ok = + pprPanic "mkZappedCoercion" $ vcat + [ text "real role:" <+> ppr real_role + , text "given role:" <+> ppr role + , text "real ty1:" <+> ppr real_ty1 + , text "given ty1:" <+> ppr ty1 + , text "real ty2:" <+> ppr real_ty2 + , text "given ty2:" <+> ppr ty2 + , text "real free co vars:" <+> ppr real_fCvs + , text "given free co vars:" <+> ppr fCvs + ] + | shouldBuildCoercions dflags = co + | otherwise = + mkUnivCo (ZappedProv fCvs) role ty1 ty2 + where + (Pair real_ty1 real_ty2, real_role) = coercionKindRole co + real_fCvs = filterVarSet isCoVar (coVarsOfCo co) + is_ok = + real_role == role + && (real_ty1 `eqType` ty1) + && (real_ty2 `eqType` ty2) + -- It's not generally possible to compute the actual free variable set + -- since we may encounter flattening skolems during reduction. + -- && dVarSetToVarSet fCvs == real_fCvs + +-- | Replace a coercion with a zapped coercion unless coercions are needed. +zapCoercion :: DynFlags -> Coercion -> Coercion +zapCoercion _ co@(UnivCo (ZappedProv _) _ _ _) = co -- already zapped +zapCoercion _ co@(Refl _) = co -- Refl is smaller than zapped coercions +zapCoercion dflags co = + mkZappedCoercion dflags co (Pair t1 t2) role fvs + where + (Pair t1 t2, role) = coercionKindRole co + fvs = filterDVarSet isCoVar $ tyCoVarsOfCoDSet co + +{- %************************************************************************ %* * Free variables of types and coercions @@ -1820,7 +2053,7 @@ instead do so at call sites, but it seems that we always want to do so, so it's easiest to do it here. It turns out that getting the free variables of types is performance critical, -so we profiled several versions, exploring different implementation strategies. +o we profiled several versions, exploring different implementation strategies. 1. Baseline version: uses FV naively. Essentially: @@ -2013,6 +2246,7 @@ ty_co_vars_of_prov (PhantomProv co) is acc = ty_co_vars_of_co co is acc ty_co_vars_of_prov (ProofIrrelProv co) is acc = ty_co_vars_of_co co is acc ty_co_vars_of_prov UnsafeCoerceProv _ acc = acc ty_co_vars_of_prov (PluginProv _) _ acc = acc +ty_co_vars_of_prov (ZappedProv fvs) _ acc = dVarSetToVarSet fvs -- | Generates an in-scope set from the free variables in a list of types -- and a list of coercions @@ -2160,6 +2394,7 @@ tyCoFVsOfProv UnsafeCoerceProv fv_cand in_scope acc = emptyFV fv_cand in_scop tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfProv (ZappedProv fvs) fv_cand in_scope acc = (mkFVs $ dVarSetElems fvs) fv_cand in_scope acc tyCoFVsOfCos :: [Coercion] -> FV tyCoFVsOfCos [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc @@ -2265,6 +2500,7 @@ almost_devoid_co_var_of_prov (ProofIrrelProv co) cv = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_prov UnsafeCoerceProv _ = True almost_devoid_co_var_of_prov (PluginProv _) _ = True +almost_devoid_co_var_of_prov (ZappedProv fvs) cv = cv `elemDVarSet` fvs almost_devoid_co_var_of_type :: Type -> CoVar -> Bool almost_devoid_co_var_of_type (TyVarTy _) _ = True @@ -2651,6 +2887,7 @@ noFreeVarsOfProv UnsafeCoerceProv = True noFreeVarsOfProv (PhantomProv co) = noFreeVarsOfCo co noFreeVarsOfProv (ProofIrrelProv co) = noFreeVarsOfCo co noFreeVarsOfProv (PluginProv {}) = True +noFreeVarsOfProv (ZappedProv fvs) = isEmptyDVarSet fvs {- %************************************************************************ @@ -3391,11 +3628,20 @@ subst_co subst co go_prov (PhantomProv kco) = PhantomProv (go kco) go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco) go_prov p@(PluginProv _) = p + go_prov (ZappedProv fvs) = ZappedProv (filterDVarSet isCoVar $ substFreeDVarSet subst fvs) -- See Note [Substituting in a coercion hole] go_hole h@(CoercionHole { ch_co_var = cv }) = h { ch_co_var = updateVarType go_ty cv } +-- | Perform a substitution within a 'DVarSet' of free variables. +substFreeDVarSet :: TCvSubst -> DVarSet -> DVarSet +substFreeDVarSet subst = + let f v + | isTyVar v = tyCoVarsOfTypeDSet $ substTyVar subst v + | otherwise = tyCoVarsOfCoDSet $ substCoVar subst v + in mapUnionDVarSet f . dVarSetElems + substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion -> (TCvSubst, TyCoVar, Coercion) substForAllCoBndr subst @@ -3475,14 +3721,15 @@ substForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) substCoVar :: TCvSubst -> CoVar -> Coercion substCoVar (TCvSubst _ _ cenv) cv - = case lookupVarEnv cenv cv of + = ASSERT( isCoVar cv ) + case lookupVarEnv cenv cv of Just co -> co Nothing -> CoVarCo cv substCoVars :: TCvSubst -> [CoVar] -> [Coercion] substCoVars subst cvs = map (substCoVar subst) cvs -lookupCoVar :: TCvSubst -> Var -> Maybe Coercion +lookupCoVar :: TCvSubst -> CoVar -> Maybe Coercion lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar) @@ -4057,9 +4304,7 @@ tidyCo env@(_, subst) co -- the case above duplicates a bit of work in tidying h and the kind -- of tv. But the alternative is to use coercionKind, which seems worse. go (FunCo r co1 co2) = (FunCo r $! go co1) $! go co2 - go (CoVarCo cv) = case lookupVarEnv subst cv of - Nothing -> CoVarCo cv - Just cv' -> CoVarCo cv' + go (CoVarCo cv) = CoVarCo $ substCoVar cv go (HoleCo h) = HoleCo h go (AxiomInstCo con ind cos) = let args = map go cos in args `seqList` AxiomInstCo con ind args @@ -4079,6 +4324,9 @@ tidyCo env@(_, subst) co go_prov (PhantomProv co) = PhantomProv (go co) go_prov (ProofIrrelProv co) = ProofIrrelProv (go co) go_prov p@(PluginProv _) = p + go_prov (ZappedProv fvs) = ZappedProv $ mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs) + + substCoVar cv = fromMaybe cv $ lookupVarEnv subst cv tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = map (tidyCo env) @@ -4139,3 +4387,4 @@ provSize UnsafeCoerceProv = 1 provSize (PhantomProv co) = 1 + coercionSize co provSize (ProofIrrelProv co) = 1 + coercionSize co provSize (PluginProv _) = 1 +provSize (ZappedProv _) = 1 ===================================== compiler/types/Type.hs ===================================== @@ -267,7 +267,8 @@ import FV import Outputable import FastString import Pair -import DynFlags ( gopt_set, GeneralFlag(Opt_PrintExplicitRuntimeReps) ) +import DynFlags ( HasDynFlags(..) + , gopt_set, GeneralFlag(Opt_PrintExplicitRuntimeReps) ) import ListSetOps import Unique ( nonDetCmpUnique ) @@ -479,6 +480,8 @@ expandTypeSynonyms ty go_prov subst (PhantomProv co) = PhantomProv (go_co subst co) go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co) go_prov _ p@(PluginProv _) = p + go_prov subst (ZappedProv fvs) + = ZappedProv $ substFreeDVarSet subst fvs -- the "False" and "const" are to accommodate the type of -- substForAllCoBndrUsing, which is general enough to @@ -547,7 +550,8 @@ data TyCoMapper env m } {-# INLINABLE mapType #-} -- See Note [Specialising mappers] -mapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type +mapType :: (Monad m, HasDynFlags m) + => TyCoMapper env m -> env -> Type -> m Type mapType mapper@(TyCoMapper { tcm_tyvar = tyvar , tcm_tycobinder = tycobinder , tcm_tycon = tycon }) @@ -582,7 +586,7 @@ mapType mapper@(TyCoMapper { tcm_tyvar = tyvar ; return $ ForAllTy (Bndr tv' vis) inner' } {-# INLINABLE mapCoercion #-} -- See Note [Specialising mappers] -mapCoercion :: Monad m +mapCoercion :: (Monad m, HasDynFlags m) => TyCoMapper env m -> env -> Coercion -> m Coercion mapCoercion mapper@(TyCoMapper { tcm_covar = covar , tcm_hole = cohole @@ -629,6 +633,11 @@ mapCoercion mapper@(TyCoMapper { tcm_covar = covar go_prov (PhantomProv co) = PhantomProv <$> go co go_prov (ProofIrrelProv co) = ProofIrrelProv <$> go co go_prov p@(PluginProv _) = return p + go_prov (ZappedProv fvs) + = let bndrFVs v = + ASSERT(isCoVar v) + tyCoVarsOfCoDSet <$> covar env v + in ZappedProv . unionDVarSets <$> mapM bndrFVs (dVarSetElems fvs) {- ************************************************************************ @@ -3012,7 +3021,7 @@ occCheckExpand vs_to_avoid ty go_prov cxt (PhantomProv co) = PhantomProv <$> go_co cxt co go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co go_prov _ p@(PluginProv _) = return p - + go_prov _ p@(ZappedProv _) = return p {- %************************************************************************ @@ -3068,6 +3077,10 @@ tyConsOfType ty go_prov (PluginProv _) = emptyUniqSet -- this last case can happen from the tyConsOfType used from -- checkTauTvUpdate + go_prov (ZappedProv _) = emptyUniqSet + -- [ZappedCoDifference] that this will not report TyCons present in the + -- unzapped proof but not its kind. See Note [Zapping coercions] in + -- TyCoRep. go_s tys = foldr (unionUniqSets . go) emptyUniqSet tys go_cos cos = foldr (unionUniqSets . go_co) emptyUniqSet cos View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ea7f96de6f492a82564b0633152a895b9408c15f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ea7f96de6f492a82564b0633152a895b9408c15f You're receiving 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 Jun 11 19:36:58 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 15:36:58 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 28 commits: Bump Cabal submodule Message-ID: <5d0002da77f44_6f73fe5f555e644227707@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: b1fe5750 by Ben Gamari at 2019-06-11T19:36:03Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 5a33cd10 by Ben Gamari at 2019-06-11T19:36:17Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - b394cfa6 by Ben Gamari at 2019-06-11T19:36:17Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 5f503bc0 by Ben Gamari at 2019-06-11T19:36:17Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - e815ac23 by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - af3a63e6 by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - aa497e2a by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - 27fc0177 by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark T14761c as broken in hpc and optasm ways As noted in #16540. - - - - - 4377f44b by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - df4c591f by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - e606b08c by Ben Gamari at 2019-06-11T19:36:17Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 77576cd6 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - f538a2e6 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 907e68b2 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Fix fragile_for test modifier - - - - - 873b4c0a by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 8256f76f by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 3c424dfb by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - b6fd0634 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 26254cd0 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - da0cd963 by Ben Gamari at 2019-06-11T19:36:18Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - 83f3b630 by Ben Gamari at 2019-06-11T19:36:19Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - 35b2a9b9 by Ben Gamari at 2019-06-11T19:36:19Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 70b1a304 by Ben Gamari at 2019-06-11T19:36:19Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 21cbcf33 by Ben Gamari at 2019-06-11T19:36:19Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 3f11bbd2 by Ben Gamari at 2019-06-11T19:36:19Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - fbfa8095 by Ben Gamari at 2019-06-11T19:36:19Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - cbe00035 by Ben Gamari at 2019-06-11T19:36:19Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 4325cce5 by Ben Gamari at 2019-06-11T19:36:19Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/Cabal - libraries/base/tests/all.T - libraries/process - libraries/terminfo - libraries/time - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/programs/galois_raytrace/test.T - testsuite/tests/rts/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T - testsuite/tests/warnings/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/b4ef27bb15edb9cf2ab0e06704f2646c5101add0...4325cce5b7c06788a8ddf30793c0fb0aa8c8fb1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b4ef27bb15edb9cf2ab0e06704f2646c5101add0...4325cce5b7c06788a8ddf30793c0fb0aa8c8fb1b You're receiving 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 Jun 11 19:37:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 15:37:39 -0400 Subject: [Git][ghc/ghc][wip/submod-bumps] 10 commits: Comments only: document newtypes' DataConWrapId Message-ID: <5d0003038a14b_6f73fe61e8072a0227763d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/submod-bumps at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 12b6a587 by Ben Gamari at 2019-06-11T19:37:21Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 9020a981 by Ben Gamari at 2019-06-11T19:37:21Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - ecb30a83 by Ben Gamari at 2019-06-11T19:37:29Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - 1785adfd by Ben Gamari at 2019-06-11T19:37:29Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - e5c6b4c2 by Ben Gamari at 2019-06-11T19:37:29Z Bump process submodule to 1.6.5.1 - - - - - 34876db8 by Ben Gamari at 2019-06-11T19:37:29Z testsuite: Fix fragile_for test modifier - - - - - 16 changed files: - compiler/basicTypes/MkId.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Compile.hs - libraries/Cabal - libraries/binary - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - libraries/process - libraries/terminfo - libraries/time - testsuite/driver/testlib.py - testsuite/tests/driver/T4437.hs - utils/ghc-cabal/Main.hs - + utils/ghctags/ghctags.cabal Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal.Parse @@ -17,6 +16,7 @@ module Hadrian.Haskell.Cabal.Parse ( import Data.Bifunctor import Data.List.Extra import Development.Shake +import qualified Distribution.Compat.Graph as Graph import qualified Distribution.ModuleName as C import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C @@ -30,6 +30,7 @@ import qualified Distribution.Simple.Utils as C import qualified Distribution.Simple.Program.Types as C import qualified Distribution.Simple.Configure as C (getPersistBuildConfig) import qualified Distribution.Simple.Build as C +import qualified Distribution.Types.ComponentLocalBuildInfo as C import qualified Distribution.Types.ComponentRequestedSpec as C import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as C @@ -219,7 +220,7 @@ resolveContextData context at Context {..} = do -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 - let extDeps = C.externalPackageDeps lbi' + let extDeps = externalPackageDeps lbi' deps = map (C.display . snd) extDeps depDirect = map (fromMaybe (error "resolveContextData: depDirect failed") . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps @@ -306,7 +307,20 @@ buildAutogenFiles context = do getHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo getHookedBuildInfo [] = return C.emptyHookedBuildInfo getHookedBuildInfo (baseDir:baseDirs) = do - maybeInfoFile <- C.findHookedPackageDesc baseDir + maybeInfoFile <- C.findHookedPackageDesc C.normal baseDir case maybeInfoFile of Nothing -> getHookedBuildInfo baseDirs Just infoFile -> C.readHookedBuildInfo C.silent infoFile + +externalPackageDeps :: C.LocalBuildInfo -> [(C.UnitId, C.MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (C.componentGraph lbi) + , (ipkgid, pkgid) <- C.componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . C.componentUnitId) (Graph.toList (C.componentGraph lbi)) + ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5d258537b754005d2a1d170b44d764b63ff4fc75 +Subproject commit f697d3209990c3314efe840be54fb7c5a967e6ff ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174 +Subproject commit fcd9d3cb2a942c54347d28bcb80a1b46d2d7d673 ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 7049b2625a490feda9bcb201a5a811d790f06cd0 +Subproject commit 6065302a4f75649f14397833766e82c8182935bf ===================================== libraries/time ===================================== @@ -1 +1 @@ -Subproject commit 9e96c26132fef01a3113c8b152b1be96c0eccd86 +Subproject commit 5319bed3b14c21de5410ead88ec8aaa838d7339c ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,7 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -39,8 +39,6 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", - "EmptyDataDeriving", - "GeneralisedNewtypeDeriving", "CUSKs", "ImportQualifiedPost"] ===================================== utils/ghc-cabal/Main.hs ===================================== @@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register +import qualified Distribution.Compat.Graph as Graph import Distribution.Text import Distribution.Types.MungedPackageId +import Distribution.Types.LocalBuildInfo import Distribution.Verbosity import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex @@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } +externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] +externalPackageDeps lbi = + -- TODO: what about non-buildable components? + nub [ (ipkgid, pkgid) + | clbi <- Graph.toList (componentGraph lbi) + , (ipkgid, pkgid) <- componentPackageDeps clbi + , not (internal ipkgid) ] + where + -- True if this dependency is an internal one (depends on the library + -- defined in the same package). + internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) + generate :: FilePath -> FilePath -> [String] -> IO () generate directory distdir config_args = withCurrentDirectory directory @@ -274,8 +288,8 @@ generate directory distdir config_args -- cabal 2.2+ will expect it, but fallback to the old default -- location if we don't find any. This is the case of the -- bindist, which doesn't ship the $dist/build folder. - maybe_infoFile <- findHookedPackageDesc (cwd distdir "build") - <|> defaultHookedPackageDesc + maybe_infoFile <- findHookedPackageDesc verbosity (cwd distdir "build") + <|> fmap Just (defaultPackageDesc verbosity) case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -307,8 +321,9 @@ generate directory distdir config_args let comp = compiler lbi - libBiModules lib = (libBuildInfo lib, libModules lib) + libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName)) exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe) + biModuless :: [(BuildInfo, [ModuleName.ModuleName])] biModuless = (map libBiModules . maybeToList $ library pd) ++ (map exeBiModules $ executables pd) buildableBiModuless = filter isBuildable biModuless ===================================== utils/ghctags/ghctags.cabal ===================================== @@ -0,0 +1,23 @@ +Name: ghctags +Version: 0.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: A simple generator of vi- and emacs-compatible TAGS files. +Description: XXX +Category: Development +build-type: Simple +cabal-version: >=1.10 + +Executable ghctags + Default-Language: Haskell2010 + + Main-Is: Main.hs + + Build-Depends: base >= 4 && < 5, + containers, + Cabal >= 3.0 && <3.1, + ghc + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2...34876db83aab33fafcce4922f80aab5bb0d8bc1a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2...34876db83aab33fafcce4922f80aab5bb0d8bc1a You're receiving 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 Jun 11 19:39:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 15:39:55 -0400 Subject: [Git][ghc/ghc][wip/T16798] 5 commits: Comments only: document newtypes' DataConWrapId Message-ID: <5d00038bb364f_6f7a3b0efc2278329@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - 4c5a490e by Ben Gamari at 2019-06-11T19:39:44Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 11 changed files: - compiler/basicTypes/MkId.hs - hadrian/src/Rules/Compile.hs - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,26 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py']), + when(opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.bat'))), + when(not opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.py'))) + ], + compile_and_run, + ['']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5ead7a09f17019d7d171c4213cc41a065082e96f...4c5a490e362a65e7ebf15f2fa2041b79ab5c7b44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5ead7a09f17019d7d171c4213cc41a065082e96f...4c5a490e362a65e7ebf15f2fa2041b79ab5c7b44 You're receiving 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 Jun 11 20:08:51 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 16:08:51 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 22 commits: testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways Message-ID: <5d000a53658b_6f7a3b0efc22824f5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: 9bf20fa7 by Ben Gamari at 2019-06-11T19:53:37Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 00a1c98e by Ben Gamari at 2019-06-11T19:53:48Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 2a4178ef by Ben Gamari at 2019-06-11T19:53:48Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - a4a8b82a by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - 67026576 by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - 43707434 by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 6137c44e by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Fix fragile_for test modifier - - - - - 0be20257 by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 42be8f18 by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - ca0f71e8 by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - cca4a9cb by Ben Gamari at 2019-06-11T19:53:49Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - 63425da6 by Ben Gamari at 2019-06-11T19:53:50Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - d3eae47a by Ben Gamari at 2019-06-11T19:53:50Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - ebc445cd by Ben Gamari at 2019-06-11T19:53:50Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - e32b348c by Ben Gamari at 2019-06-11T19:53:50Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - b509df62 by Ben Gamari at 2019-06-11T19:53:50Z gitlab-ci: Fetch submodules before running submodule linter - - - - - dd7af1de by Ben Gamari at 2019-06-11T19:53:50Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - ec8a7d03 by Ben Gamari at 2019-06-11T19:53:50Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - 4ba68bff by Ben Gamari at 2019-06-11T19:53:50Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 79ef5215 by Ben Gamari at 2019-06-11T19:53:50Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - a3152287 by Ben Gamari at 2019-06-11T19:53:51Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - edda3103 by Ben Gamari at 2019-06-11T20:08:11Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/process - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/parser/should_compile/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/programs/galois_raytrace/test.T - testsuite/tests/quotes/all.T - testsuite/tests/roles/should_compile/all.T - testsuite/tests/rts/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/utils/should_run/all.T - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,6 +80,7 @@ ghc-linters: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: @@ -109,6 +110,7 @@ lint-submods-branch: extends: .lint-submods script: - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" + - git submodule foreach git remote update - submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) only: refs: ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,7 +12,8 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.", + path_filter = lambda path: path == 'Makefile') ] if __name__ == '__main__': ===================================== .gitlab/linters/linter.py ===================================== @@ -73,13 +73,14 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex, message, path_filter=lambda path: True): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message + self.path_filter = path_filter def lint_line(self, path, line_no, line): - if self.re.search(line): + if self.path_filter(path) and self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) ===================================== aclocal.m4 ===================================== @@ -866,7 +866,7 @@ case $TargetPlatform in esac ;; i386-unknown-mingw32) fptools_cv_leading_underscore=yes;; x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;; - *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H + *) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H) #include struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; @@ -876,7 +876,7 @@ int main(argc, argv) int argc; char **argv; { -#ifdef HAVE_NLIST_H +#if defined(HAVE_NLIST_H) if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) exit(1); if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) @@ -1650,16 +1650,16 @@ then [fptools_cv_timer_create_works], [AC_TRY_RUN([ #include -#ifdef HAVE_STDLIB_H +#if defined(HAVE_STDLIB_H) #include #endif -#ifdef HAVE_TIME_H +#if defined(HAVE_TIME_H) #include #endif -#ifdef HAVE_SIGNAL_H +#if defined(HAVE_SIGNAL_H) #include #endif -#ifdef HAVE_UNISTD_H +#if defined(HAVE_UNISTD_H) #include #endif ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -233,7 +233,7 @@ generateGhcPlatformH = do targetVendor <- getSetting TargetVendor ghcUnreg <- getFlag GhcUnregisterised return . unlines $ - [ "#ifndef __GHCPLATFORM_H__" + [ "#if !defined(__GHCPLATFORM_H__)" , "#define __GHCPLATFORM_H__" , "" , "#define BuildPlatform_TYPE " ++ cppify hostPlatform @@ -386,7 +386,7 @@ generateGhcAutoconfH = do ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ - [ "#ifndef __GHCAUTOCONF_H__" + [ "#if !defined(__GHCAUTOCONF_H__)" , "#define __GHCAUTOCONF_H__" ] ++ configHContents ++ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ] @@ -422,7 +422,7 @@ generateGhcBootPlatformH = do targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor return $ unlines - [ "#ifndef __PLATFORM_H__" + [ "#if !defined(__PLATFORM_H__)" , "#define __PLATFORM_H__" , "" , "#define BuildPlatform_NAME " ++ show buildPlatform @@ -464,10 +464,10 @@ generateGhcVersionH = do patchLevel1 <- getSetting ProjectPatchLevel1 patchLevel2 <- getSetting ProjectPatchLevel2 return . unlines $ - [ "#ifndef __GHCVERSION_H__" + [ "#if !defined(__GHCVERSION_H__)" , "#define __GHCVERSION_H__" , "" - , "#ifndef __GLASGOW_HASKELL__" + , "#if !defined(__GLASGOW_HASKELL__)" , "# define __GLASGOW_HASKELL__ " ++ version , "#endif" , ""] ===================================== includes/ghc.mk ===================================== @@ -57,7 +57,7 @@ endif $(includes_H_VERSION) : mk/project.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCVERSION_H__" > $@ + @echo "#if !defined(__GHCVERSION_H__)" > $@ @echo "#define __GHCVERSION_H__" >> $@ @echo >> $@ @echo "#define __GLASGOW_HASKELL__ $(ProjectVersionInt)" >> $@ @@ -92,7 +92,7 @@ else $(includes_H_CONFIG) : mk/config.h mk/config.mk includes/ghc.mk | $$(dir $$@)/. @echo "Creating $@..." - @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#if !defined(__GHCAUTOCONF_H__)" >$@ @echo "#define __GHCAUTOCONF_H__" >>$@ # # Copy the contents of mk/config.h, turning '#define PACKAGE_FOO @@ -125,7 +125,7 @@ endif $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. $(call removeFiles,$@) @echo "Creating $@..." - @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#if !defined(__GHCPLATFORM_H__)" >$@ @echo "#define __GHCPLATFORM_H__" >>$@ @echo >> $@ @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 5c81524694ceaf8523a1846718a7a7c3f402124f ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit a102df29c107e8f853129dd40fbbb487e1818149 +Subproject commit 3985f63a35235ce5e10a4cb6f532c1041f466372 ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,8 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + assert ways.__class__ is list + opts.omit_ways += ways # ----- @@ -433,6 +434,14 @@ def unless(b, f): def doing_ghci(): return 'ghci' in config.run_ways +def requires_th(name, opts): + """ + Mark a test as requiring TemplateHaskell. Currently this means + that we don't run the test in the profasm when when GHC is + dynamically-linked since we can't load profiled objects in this case. + """ + return when(ghc_dynamic(), omit_ways(['profasm'])) + def ghc_dynamic(): return config.ghc_dynamic ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -83,7 +83,7 @@ test('cgrun072', normal, compile_and_run, ['']) test('cgrun075', normal, compile_and_run, ['']) test('cgrun076', normal, compile_and_run, ['']) test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], compile_and_run, ['']) -test('cgrun078', normal, compile_and_run, ['']) +test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) @@ -196,4 +196,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', [expect_broken_for(16742, ['dyn', 'ghci', 'optasm', 'threaded2']), exit_code(1)], compile_and_run, ['']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -88,7 +88,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) @@ -239,7 +239,7 @@ test('conc067', ignore_stdout, compile_and_run, ['']) # omit threaded2, the behaviour of this test is non-deterministic with more # than one CPU. -test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) +test('conc068', [ omit_ways(['threaded2']), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', [ only_ways(['threaded1','threaded2']), ===================================== testsuite/tests/driver/all.T ===================================== @@ -170,6 +170,7 @@ test( 'T4114d', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_r test('T5584', [], makefile_test, []) test('T5198', [], makefile_test, []) test('T7060', [], makefile_test, []) +# N.B. The typo in the argument below is intentional. test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), makefile_test, []) test('T6037', @@ -270,4 +271,8 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) -test('T16737', [extra_files(['T16737include/'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) +test('T16737', + [extra_files(['T16737include/']), + requires_th, + expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-optP=-isystem -optP=T16737include']) ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -35,7 +35,8 @@ test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) test('T14125', normal, compile, ['']) test( 'cc017', - normal, + # We need TH but can't load profiled dynamic objects + when(ghc_dynamic(), omit_ways(['profasm'])), compile, [ '-optc=-DC -optcxx=-DCXX -optcxx=-std=c++11' ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -207,4 +207,4 @@ test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c' test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c']) -test('T493', [], compile_and_run, ['T493_c.c']) +test('T493', [omit_ways(['ghci'])], compile_and_run, ['T493_c.c']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -1,8 +1,8 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples -test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) -test('plusMinusInteger', [omit_ways('ghci')], compile_and_run, ['']) +test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways(['ghci'])], compile_and_run, ['']) +test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -142,5 +142,5 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) -test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T16619', requires_th, multimod_compile, ['T16619', '-v0']) test('T504', normal, compile, ['']) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,7 +404,7 @@ test ('WWRec', ['-v0 -O']) test('T16190', - collect_stats(), + [requires_th, collect_stats()], multimod_compile, ['T16190.hs', '-v0']) ===================================== testsuite/tests/programs/barton-mangler-bug/test.T ===================================== @@ -8,7 +8,7 @@ test('barton-mangler-bug', 'Plot.hi', 'Plot.o', 'PlotExample.hi', 'PlotExample.o', 'TypesettingTricks.hi', 'TypesettingTricks.o']), - omit_ways('debug') # Fails for debug way due to annotation linting timeout + omit_ways(['debug']) # Fails for debug way due to annotation linting timeout ], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/programs/galois_raytrace/test.T ===================================== @@ -1,8 +1,3 @@ -# Floating point differences on x86 using the NCG -if config.platform.startswith('i386-') and \ - config.platform != 'i386-unknown-openbsd': - setTestOpts(expect_fail_for(['hpc','optasm','profasm','threaded2','profthreaded'])) - test('galois_raytrace', [extra_files(['CSG.hs', 'Construct.hs', 'Data.hs', 'Eval.hs', 'Geometry.hs', 'Illumination.hs', 'Intersections.hs', 'Interval.hs', 'Main.hs', 'Misc.hs', 'Parse.hs', 'Primitives.hs', 'Surface.hs', 'galois.gml']), when(fast(), skip)], multimod_compile_and_run, ['Main', '-package parsec']) ===================================== testsuite/tests/quotes/all.T ===================================== @@ -15,7 +15,7 @@ test('T8633', normal, compile_and_run, ['']) test('T8759a', normal, compile, ['-v0']) test('T9824', normal, compile, ['-v0']) test('T10384', normal, compile_fail, ['']) -test('T16384', normal, compile, ['']) +test('T16384', requires_th, compile, ['']) test('TH_tf2', normal, compile, ['-v0']) test('TH_ppr1', normal, compile_and_run, ['']) ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,4 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) -test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T16718', requires_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -73,7 +73,7 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 test('T2783', [ omit_ways(['ghci']), exit_code(1) - , expect_broken_for(2783, ['threaded1']) + , fragile_for(2783, ['threaded1']) ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in @@ -93,7 +93,7 @@ test('stack002', [extra_files(['stack001.hs']), # run this test with very small stack chunks to exercise the stack # overflow/underflow machinery. -test('stack003', [ omit_ways('ghci'), # uses unboxed tuples +test('stack003', [ omit_ways(['ghci']), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) @@ -214,7 +214,8 @@ test('T7815', [ multi_cpu_race, test('ffishutdown', [ignore_stderr, only_ways(['threaded1','threaded2'])], compile_and_run, ['']) -test('T7919', [when(fast(), skip), omit_ways(prof_ways)], compile_and_run, +# Times out in ghci way +test('T7919', [when(fast(), skip), omit_ways(['ghci'] + prof_ways)], compile_and_run, [config.ghc_th_way_flags]) test('T8035', normal, compile_and_run, ['']) ===================================== testsuite/tests/th/all.T ===================================== @@ -13,7 +13,7 @@ if config.have_ext_interp : setTestOpts(extra_ways(['ext-interp'])) setTestOpts(only_ways(['normal','ghci','ext-interp'])) -broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] +broken_tests = ["ClosedFam1TH","T10620","T10828","T11721_TH","T11797","T12045TH2","T12478_1","T12646","T13642","T14060","T15502","T15738","T15792","T15845","T16180","T1835","T3920","T4135","T4188","T5037","T5362","T7477","T7910","T8761","T8884","T8953","T9262","T9692","T9738","TH_Lift","TH_RichKinds","TH_RichKinds2","TH_Roles3","TH_TyInstWhere2","TH_implicitParams","TH_recursiveDo","TH_reifyDecl1","TH_reifyExplicitForAllFams","TH_reifyInstances","TH_reifyMkName","TH_repE2","TH_repGuard","TH_repPrim","TH_repPrim2","TH_repUnboxedTuples","TH_spliceE6","T16326_TH"] # ext-interp, integer-gmp and llvm is broken see #16087 def broken_ext_interp(name, opts): if name in broken_tests and config.ghc_built_by_llvm: @@ -467,7 +467,10 @@ test('T15437', expect_broken(15437), multimod_compile, test('T15985', normal, compile, ['']) test('T16133', normal, compile_fail, ['']) test('T15471', normal, multimod_compile, ['T15471.hs', '-v0']) -test('T16180', normal, compile_and_run, ['']) +test('T16180', + [when(llvm_build(), expect_broken_for(16541, ['ext-interp'])), + expect_broken_for(16541, ['ghci'])], + compile_and_run, ['-package ghc']) test('T16183', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T16195', normal, multimod_compile, ['T16195.hs', '-v0']) test('T16293b', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -659,7 +659,7 @@ test('T15586', normal, compile, ['']) test('T15368', normal, compile, ['-fdefer-type-errors']) test('T15645', normal, compile, ['-Wwarn=missing-monadfail-instances']) test('T15778', normal, compile, ['']) -test('T14761c', normal, compile, ['']) +test('T14761c', expect_broken_for(16540, ['hpc', 'profasm', 'optasm']), compile, ['']) test('T16008', normal, compile, ['']) test('T16033', normal, compile, ['']) test('T16141', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -35,7 +35,7 @@ test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) test('tcrun021', normal, compile_and_run, ['-package containers']) -test('tcrun022', omit_ways(['ghci']), compile_and_run, ['-O']) +test('tcrun022', omit_ways(['hpc', 'ghci']), compile_and_run, ['-O']) test('tcrun023', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O']) test('tcrun024', normal, compile_and_run, ['-O']) @@ -96,7 +96,7 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('T7861', [omit_ways('debug'), exit_code(1)], compile_and_run, ['']) +test('T7861', [omit_ways(['debug']), exit_code(1)], compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) test('TcTypeSymbolSimpleRun', normal, compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) ===================================== testsuite/tests/utils/should_run/all.T ===================================== @@ -1,6 +1,6 @@ test('T14854', [only_ways(threaded_ways), - omit_ways('ghci'), + omit_ways(['ghci']), reqlib('random'), ignore_stderr], compile_and_run, ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -26,4 +26,4 @@ test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T1655 test('StarBinder', normal, compile, ['']) -test('Overflow', normal, compile, ['']) +test('Overflow', expect_broken_for(16543, ['hpc']), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4325cce5b7c06788a8ddf30793c0fb0aa8c8fb1b...edda3103b6a6284aff12f041c640313c2222cc13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4325cce5b7c06788a8ddf30793c0fb0aa8c8fb1b...edda3103b6a6284aff12f041c640313c2222cc13 You're receiving 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 Jun 11 20:50:35 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 16:50:35 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] 13 commits: base: Mark CPUTime001 as fragile Message-ID: <5d00141b30097_6f7e29d20022882fc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: 1a3420ca by Ben Gamari at 2019-06-10T11:59:41Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. - - - - - 9bc10993 by Vladislav Zavialov at 2019-06-10T12:00:16Z Print role annotations in TemplateHaskell brackets (#16718) - - - - - 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - c276f6aa by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Skip dynamicToo006 when dynamic linking is not available This was previously failling on Windows. - - - - - 97d866c2 by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Mark T3372 as fragile on Windows On Windows we must lock package databases even when opening for read-only access. This means that concurrent GHC sessions are very likely to fail with file lock contention. See #16773. - - - - - 1aa98890 by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Add stderr output for UnsafeInfered02 on Windows This test uses TemplateHaskell causing GHC to build dynamic objects on platforms where dynamic linking is available. However, Windows doesn't support dynamic linking. Consequently the test would fail on Windows with: ```patch --- safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.stderr.normalised 2019-06-04 15:10:10.521594200 +0000 +++ safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.comp.stderr.normalised 2019-06-04 15:10:10.523546200 +0000 @@ -1,5 +1,5 @@ -[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o, UnsafeInfered02_A.dyn_o ) -[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o, UnsafeInfered02.dyn_o ) +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) UnsafeInfered02.hs:4:1: UnsafeInfered02_A: Can't be safely imported! ``` The other approach I considered for this issue is to pass `-v0` to GHC. However, I felt we should probably do this consistently for all of the tests in this directory and this would take more time than I currently have. - - - - - b6e3234e by Ben Gamari at 2019-06-11T20:50:24Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 10677290 by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - b6378114 by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Mark T7170 as broken on Windows Due to #16801. - - - - - 8f0f3f0a by Ben Gamari at 2019-06-11T20:50:24Z testsuite: Mark T7702 as broken on Windows Due to #16799. - - - - - 20 changed files: - .gitlab-ci.yml - compiler/basicTypes/MkId.hs - compiler/hsSyn/HsDecls.hs - hadrian/src/Rules/Compile.hs - libraries/base/tests/all.T - libraries/ghc-boot/GHC/PackageDb.hs - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - testsuite/tests/driver/dynamicToo/dynamicToo006/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/ghci/linking/dyn/all.T - + testsuite/tests/roles/should_compile/T16718.hs - + testsuite/tests/roles/should_compile/T16718.stderr - testsuite/tests/roles/should_compile/all.T - + testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr-mingw32 - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/th/T15365.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -654,8 +654,6 @@ nightly-i386-windows-hadrian: .build-windows-make: extends: .build-windows stage: full-build - # due to #16084 - allow_failure: true variables: BUILD_FLAVOUR: "quick" GHC_VERSION: "8.6.5" ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== compiler/hsSyn/HsDecls.hs ===================================== @@ -302,6 +302,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where if isEmptyValBinds val_decls then Nothing else Just (ppr val_decls), + ppr_ds (tyClGroupRoleDecls tycl_decls), ppr_ds (tyClGroupTyClDecls tycl_decls), ppr_ds (tyClGroupInstDecls tycl_decls), ppr_ds deriv_decls, ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), ===================================== libraries/ghc-boot/GHC/PackageDb.hs ===================================== @@ -387,6 +387,8 @@ decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock) decodeFromFile file mode decoder = case mode of DbOpenReadOnly -> do + -- Note [Locking package database on Windows] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- When we open the package db in read only mode, there is no need to acquire -- shared lock on non-Windows platform because we update the database with an -- atomic rename, so readers will always see the database in a consistent ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + ===================================== testsuite/tests/driver/dynamicToo/dynamicToo006/all.T ===================================== @@ -1,2 +1,3 @@ -test('dynamicToo006', [normalise_slashes, extra_files(['Main.hs'])], +test('dynamicToo006', + [normalise_slashes, extra_files(['Main.hs']), unless(have_dynamic(), skip)], run_command, ['$MAKE -s main --no-print-director']) ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -169,7 +169,9 @@ test('ffi_parsing_001', [omit_ways(['ghci'])], compile_and_run, test('capi_value', [omit_ways(['ghci'])], compile_and_run, ['capi_value_c.c']) -test('T7170', exit_code(1), compile_and_run, ['']) +test('T7170', + [when(opsys('mingw32'), expect_broken(16801)], + exit_code(1)], compile_and_run, ['']) test('T4012', [expect_broken_for(7388, ['ghci'])], multimod_compile_and_run, ['T4012', '']) ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -9,6 +9,7 @@ test('PartialDownsweep', test('OldModLocation', [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('mingw32'), expect_broken(16772)) ], compile_and_run, ['-package ghc']) ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -45,5 +45,11 @@ test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['big-obj']) -test('T3372', [unless(doing_ghci, skip), extra_run_opts('"' + config.libdir + '"')], +test('T3372', + [unless(doing_ghci, skip), + extra_run_opts('"' + config.libdir + '"'), + # Concurrent GHC sessions is fragile on Windows since we must lock the + # package database even for read-only access. + # See Note [Locking package database on Windows] in GHC.PackageDb + when(opsys('mingw32'), fragile(16773))], compile_and_run, ['-package ghc']) ===================================== testsuite/tests/roles/should_compile/T16718.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE RoleAnnotations, TemplateHaskell #-} + +module T16718 where + +$([d| type role P phantom + data P a + |]) ===================================== testsuite/tests/roles/should_compile/T16718.stderr ===================================== @@ -0,0 +1,7 @@ +T16718.hs:(5,3)-(7,6): Splicing declarations + [d| type role P phantom + + data P a |] + ======> + type role P phantom + data P a ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,3 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) +test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr-mingw32 ===================================== @@ -0,0 +1,7 @@ +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) + +UnsafeInfered02.hs:4:1: error: + UnsafeInfered02_A: Can't be safely imported! + The module itself isn't safe. + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -144,6 +144,7 @@ test('T7702', # a large effect on allocation which is hard to separate from the # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), + when(opsys('mingw'), expect_broken_for(16799, ['normal'])) ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) ===================================== testsuite/tests/th/T15365.stderr ===================================== @@ -4,6 +4,8 @@ T15365.hs:(9,3)-(31,6): Splicing declarations pattern (:!!!) :: Bool pattern (:!!!) = True + type role (***) + type (|||) = Either data (***) class (???) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5f631f7b24dcbadf16af7a7097aee4ef911344bb...8f0f3f0aed918000cd0d82f65579e5244db8033d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5f631f7b24dcbadf16af7a7097aee4ef911344bb...8f0f3f0aed918000cd0d82f65579e5244db8033d You're receiving 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 Jun 11 21:12:02 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:12:02 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5d001922d68a9_6f7d5d22642289097@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 7bebe0ad by Ben Gamari at 2019-06-11T21:11:50Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 5 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,26 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py']), + when(opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.bat')), + when(not opsys('mingw32'), + extra_compile_opts('-F -pgmF ./enum_processor.py')) + ], + compile_and_run, + ['']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7bebe0adcdb1aed857b954f09ca77f022c469f2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7bebe0adcdb1aed857b954f09ca77f022c469f2e You're receiving 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 Jun 11 21:24:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:24:54 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 11 commits: Comments only: document newtypes' DataConWrapId Message-ID: <5d001c26baae6_6f73fe60d0b2a38228987d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z Comments only: document newtypes' DataConWrapId - - - - - 58a5d728 by David Eichmann at 2019-06-11T03:52:50Z Refactor the rules for .hi and .o into a single rule using `&%>` #16764 Currently the rule for .hi files just triggers (via need) the rule for the .o file, and .o rule generates both the .o and .hi file. Likewise for .o-boot and .hi-boot files. This is a bit of an abuse of Shake, and in fact shake supports rules with multiple output with the &%> function. This exact use case appears in Neil Mitchell's paper *Shake Before Building* section 6.3. - - - - - 2f945086 by Ben Gamari at 2019-06-11T03:53:25Z testsuite: Fix and extend closure_size test This was previously broken in several ways. This is fixed and it also now tests arrays. Unfortunately I was unable to find a way to continue testing PAP and FUN sizes; these simply depend too much upon the behavior of the simplifier. I also tried to extend this to test non-empty arrays as well but unfortunately this was non-trivial as the array card size constant isn't readily available from haskell. Fixes #16531. - - - - - e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z ghc-heap: Add closure_size_noopt test This adds a new test, only run in the `normal` way, to verify the size of FUNs and PAPs. - - - - - e7d9cd0a by Ben Gamari at 2019-06-11T21:24:43Z gitlab-ci: Build alpine release bindists - - - - - aa4f1c89 by Ben Gamari at 2019-06-11T21:24:43Z base/Event/Poll: Drop POLLRDHUP enum item Previously the Event enumeration produced by hsc2hs would sometimes include a currently-unused POLLRDHUP item. This unused binding would result in a build failure. Drop it. - - - - - 61a14107 by Ben Gamari at 2019-06-11T21:24:43Z testsuite: Fix T8602 on musl Musl wants hash-bangs on all executables. - - - - - c9b62b9f by Ben Gamari at 2019-06-11T21:24:44Z testsuite: Ensure T5423 flushes C output buffer Previously T5423 would fail to flush the printf output buffer. Consequently it was platform-dependent whether the C or Haskell print output would be emitted first. - - - - - 4c0fdac0 by Ben Gamari at 2019-06-11T21:24:44Z testsuite: Flush conc059's printf buffer Otherwise it the order out the Haskell and C output will be system-dependent. - - - - - 1b181cdb by Ben Gamari at 2019-06-11T21:24:44Z testsuite: Ensure that ffi005 output order is predictable The libc output buffer wasn't being flushed, making the order system-depedent. - - - - - 915a7042 by Ben Gamari at 2019-06-11T21:24:44Z XXX: Test alpine job - - - - - 14 changed files: - .gitlab-ci.yml - compiler/basicTypes/MkId.hs - hadrian/src/Rules/Compile.hs - libraries/base/GHC/Event/Poll.hsc - + libraries/ghc-heap/tests/ClosureSizeUtils.hs - libraries/ghc-heap/tests/all.T - libraries/ghc-heap/tests/closure_size.hs - + libraries/ghc-heap/tests/closure_size_noopt.hs - testsuite/tests/concurrent/should_run/conc059.stdout - testsuite/tests/concurrent/should_run/conc059_c.c - testsuite/tests/driver/T8602/T8602.script - testsuite/tests/ffi/should_run/ffi005.hs - testsuite/tests/rts/T5423.stdout - testsuite/tests/rts/T5423_cmm.cmm 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 6bcca6969aece60c4fc7aef2d17053146eda100e # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the predicate (C a). But now we treat that as an ordinary argument, not part of the theta-type, so all is well. +Note [Newtype workers] +~~~~~~~~~~~~~~~~~~~~~~ +A newtype does not really have a worker. Instead, newtype constructors +just unfold into a cast. But we need *something* for, say, MkAge to refer +to. So, we do this: + +* The Id used as the newtype worker will have a compulsory unfolding to + a cast. See Note [Compulsory newtype unfolding] + +* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId, + as those have special treatment in the back end. + +* There is no top-level binding, because the compulsory unfolding + means that it will be inlined (to a cast) at every call site. + +We probably should have a NewtypeWorkId, but these Ids disappear as soon as +we desugar anyway, so it seems a step too far. + Note [Compulsory newtype unfolding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Newtype wrappers, just like workers, have compulsory unfoldings. @@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con | isNewTyCon tycon = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info + -- See Note [Newtype workers] + | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info ===================================== hadrian/src/Rules/Compile.hs ===================================== @@ -4,7 +4,7 @@ import Hadrian.BuildPath import Hadrian.Oracles.TextFile import Base -import Context +import Context as C import Expression import Rules.Generate import Settings @@ -30,16 +30,29 @@ compilePackage rs = do -- -- and parse the information we need (stage, package path, ...) from -- the path and figure out the suitable way to produce that object file. - objectFilesUnder root |%> \path -> do - obj <- parsePath (parseBuildObject root) "" path - compileObject rs path obj + alternatives $ do + -- Language is identified by subdirectory under /build. + -- These are non-haskell files so only have a .o or ._o suffix. + [ root -/- "**/build/c/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs C + + [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Cmm + + [ root -/- "**/build/s/**/*." ++ wayPat ++ "o" + | wayPat <- wayPats] |%> compileNonHsObject rs Asm + + -- All else is haskell. + -- This comes last as it overlaps with the above rules' file patterns. + forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) -> + [ root -/- "**/build/**/*." ++ wayPat ++ oExt + , root -/- "**/build/**/*." ++ wayPat ++ hiExt ] + &%> \ [o, _hi] -> compileHsObjectAndHi rs o where - objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat) - | pat <- extensionPats ] - - exts = [ "o", "hi", "o-boot", "hi-boot" ] - patternsFor e = [ "." ++ e, ".*_" ++ e ] - extensionPats = concatMap patternsFor exts + hsExts = [ ("o", "hi") + , ("o-boot", "hi-boot") + ] + wayPats = [ "", "*_" ] -- * Object file paths types and parsers @@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) = -- * Building an object -compileHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action () -compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj = - case hsobj of - HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way] - HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way] - HsObject _basename (Extension way suf) -> do - let ctx = objectContext b - ctxPath <- contextPath ctx - (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath - need (src:deps) - needLibrary =<< contextDependencies ctx - - -- The .dependencies files only lists shallow dependencies. ghc will - -- generally read more *.hi and *.hi-boot files (deep dependencies). - -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build) - -- Note that this may allow too many *.hi and *.hi-boot files, but - -- calculating the exact set of deep dependencies is not feasible. - trackAllow [ "//*." ++ hisuf way - , "//*." ++ hibootsuf way - ] - - buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] - -- Andrey: It appears that the previous refactoring has broken - -- multiple-output build rules. Ideally, we should bring multiple-output - -- rules back, see: https://github.com/snowleopard/hadrian/issues/216. - -- As a temporary solution, I'm using Shake's new 'produces' feature to - -- record that this rule also produces a corresponding interface file. - let hi | suf == O = objpath -<.> hisuf way - | suf == OBoot = objpath -<.> hibootsuf way - | otherwise = error "Internal error: unknown Haskell object extension" - produces [hi] - -compileNonHsObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject - -> Action () -compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj = - case nonhsobj of - NonHsObject lang _basename _way -> - go (builderFor lang) (toSrcFor lang) - - where builderFor C = Ghc CompileCWithGhc - builderFor _ = Ghc CompileHs - - toSrcFor Asm = obj2src "S" (const False) - toSrcFor C = obj2src "c" (const False) - toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile - - go builder tosrc = do - let ctx = objectContext b - src <- tosrc ctx objpath - need [src] - needDependencies ctx src (objpath <.> "d") - buildWithResources rs $ target ctx (builder stage) [src] [objpath] - -compileObject - :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action () -compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) = - compileHsObject rs objpath b o -compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) = - compileNonHsObject rs objpath b o +compileHsObjectAndHi + :: [(Resource, Int)] -> FilePath -> Action () +compileHsObjectAndHi rs objpath = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" objpath + let ctx = objectContext b + way = C.way ctx + ctxPath <- contextPath ctx + (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath + need (src:deps) + needLibrary =<< contextDependencies ctx + + -- The .dependencies file lists indicating inputs. ghc will + -- generally read more *.hi and *.hi-boot files (direct inputs). + -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs) + -- Note that this may allow too many *.hi and *.hi-boot files, but + -- calculating the exact set of direct inputs is not feasible. + trackAllow [ "//*." ++ hisuf way + , "//*." ++ hibootsuf way + ] + + buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath] + +compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action () +compileNonHsObject rs lang path = do + root <- buildRoot + b@(BuildPath _root stage _path _o) + <- parsePath (parseBuildObject root) "" path + let + ctx = objectContext b + builder = case lang of + C -> Ghc CompileCWithGhc + _ -> Ghc CompileHs + src <- case lang of + Asm -> obj2src "S" (const False) ctx path + C -> obj2src "c" (const False) ctx path + Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path + need [src] + needDependencies ctx src (path <.> "d") + buildWithResources rs $ target ctx (builder stage) [src] [path] -- * Helpers ===================================== libraries/base/GHC/Event/Poll.hsc ===================================== @@ -162,24 +162,12 @@ newtype Event = Event CShort , FiniteBits -- ^ @since 4.7.0.0 ) --- We have to duplicate the whole enum like this in order for the --- hsc2hs cross-compilation mode to work -#if defined(POLLRDHUP) #{enum Event, Event , pollIn = POLLIN , pollOut = POLLOUT - , pollRdHup = POLLRDHUP , pollErr = POLLERR , pollHup = POLLHUP } -#else -#{enum Event, Event - , pollIn = POLLIN - , pollOut = POLLOUT - , pollErr = POLLERR - , pollHup = POLLHUP - } -#endif fromEvent :: E.Event -> Event fromEvent e = remap E.evtRead pollIn .|. ===================================== libraries/ghc-heap/tests/ClosureSizeUtils.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Utilities for the @closure_size@ tests +module ClosureSizeUtils (assertSize, assertSizeUnlifted) where + +import Control.Monad +import GHC.Exts +import GHC.Exts.Heap.Closures +import GHC.Stack +import Type.Reflection + +profHeaderSize :: Int +#if PROFILING +profHeaderSize = 2 +#else +profHeaderSize = 0 +#endif + +assertSize + :: forall a. (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSize x = + assertSizeBox (asBox x) (typeRep @a) + +assertSizeUnlifted + :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a) + => a -- ^ closure + -> Int -- ^ expected size in words + -> IO () +assertSizeUnlifted x = + assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a) + +assertSizeBox + :: forall a. (HasCallStack) + => Box -- ^ closure + -> TypeRep a + -> Int -- ^ expected size in words + -> IO () +assertSizeBox x ty expected = do + let !size = closureSize x + when (size /= expected') $ do + putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected' + putStrLn $ prettyCallStack callStack + where expected' = expected + profHeaderSize +{-# NOINLINE assertSize #-} ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -1,11 +1,26 @@ test('heap_all', - [when(have_profiling(), - extra_ways(['prof'])), + [when(have_profiling(), extra_ways(['prof'])), # These ways produce slightly different heap representations. # Currently we don't test them. omit_ways(['ghci', 'hpc']) ], compile_and_run, ['']) + +# Test everything except FUNs and PAPs in all ways. test('closure_size', - omit_ways(['ghci', 'hpc', 'prof']), + [extra_files(['ClosureSizeUtils.hs']), + when(have_profiling(), extra_ways(['prof'])), + # These ways produce slightly different heap representations. + # Currently we don't test them. + omit_ways(['hpc']) + ], + compile_and_run, ['']) + +# Test PAPs and FUNs only in normal way (e.g. with -O0) +# since otherwise the simplifier interferes. +test('closure_size_noopt', + [extra_files(['ClosureSizeUtils.hs']), + only_ways(['normal']) + ], compile_and_run, ['']) + ===================================== libraries/ghc-heap/tests/closure_size.hs ===================================== @@ -1,25 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad -import Type.Reflection -import GHC.Stack +import GHC.Exts +import GHC.IO +import ClosureSizeUtils -import GHC.Exts.Heap.Closures +data A = A (Array# Int) +data MA = MA (MutableArray# RealWorld Int) +data BA = BA ByteArray# +data MBA = MBA (MutableByteArray# RealWorld) +data B = B BCO# +data APC a = APC a -assertSize :: forall a. (HasCallStack, Typeable a) - => a -> Int -> IO () -assertSize !x expected = do - let !size = closureSize (asBox x) - when (size /= expected) $ do - putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected - putStrLn $ prettyCallStack callStack -{-# NOINLINE assertSize #-} - -pap :: Int -> Char -> Int -pap x _ = x -{-# NOINLINE pap #-} main :: IO () main = do @@ -28,7 +23,26 @@ main = do assertSize (Nothing :: Maybe ()) 2 assertSize ((1,2) :: (Int,Int)) 3 assertSize ((1,2,3) :: (Int,Int,Int)) 4 - assertSize (id :: Int -> Int) 1 - assertSize (fst :: (Int,Int) -> Int) 1 - assertSize (pap 1) 2 + MA ma <- IO $ \s -> + case newArray# 0# 0 s of + (# s1, x #) -> (# s1, MA x #) + + A a <- IO $ \s -> + case freezeArray# ma 0# 0# s of + (# s1, x #) -> (# s1, A x #) + + MBA mba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> (# s1, MBA x #) + + BA ba <- IO $ \s -> + case newByteArray# 0# s of + (# s1, x #) -> + case unsafeFreezeByteArray# x s1 of + (# s2, y #) -> (# s2, BA y #) + + assertSizeUnlifted ma 3 + assertSizeUnlifted a 3 + assertSizeUnlifted mba 2 + assertSizeUnlifted ba 2 ===================================== libraries/ghc-heap/tests/closure_size_noopt.hs ===================================== @@ -0,0 +1,12 @@ +import ClosureSizeUtils + +pap :: Int -> Char -> Int +pap x _ = x +{-# NOINLINE pap #-} + +main :: IO () +main = do + assertSize (id :: Int -> Int) 1 + assertSize (fst :: (Int,Int) -> Int) 1 + assertSize (pap 1) 2 + ===================================== testsuite/tests/concurrent/should_run/conc059.stdout ===================================== @@ -1,3 +1,3 @@ -500000 exiting... +500000 exited. ===================================== testsuite/tests/concurrent/should_run/conc059_c.c ===================================== @@ -16,6 +16,7 @@ int main(int argc, char *argv[]) usleep(100000); #endif printf("exiting...\n"); + fflush(stdout); hs_exit(); printf("exited.\n"); #if mingw32_HOST_OS ===================================== testsuite/tests/driver/T8602/T8602.script ===================================== @@ -1,3 +1,4 @@ -:! echo 'echo $4 $5 $6; exit 1' > t8602.sh +:! echo '#!/bin/sh' > t8602.sh +:! echo 'echo $4 $5 $6; exit 1' >> t8602.sh :! chmod +x t8602.sh :load A ===================================== testsuite/tests/ffi/should_run/ffi005.hs ===================================== @@ -21,6 +21,7 @@ main = do putStrLn "\nTesting puts (and withString)" withCString "Test successful" puts + c_fflush c_stdout putStrLn "\nTesting peekArray0" s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0')) @@ -71,6 +72,8 @@ withBuffer sz m = do return s foreign import ccall puts :: CString -> IO CInt +foreign import ccall "fflush" c_fflush :: Ptr () -> IO CInt +foreign import ccall "stdio.h stdout" c_stdout :: Ptr () -- foreign import ccall "open" open' :: CString -> CInt -> IO CInt -- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt ===================================== testsuite/tests/rts/T5423.stdout ===================================== @@ -1,2 +1,2 @@ -120 111 112 113 114 115 116 117 118 119 120 +120 ===================================== testsuite/tests/rts/T5423_cmm.cmm ===================================== @@ -12,5 +12,6 @@ test (W_ r1, { foreign "C" printf("%d %d %d %d %d %d %d %d %d %d\n", r1, r2, r3, r4, r5, r6, r7, r8, r9, r10); + foreign "C" fflush(W_[stdout]); return (r10); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6...915a704255539d70e975af4bf46523ef5e6479c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6...915a704255539d70e975af4bf46523ef5e6479c6 You're receiving 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 Jun 11 21:29:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:29:29 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5d001d39a068e_6f73fe6149274782292633@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 0e531977 by Ben Gamari at 2019-06-11T21:29:21Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 5 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,27 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + if opsys('mingw32'): + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.bat']) + else: + test(name, + [extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.py']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e53197760818fa8dc46533c82cd8a6ac616b89a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0e53197760818fa8dc46533c82cd8a6ac616b89a You're receiving 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 Jun 11 21:30:15 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:30:15 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5d001d6769773_6f73fe597a4cc042293224@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 21299d29 by Ben Gamari at 2019-06-11T21:30:08Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 6 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat - libraries/base/tests/enum_processor.py Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,27 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + if opsys('mingw32'): + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.bat']) + else: + test(name, + [extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.py']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* ===================================== libraries/base/tests/enum_processor.py ===================================== @@ -1,3 +1,5 @@ +#!/usr/bin/env python + # The rough equivalent of the traditional CPP: # #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) # which is not portable to clang. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/21299d29a161bd5f0b236c156946a28bbc1794cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/21299d29a161bd5f0b236c156946a28bbc1794cd You're receiving 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 Jun 11 21:31:08 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:31:08 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5d001d9c6ab56_6f73fe61e5d755c2294415@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 9a841f70 by Ben Gamari at 2019-06-11T21:30:59Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 6 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat - libraries/base/tests/enum_processor.py Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,27 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + if opsys('mingw32'): + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.bat']) + else: + test(name, + [extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.py']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* ===================================== libraries/base/tests/enum_processor.py ===================================== @@ -1,3 +1,5 @@ +#!/usr/bin/env python + # The rough equivalent of the traditional CPP: # #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) # which is not portable to clang. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a841f70d308e9f699fb3e33f032e3b145a9c0b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a841f70d308e9f699fb3e33f032e3b145a9c0b0 You're receiving 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 Jun 11 21:31:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:31:50 -0400 Subject: [Git][ghc/ghc][wip/T16798] testsuite: A more portable solution to #9399 Message-ID: <5d001dc6dfe8d_6f73fe597a4cc04229525b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16798 at Glasgow Haskell Compiler / GHC Commits: 43fd712b by Ben Gamari at 2019-06-11T21:31:43Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 6 changed files: - libraries/base/tests/all.T - libraries/base/tests/enum01.hs - libraries/base/tests/enum02.hs - libraries/base/tests/enum03.hs - libraries/base/tests/enum_processor.bat - libraries/base/tests/enum_processor.py Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -94,13 +94,27 @@ test('dynamic004', omit_ways(['normal', 'threaded1', 'ghci']), compile_and_ test('dynamic005', normal, compile_and_run, ['']) enum_setups = [when(fast(), skip)] -test('enum01', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum02', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum03', [extra_files(['enum_processor.bat', 'enum_processor.py']), - enum_setups], compile_and_run, ['']) -test('enum04', normal, compile_and_run, ['']) +def enum_test(name): + """ + These tests have a funky Python preprocessor which require some headstands + to run on Windows. + """ + if opsys('mingw32'): + test(name, + [when(opsys('mingw32'), extra_files(['enum_processor.bat'])), + extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.bat']) + else: + test(name, + [extra_files(['enum_processor.py'])], + compile_and_run, + ['-F -pgmF ./enum_processor.py']) + +enum_test('enum01') +enum_test('enum02') +enum_test('enum03') +test('enum04', normal, compile_and_run, ['']) test('exceptionsrun001', normal, compile_and_run, ['']) test('exceptionsrun002', normal, compile_and_run, ['']) ===================================== libraries/base/tests/enum01.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Prelude's Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum02.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Int Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum03.hs ===================================== @@ -1,8 +1,4 @@ -- !!! Testing the Word Enum instances. -{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-} --- The processor is a non-CPP-based equivalent of --- #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) --- which is not portable to clang module Main(main) where ===================================== libraries/base/tests/enum_processor.bat ===================================== @@ -1,11 +1,5 @@ :;# Problem: GHC on Windows doesn't like '-pgmF ./enum_processor.py'. :;# See ticket:365#comment:7 for details. :;# -:;# Workaround: this file, which functions both as a Windows .bat script and a -:;# Unix shell script. Hacky, but it seems to work. -:;# Starts with a ':', to skip on Windows. -:; "${PYTHON}" enum_processor.py $@; exit $? - -:;# Windows only: %PYTHON% enum_processor.py %* ===================================== libraries/base/tests/enum_processor.py ===================================== @@ -1,3 +1,5 @@ +#!/usr/bin/env python3 + # The rough equivalent of the traditional CPP: # #define printTest(x) (do{ putStr ( " " ++ "x" ++ " = " ) ; print (x) }) # which is not portable to clang. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/43fd712b4f679fe00d6d75c8bc088357052a0365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/43fd712b4f679fe00d6d75c8bc088357052a0365 You're receiving 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 Jun 11 21:49:04 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 17:49:04 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 2 commits: testsuite: Ensure that ffi005 output order is predictable Message-ID: <5d0021d068beb_6f7e29d20023009c1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: e8e0e7c8 by Ben Gamari at 2019-06-11T21:48:57Z testsuite: Ensure that ffi005 output order is predictable The libc output buffer wasn't being flushed, making the order system-depedent. - - - - - 6f12aa63 by Ben Gamari at 2019-06-11T21:48:57Z XXX: Test alpine job - - - - - 5 changed files: - .gitlab-ci.yml - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi005.hs - testsuite/tests/ffi/should_run/ffi005.stdout - + testsuite/tests/ffi/should_run/ffi005_c.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -541,7 +541,7 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: extends: .validate-linux - stage: full-build + stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" variables: BUILD_SPHINX_PDF: "NO" @@ -549,8 +549,6 @@ release-x86_64-linux-alpine: BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - only: - - tags cache: key: linux-x86_64-alpine artifacts: ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -32,7 +32,7 @@ test('ffi005', [ omit_ways(prof_ways), when(arch('i386'), skip), when(platform('i386-apple-darwin'), expect_broken(4105)), exit_code(3) ], - compile_and_run, ['']) + compile_and_run, ['ffi005_c.c']) test('ffi006', normal, compile_and_run, ['']) ===================================== testsuite/tests/ffi/should_run/ffi005.hs ===================================== @@ -20,10 +20,12 @@ main = do -- putStrLn $ "errno == " ++ show err putStrLn "\nTesting puts (and withString)" - withCString "Test successful" puts + hFlush stdout + withCString "Test puts successful" puts + flushStdout -- Flush the libc output buffer putStrLn "\nTesting peekArray0" - s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0')) + s <- withCString "Test peekArray0 successful" (peekArray0 (castCharToCChar '\0')) putStr (map castCCharToChar s) -- disabled due to use of non-portable constants in arguments to open: @@ -71,6 +73,7 @@ withBuffer sz m = do return s foreign import ccall puts :: CString -> IO CInt +foreign import ccall "flush_stdout" flushStdout :: IO () -- foreign import ccall "open" open' :: CString -> CInt -> IO CInt -- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt ===================================== testsuite/tests/ffi/should_run/ffi005.stdout ===================================== @@ -3,9 +3,10 @@ Testing sin==mysin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] Testing puts (and withString) +Test puts successful Testing peekArray0 -Test successful +Test peekArray0 successful Testing sin==dynamic_sin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] @@ -16,4 +17,3 @@ Testing sin==Id wrapped_sin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] Testing exit -Test successful ===================================== testsuite/tests/ffi/should_run/ffi005_c.c ===================================== @@ -0,0 +1,5 @@ +#include +void flush_stdout(void) +{ + fflush(stdout); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/915a704255539d70e975af4bf46523ef5e6479c6...6f12aa63c67f8d252f0ad0487a031abb01beadc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/915a704255539d70e975af4bf46523ef5e6479c6...6f12aa63c67f8d252f0ad0487a031abb01beadc6 You're receiving 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 Jun 11 22:40:03 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:40:03 -0400 Subject: [Git][ghc/ghc][master] Warn about unused packages Message-ID: <5d002dc3abc7_6f73fe597a4cc0423116e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 7 changed files: - compiler/main/DynFlags.hs - compiler/main/GhcMake.hs - docs/users_guide/8.8.1-notes.rst - docs/users_guide/using-warnings.rst - + testsuite/tests/warnings/should_compile/UnusedPackages.hs - + testsuite/tests/warnings/should_compile/UnusedPackages.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/main/DynFlags.hs ===================================== @@ -911,6 +911,7 @@ data WarningFlag = | Opt_WarnSpaceAfterBang | Opt_WarnMissingDerivingStrategies -- Since 8.8 | Opt_WarnPrepositiveQualifiedModule -- Since TBD + | Opt_WarnUnusedPackages -- Since 8.10 deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -4110,7 +4111,8 @@ wWarningFlagsDeps = [ flagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang, flagSpec "partial-fields" Opt_WarnPartialFields, flagSpec "prepositive-qualified-module" - Opt_WarnPrepositiveQualifiedModule + Opt_WarnPrepositiveQualifiedModule, + flagSpec "unused-packages" Opt_WarnUnusedPackages ] -- | These @-\@ flags can all be reversed with @-no-\@ ===================================== compiler/main/GhcMake.hs ===================================== @@ -267,7 +267,75 @@ data LoadHowMuch load :: GhcMonad m => LoadHowMuch -> m SuccessFlag load how_much = do mod_graph <- depanal [] False - load' how_much (Just batchMsg) mod_graph + success <- load' how_much (Just batchMsg) mod_graph + warnUnusedPackages + pure success + +-- Note [Unused packages] +-- +-- Cabal passes `--package-id` flag for each direct dependency. But GHC +-- loads them lazily, so when compilation is done, we have a list of all +-- actually loaded packages. All the packages, specified on command line, +-- but never loaded, are probably unused dependencies. + +warnUnusedPackages :: GhcMonad m => m () +warnUnusedPackages = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + + let dflags = hsc_dflags hsc_env + pit = eps_PIT eps + + let loadedPackages + = map (getPackageDetails dflags) + . nub . sort + . map moduleUnitId + . moduleEnvKeys + $ pit + + requestedArgs = mapMaybe packageArg (packageFlags dflags) + + unusedArgs + = filter (\arg -> not $ any (matching dflags arg) loadedPackages) + requestedArgs + + let warn = makeIntoWarning + (Reason Opt_WarnUnusedPackages) + (mkPlainErrMsg dflags noSrcSpan msg) + msg = hang + ( text "The following packages were specified " + <> text "via -package or -package-id flags, " + <> text "but were not needed for compilation: ") + 4 + (sep (map pprUnusedArg unusedArgs)) + + when (wopt Opt_WarnUnusedPackages dflags && not (null unusedArgs)) $ + logWarnings (listToBag [warn]) + + where + packageArg (ExposePackage _ arg _) = Just arg + packageArg _ = Nothing + + pprUnusedArg (PackageArg str) = text str + pprUnusedArg (UnitIdArg uid) = ppr uid + + matchingStr :: String -> PackageConfig -> Bool + matchingStr str p + = str == sourcePackageIdString p + || str == packageNameString p + + matching :: DynFlags -> PackageArg -> PackageConfig -> Bool + matching _ (PackageArg str) p = matchingStr str p + matching dflags (UnitIdArg uid) p = uid == realUnitId dflags p + + -- For wired-in packages, we have to unwire their id, + -- otherwise they won't match package flags + realUnitId :: DynFlags -> PackageConfig -> UnitId + realUnitId dflags + = unwireUnitId dflags + . DefiniteUnitId + . DefUnitId + . installedPackageConfigId -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally ===================================== docs/users_guide/8.8.1-notes.rst ===================================== @@ -102,6 +102,8 @@ Compiler - The :ghc-flag:`-Wcompat` warning group now includes :ghc-flag:`-Wstar-is-type`. +- New :ghc-flag:`-Wunused-packages` warning reports unused packages. + - The :ghc-flag:`-fllvm-pass-vectors-in-regs` flag is now deprecated as vector arguments are now passed in registers by default. ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1683,6 +1683,21 @@ of ``-W(no-)*``. data Foo = Foo { f :: Int } | Bar +.. ghc-flag:: -Wunused-packages + :shortdesc: warn when package is requested on command line, but was never loaded. + :type: dynamic + :reverse: -Wno-unused-packages + :category: + + :since: 8.8 + + The option :ghc-flag:`-Wunused-packages` warns about packages, specified on + command line via :ghc-flag:`-package` or :ghc-flag:`-package-id`, but were not + loaded during compication. Usually it means that you have an unused dependency. + + You may want to enable this warning on a clean build or enable :ghc-flag:`-fforce-recomp` + in order to get reliable results. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's sanity, not yours.) ===================================== testsuite/tests/warnings/should_compile/UnusedPackages.hs ===================================== @@ -0,0 +1,5 @@ +module Main +where + +main :: IO () +main = return () ===================================== testsuite/tests/warnings/should_compile/UnusedPackages.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 1] Compiling Main ( UnusedPackages.hs, UnusedPackages.o ) +Linking UnusedPackages ... + +: warning: [-Wunused-packages] + The following packages were specified via -package or -package-id flags, but were not needed for compilation: + bytestring ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -27,3 +27,5 @@ test('T16551', [extra_files(['T16551/'])], multimod_compile, ['T16551/A.hs T1655 test('StarBinder', normal, compile, ['']) test('Overflow', normal, compile, ['']) + +test('UnusedPackages', normal, multimod_compile, ['UnusedPackages.hs', '-package=bytestring -package=base -Wunused-packages']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fe7e7e4a950a77326cc16f4ade30a67d20d7cdd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fe7e7e4a950a77326cc16f4ade30a67d20d7cdd5 You're receiving 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 Jun 11 22:40:43 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:40:43 -0400 Subject: [Git][ghc/ghc][master] Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER Message-ID: <5d002deb59861_6f73fe61e5d755c23149c2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 17 changed files: - compiler/ghc.cabal.in - compiler/ghci/GHCi.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/rename/RnExpr.hs - compiler/simplCore/SimplCore.hs - compiler/typecheck/TcAnnotations.hs - compiler/typecheck/TcPluginM.hs - compiler/utils/Util.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/BreakArray.hs - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/ghci.cabal.in - testsuite/tests/codeGen/should_compile/jmp_tbl.hs - utils/ghc-in-ghci/settings.ghci Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -25,6 +25,11 @@ Flag ghci Default: False Manual: True +Flag ext-interp + Description: Support external interpreter + Default: True + Manual: True + Flag stage1 Description: Is this stage 1? Default: False @@ -90,9 +95,15 @@ Library -Wnoncanonical-monoid-instances if flag(ghci) - CPP-Options: -DGHCI + CPP-Options: -DHAVE_INTERNAL_INTERPRETER Include-Dirs: ../rts/dist/build @FFIIncludeDir@ + if flag(ext-interp) + CPP-Options: -DHAVE_EXTERNAL_INTERPRETER + + if flag(ghci) || flag(ext-interp) + CPP-Options: -DHAVE_INTERPRETER + -- sanity-check to ensure not more than one integer flag is set if flag(integer-gmp) && flag(integer-simple) build-depends: invalid-cabal-flag-settings<0 ===================================== compiler/ghci/GHCi.hs ===================================== @@ -51,7 +51,7 @@ module GHCi import GhcPrelude import GHCi.Message -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.Run #endif import GHCi.RemoteTypes @@ -157,7 +157,7 @@ Other Notes on Remote GHCi * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs -} -#if !defined(GHCI) +#if !defined(HAVE_INTERNAL_INTERPRETER) needExtInt :: IO a needExtInt = throwIO (InstallationError "this operation requires -fexternal-interpreter") @@ -175,7 +175,7 @@ iservCmd hsc_env at HscEnv{..} msg uninterruptibleMask_ $ do -- Note [uninterruptibleMask_] iservCall iserv msg | otherwise = -- Just run it directly -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) run msg #else needExtInt @@ -391,7 +391,7 @@ lookupSymbol hsc_env at HscEnv{..} str writeIORef iservLookupSymbolCache $! addToUFM cache str p return (Just p) | otherwise = -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) #else needExtInt @@ -642,7 +642,7 @@ wormholeRef dflags _r | gopt Opt_ExternalInterpreter dflags = throwIO (InstallationError "this operation requires -fno-external-interpreter") -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) | otherwise = localRef _r #else ===================================== compiler/main/DynFlags.hs ===================================== @@ -320,8 +320,8 @@ import qualified EnumSet import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -#if defined(GHCI) -import Foreign (Ptr) -- needed for 2nd stage +#if defined(HAVE_INTERPRETER) +import Foreign (Ptr) #endif -- Note [Updating flag description in the User's Guide] @@ -4342,7 +4342,7 @@ supportedExtensions :: [String] supportedExtensions = concatMap toFlagSpecNamePair xFlags where toFlagSpecNamePair flg -#if !defined(GHCI) +#if !defined(HAVE_INTERPRETER) -- IMPORTANT! Make sure that `ghc --supported-extensions` omits -- "TemplateHaskell"/"QuasiQuotes" when it's known not to work out of the -- box. See also GHC #11102 and #16331 for more details about ===================================== compiler/main/DynamicLoading.hs ===================================== @@ -3,7 +3,7 @@ -- | Dynamically lookup up values from modules and loading them. module DynamicLoading ( initializePlugins, -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) -- * Loading plugins loadFrontendPlugin, @@ -27,7 +27,7 @@ module DynamicLoading ( import GhcPrelude import DynFlags -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) import Linker ( linkModule, getHValue ) import GHCi ( wormhole ) import SrcLoc ( noSrcSpan ) @@ -76,7 +76,7 @@ import Control.Monad ( unless ) -- actual compilation starts. Idempotent operation. Should be re-called if -- pluginModNames or pluginModNameOpts changes. initializePlugins :: HscEnv -> DynFlags -> IO DynFlags -#if !defined(GHCI) +#if !defined(HAVE_INTERPRETER) initializePlugins _ df = do let pluginMods = pluginModNames df unless (null pluginMods) (pluginError pluginMods) @@ -96,7 +96,7 @@ initializePlugins hsc_env df #endif -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) loadPlugins :: HscEnv -> IO [LoadedPlugin] loadPlugins hsc_env ===================================== compiler/rename/RnExpr.hs ===================================== @@ -208,7 +208,7 @@ rnExpr (NegApp _ e _) ------------------------------------------ -- Template Haskell extensions --- Don't ifdef-GHCI them because we want to fail gracefully +-- Don't ifdef-HAVE_INTERPRETER them because we want to fail gracefully -- (not with an rnExpr crash) in a stage-1 compiler. rnExpr e@(HsBracket _ br_body) = rnBracket e br_body ===================================== compiler/simplCore/SimplCore.hs ===================================== @@ -462,7 +462,7 @@ doCorePass (CoreDoRuleCheck phase pat) = ruleCheckPass phase pat doCorePass CoreDoNothing = return doCorePass (CoreDoPasses passes) = runCorePasses passes -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) doCorePass (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-} pass #else doCorePass pass at CoreDoPluginPass {} = pprPanic "doCorePass" (ppr pass) ===================================== compiler/typecheck/TcAnnotations.hs ===================================== @@ -28,7 +28,7 @@ import Outputable -- Some platforms don't support the external interpreter, and -- compilation on those platforms shouldn't fail just due to -- annotations -#ifndef GHCI +#if !defined(HAVE_INTERNAL_INTERPRETER) tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation] tcAnnotations anns = do dflags <- getDynFlags ===================================== compiler/typecheck/TcPluginM.hs ===================================== @@ -3,7 +3,7 @@ -- access select functions of the 'TcM', principally those to do with -- reading parts of the state. module TcPluginM ( -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) -- * Basic TcPluginM functionality TcPluginM, tcPluginIO, @@ -52,7 +52,7 @@ module TcPluginM ( #endif ) where -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) import GhcPrelude import qualified TcRnMonad as TcM ===================================== compiler/utils/Util.hs ===================================== @@ -188,7 +188,7 @@ the flags are off. -} ghciSupported :: Bool -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) ghciSupported = True #else ghciSupported = False ===================================== ghc/Main.hs ===================================== @@ -25,12 +25,12 @@ import HscMain ( newHscEnv ) import DriverPipeline ( oneShot, compileFile ) import DriverMkDepend ( doMkDependHS ) import DriverBkp ( doBackpack ) -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif -- Frontend plugins -#if defined(GHCI) +#if defined(HAVE_INTERPRETER) import DynamicLoading ( loadFrontendPlugin, initializePlugins ) import Plugins #else @@ -271,7 +271,7 @@ main' postLoadMode dflags0 args flagWarnings = do ghciUI :: HscEnv -> DynFlags -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () -#if !defined(GHCI) +#if !defined(HAVE_INTERNAL_INTERPRETER) ghciUI _ _ _ _ = throwGhcException (CmdLineError "not built for interactive use") #else @@ -521,7 +521,7 @@ isDoEvalMode :: Mode -> Bool isDoEvalMode (Right (Right (DoEval _))) = True isDoEvalMode _ = False -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) isInteractiveMode :: PostLoadMode -> Bool isInteractiveMode DoInteractive = True isInteractiveMode _ = False @@ -752,7 +752,7 @@ showBanner :: PostLoadMode -> DynFlags -> IO () showBanner _postLoadMode dflags = do let verb = verbosity dflags -#if defined(GHCI) +#if defined(HAVE_INTERNAL_INTERPRETER) -- Show the GHCi banner when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg #endif @@ -844,7 +844,7 @@ dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) -- Frontend plugin support doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc () -#if !defined(GHCI) +#if !defined(HAVE_INTERPRETER) doFrontend modname _ = pluginError [modname] #else doFrontend modname srcs = do ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -24,6 +24,11 @@ Flag ghci Default: False Manual: True +Flag ext-interp + Description: Build external interpreter support + Default: True + Manual: True + Flag threaded Description: Link the ghc executable against the threaded RTS Default: True @@ -63,7 +68,7 @@ Executable ghc haskeline == 0.7.*, time >= 1.8 && < 1.10, transformers == 0.5.* - CPP-Options: -DGHCI + CPP-Options: -DHAVE_INTERNAL_INTERPRETER GHC-Options: -fno-warn-name-shadowing Other-Modules: GHCi.Leak @@ -92,6 +97,12 @@ Executable ghc if flag(threaded) ghc-options: -threaded + if flag(ext-interp) + cpp-options: -DHAVE_EXTERNAL_INTERPRETER + + if flag(ghci) || flag(ext-interp) + cpp-options: -DHAVE_INTERPRETER + Other-Extensions: CPP NondecreasingIndentation ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -17,6 +17,8 @@ packageArgs = do intLib <- getIntegerPackage compilerPath <- expr $ buildPath (vanillaContext stage compiler) gmpBuildPath <- expr gmpBuildPath + win <- expr windowsHost + cross <- expr (flag CrossCompiling) let includeGmp = "-I" ++ gmpBuildPath -/- "include" mconcat @@ -70,6 +72,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ ghcWithNativeCodeGen ? arg "ncg" , ghcWithInterpreter ? notStage0 ? arg "ghci" + , notStage0 ? (not win && not cross) ? arg "ext-interp" , flag CrossCompiling ? arg "-terminfo" , notStage0 ? intLib == integerGmp ? arg "integer-gmp" @@ -84,6 +87,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ ghcWithInterpreter ? notStage0 ? arg "ghci" + , notStage0 ? (not win && not cross) ? arg "ext-interp" , flag CrossCompiling ? arg "-terminfo" -- the 'threaded' flag is True by default, but -- let's record explicitly that we link all ghc @@ -117,6 +121,8 @@ packageArgs = do -- behind the @-fghci@ flag. , package ghci ? mconcat [ notStage0 ? builder (Cabal Flags) ? arg "ghci" + , notStage0 ? builder (Cabal Flags) ? (not win && not cross) + ? arg "ext-interp" , flag CrossCompiling ? stage0 ? builder (Cabal Flags) ? arg "ghci" ] -------------------------------- haddock ------------------------------- ===================================== libraries/ghci/GHCi/BreakArray.hs ===================================== @@ -19,7 +19,7 @@ module GHCi.BreakArray ( BreakArray -#ifdef GHCI +#if defined(HAVE_INTERPRETER) (BA) -- constructor is exported only for ByteCodeGen , newBreakArray , getBreak @@ -29,7 +29,7 @@ module GHCi.BreakArray #endif ) where -#ifdef GHCI +#if defined(HAVE_INTERPRETER) import Prelude -- See note [Why do we import Prelude here?] import Control.Monad import Data.Word ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -10,13 +10,13 @@ -- module GHCi.InfoTable ( -#ifdef GHCI +#if defined(HAVE_INTERPRETER) mkConInfoTable #endif ) where import Prelude -- See note [Why do we import Prelude here?] -#ifdef GHCI +#if defined(HAVE_INTERPRETER) import Foreign import Foreign.C import GHC.Ptr @@ -27,13 +27,13 @@ import qualified Data.ByteString as BS #endif ghciTablesNextToCode :: Bool -#ifdef TABLES_NEXT_TO_CODE +#if defined(TABLES_NEXT_TO_CODE) ghciTablesNextToCode = True #else ghciTablesNextToCode = False #endif -#ifdef GHCI /* To end */ +#if defined(HAVE_INTERPRETER) /* To end */ -- NOTE: Must return a pointer acceptable for use in the header of a closure. -- If tables_next_to_code is enabled, then it must point the the 'code' field. -- Otherwise, it should point to the start of the StgInfoTable. @@ -387,4 +387,4 @@ wORD_SIZE = (#const SIZEOF_HSINT) conInfoTableSizeB :: Int conInfoTableSizeB = wORD_SIZE + itblSize -#endif /* GHCI */ +#endif /* HAVE_INTERPRETER */ ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag ghci Default: False Manual: True +Flag ext-interp + Description: Build external interpreter support + Default: True + Manual: True + source-repository head type: git location: https://gitlab.haskell.org/ghc/ghc.git @@ -48,7 +53,7 @@ library UnboxedTuples if flag(ghci) - CPP-Options: -DGHCI + CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run GHCi.CreateBCO @@ -56,6 +61,12 @@ library GHCi.Signals GHCi.TH + if flag(ext-interp) + CPP-Options: -DHAVE_EXTERNAL_INTERPRETER + + if flag(ghci) || flag(ext-interp) + CPP-Options: -DHAVE_INTERPRETER + include-dirs: @FFIIncludeDir@ exposed-modules: ===================================== testsuite/tests/codeGen/should_compile/jmp_tbl.hs ===================================== @@ -4,7 +4,7 @@ This funny module was reduced from a failing build of stage2 using the new code generator and the linear register allocator, with this bug: -"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds +"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DHAVE_INTERNAL_INTERPRETER -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds ghc-stage1: panic! (the 'impossible' happened) (GHC version 7.1.20110414 for x86_64-unknown-linux): ===================================== utils/ghc-in-ghci/settings.ghci ===================================== @@ -30,7 +30,7 @@ :set -Iincludes/dist-derivedconstants/header :set -package=ghc-boot-th :set -DSTAGE=2 -:set -DGHCI +:set -DHAVE_INTERNAL_INTERPRETER :set -DGHC_LOADED_INTO_GHCI :set -XNoImplicitPrelude View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/39f50bff3ea913a7f4b1d915660bcf77b9327e2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/39f50bff3ea913a7f4b1d915660bcf77b9327e2e You're receiving 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 Jun 11 22:41:19 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:41:19 -0400 Subject: [Git][ghc/ghc][master] Make `haddock_testsuite` respect `--test-accept` Message-ID: <5d002e0f417a3_6f7d5d2264231985b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 2 changed files: - testsuite/tests/haddock/haddock_testsuite/Makefile - testsuite/tests/haddock/haddock_testsuite/all.T Changes: ===================================== testsuite/tests/haddock/haddock_testsuite/Makefile ===================================== @@ -24,6 +24,7 @@ htmlTest: $(haddockTest) \ $(TOP)/../utils/haddock/html-test/Main.hs ./html-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -39,6 +40,7 @@ latexTest: $(haddockTest) \ $(TOP)/../utils/haddock/latex-test/Main.hs ./latex-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -54,6 +56,7 @@ hoogleTest: $(haddockTest) \ $(TOP)/../utils/haddock/hoogle-test/Main.hs ./hoogle-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log @@ -69,6 +72,7 @@ hypsrcTest: $(haddockTest) \ $(TOP)/../utils/haddock/hypsrc-test/Main.hs ./hypsrc-test \ + $(ACCEPT) \ --ghc-path=$(TEST_HC) \ --haddock-path=$(HADDOCK) \ --haddock-stdout=haddock-out.log ===================================== testsuite/tests/haddock/haddock_testsuite/all.T ===================================== @@ -1,19 +1,21 @@ +accept = 'ACCEPT=--accept' if config.accept else 'ACCEPT=""' + test('haddockHtmlTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['htmlTest']) + ['htmlTest ' + accept]) test('haddockLatexTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['latexTest']) + ['latexTest ' + accept]) test('haddockHoogleTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['hoogleTest']) + ['hoogleTest ' + accept]) test('haddockHypsrcTest', [ignore_stdout, ignore_stderr, unless(in_tree_compiler(), skip), req_haddock], makefile_test, - ['hypsrcTest']) + ['hypsrcTest ' + accept]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/45616133efba0c17a461ecf085427b7956250fad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/45616133efba0c17a461ecf085427b7956250fad You're receiving 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 Jun 11 22:41:56 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:41:56 -0400 Subject: [Git][ghc/ghc][master] rts/RtsFlags.c: mention that -prof too enables support for +RTS -l Message-ID: <5d002e34570a1_6f73fe61e5d755c23226e1@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 2 changed files: - docs/users_guide/phases.rst - rts/RtsFlags.c Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -365,7 +365,7 @@ defined by your local GHC installation, the following trick is useful: .. code-block:: c - #ifdef MIN_VERSION_GLASGOW_HASKELL + #if defined(MIN_VERSION_GLASGOW_HASKELL) #if MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) /* code that applies only to GHC 7.10.2 or later */ #endif ===================================== rts/RtsFlags.c ===================================== @@ -830,7 +830,7 @@ error = true; # define TRACING_BUILD_ONLY(x) x #else # define TRACING_BUILD_ONLY(x) \ -errorBelch("the flag %s requires the program to be built with -eventlog or -debug", \ +errorBelch("the flag %s requires the program to be built with -eventlog, -prof or -debug", \ rts_argv[arg]); \ error = true; #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/762098bf2cfac657c0320249f62dc49bad77f7bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/762098bf2cfac657c0320249f62dc49bad77f7bf You're receiving 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 Jun 11 22:42:34 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:42:34 -0400 Subject: [Git][ghc/ghc][master] Hadrian: teach the RTS that PROFILING implies TRACING Message-ID: <5d002e5a551e6_6f73fe610bc0cb023283ae@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - 1 changed file: - includes/rts/Config.h Changes: ===================================== includes/rts/Config.h ===================================== @@ -26,11 +26,15 @@ #define USING_LIBBFD 1 #endif -/* DEBUG implies TRACING and TICKY_TICKY */ -#if defined(DEBUG) +/* DEBUG and PROFILING both imply TRACING */ +#if defined(DEBUG) || defined(PROFILING) #if !defined(TRACING) #define TRACING #endif +#endif + +/* DEBUG implies TICKY_TICKY */ +#if defined(DEBUG) #if !defined(TICKY_TICKY) #define TICKY_TICKY #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/457fe7897d42e4359b6da6b359fd7ea8ae0f1d75 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/457fe7897d42e4359b6da6b359fd7ea8ae0f1d75 You're receiving 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 Jun 11 22:43:10 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:43:10 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts/linker: Mmap into low memory on AArch64 Message-ID: <5d002e7eeeeeb_6f73fe5ce7cf17023328b2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 2 changed files: - rts/Linker.c - rts/linker/Elf.c Changes: ===================================== rts/Linker.c ===================================== @@ -182,28 +182,37 @@ Mutex linker_unloaded_mutex; /* Generic wrapper function to try and Resolve and RunInit oc files */ int ocTryLoad( ObjectCode* oc ); -/* Link objects into the lower 2Gb on x86_64. GHC assumes the +/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the * small memory model on this architecture (see gcc docs, * -mcmodel=small). * * MAP_32BIT not available on OpenBSD/amd64 */ -#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT) +#if defined(MAP_32BIT) && defined(x86_64_HOST_ARCH) +#define MAP_LOW_MEM #define TRY_MAP_32BIT MAP_32BIT #else #define TRY_MAP_32BIT 0 #endif +#if defined(aarch64_HOST_ARCH) +// On AArch64 MAP_32BIT is not available but we are still bound by the small +// memory model. Consequently we still try using the MAP_LOW_MEM allocation +// strategy. +#define MAP_LOW_MEM +#endif + /* - * Due to the small memory model (see above), on x86_64 we have to map - * all our non-PIC object files into the low 2Gb of the address space - * (why 2Gb and not 4Gb? Because all addresses must be reachable - * using a 32-bit signed PC-relative offset). On Linux we can do this - * using the MAP_32BIT flag to mmap(), however on other OSs - * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we - * can't do this. So on these systems, we have to pick a base address - * in the low 2Gb of the address space and try to allocate memory from - * there. + * Note [MAP_LOW_MEM] + * ~~~~~~~~~~~~~~~~~~ + * Due to the small memory model (see above), on x86_64 and AArch64 we have to + * map all our non-PIC object files into the low 2Gb of the address space (why + * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit + * signed PC-relative offset). On x86_64 Linux we can do this using the + * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and + * also on Linux inside Xen, see #2512), we can't do this. So on these + * systems, we have to pick a base address in the low 2Gb of the address space + * and try to allocate memory from there. * * We pick a default address based on the OS, but also make this * configurable via an RTS flag (+RTS -xm) @@ -1006,7 +1015,7 @@ mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset) IF_DEBUG(linker, debugBelch("mmapForLinker: start\n")); size = roundUpToPage(bytes); -#if defined(x86_64_HOST_ARCH) +#if defined(MAP_LOW_MEM) mmap_again: #endif @@ -1031,7 +1040,7 @@ mmap_again: return NULL; } -#if defined(x86_64_HOST_ARCH) +#if defined(MAP_LOW_MEM) if (RtsFlags.MiscFlags.linkerAlwaysPic) { } else if (mmap_32bit_base != 0) { if (result == map_addr) { ===================================== rts/linker/Elf.c ===================================== @@ -745,12 +745,8 @@ ocGetNames_ELF ( ObjectCode* oc ) unsigned nstubs = numberOfStubsForSection(oc, i); unsigned stub_space = STUB_SIZE * nstubs; - void * mem = mmap(NULL, size+stub_space, - PROT_READ | PROT_WRITE | PROT_EXEC, - MAP_ANON | MAP_PRIVATE, - -1, 0); - - if( mem == MAP_FAILED ) { + void * mem = mmapForLinker(size+stub_space, MAP_ANON, -1, 0); + if( mem == NULL ) { barf("failed to mmap allocated memory to load section %d. " "errno = %d", i, errno); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/457fe7897d42e4359b6da6b359fd7ea8ae0f1d75...0b7f81f560c602f32cfc90fd3fb5f1c52f06ad49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/457fe7897d42e4359b6da6b359fd7ea8ae0f1d75...0b7f81f560c602f32cfc90fd3fb5f1c52f06ad49 You're receiving 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 Jun 11 22:43:46 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:43:46 -0400 Subject: [Git][ghc/ghc][master] Fix an error message in CheckUnload.c:searchHeapBlocks Message-ID: <5d002ea2d60c8_6f73fe5ce7cf1702336110@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - 1 changed file: - rts/CheckUnload.c Changes: ===================================== rts/CheckUnload.c ===================================== @@ -335,7 +335,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd, break; default: - barf("heapCensus, unknown object: %d", info->type); + barf("searchHeapBlocks, unknown object: %d", info->type); } if (!prim) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1389b2ccdecb0ea7a8982884512dbf7175a52042 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1389b2ccdecb0ea7a8982884512dbf7175a52042 You're receiving 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 Jun 11 22:44:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 18:44:28 -0400 Subject: [Git][ghc/ghc][master] testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Message-ID: <5d002eccaf064_6f778df430233943f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 2 changed files: - hadrian/src/Rules/Test.hs - testsuite/mk/boilerplate.mk Changes: ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -122,7 +122,7 @@ testRules = do -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk -- which is in turn included by all test 'Makefile's. - setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath) + setEnv "ghc_config_mk" (top -/- root -/- ghcConfigPath) -- Execute the test target. -- We override the verbosity setting to make sure the user can see ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -240,17 +240,17 @@ $(TOP)/mk/ghc-config : $(TOP)/mk/ghc-config.hs empty= space=$(empty) $(empty) -ifeq "$(ghc-config-mk)" "" -ghc-config-mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk +ifeq "$(ghc_config_mk)" "" +ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk -$(ghc-config-mk) : $(TOP)/mk/ghc-config +$(ghc_config_mk) : $(TOP)/mk/ghc-config $(TOP)/mk/ghc-config "$(TEST_HC)" >"$@"; if [ $$? != 0 ]; then $(RM) "$@"; exit 1; fi # If the ghc-config fails, remove $@, and fail endif # Note: $(CLEANING) is not defined in the testsuite. ifeq "$(findstring clean,$(MAKECMDGOALS))" "" --include $(ghc-config-mk) +-include $(ghc_config_mk) endif # Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aad6115aed884db9ed47ac602ca1bd3b953ea089 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aad6115aed884db9ed47ac602ca1bd3b953ea089 You're receiving 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 Jun 11 22:51:10 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 18:51:10 -0400 Subject: [Git][ghc/ghc][wip/T16742] PrelRules: Don't break let/app invariant in shiftRule Message-ID: <5d00305e56602_6f7cc6995c23421af@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T16742 at Glasgow Haskell Compiler / GHC Commits: 04196035 by Ben Gamari at 2019-06-11T22:50:52Z PrelRules: Don't break let/app invariant in shiftRule Previously shiftRule would rewrite as invalid shift like ``` let x = I# (uncheckedIShiftL# n 80) in ... ``` to ``` let x = I# (error "invalid shift") in ... ``` However, this breaks the let/app invariant as `error` is not okay-for-speculation. There isn't an easy way to avoid this so let's not try. Instead we just take advantage of the undefined nature of invalid shifts and return zero. Fixes #16742. - - - - - 7 changed files: - compiler/coreSyn/CoreSyn.hs - compiler/prelude/PrelRules.hs - compiler/prelude/PrimOp.hs - testsuite/tests/codeGen/should_run/T16449_2.hs - − testsuite/tests/codeGen/should_run/T16449_2.stderr - + testsuite/tests/codeGen/should_run/T16449_2.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/coreSyn/CoreSyn.hs ===================================== @@ -445,6 +445,9 @@ which will generate a @case@ if necessary The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in coreSyn/MkCore. +For discussion of some implications of the let/app invariant primops see +Note [Checking versus non-checking primops] in PrimOp. + Note [CoreSyn type and coercion invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow a /non-recursive/, /non-top-level/ let to bind type and ===================================== compiler/prelude/PrelRules.hs ===================================== @@ -475,8 +475,7 @@ shiftRule shift_op -> return e1 -- See Note [Guarding against silly shifts] | shift_len < 0 || shift_len > wordSizeInBits dflags - -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy - ("Bad shift length " ++ show shift_len) + -> return $ Lit $ mkLitNumberWrap dflags LitNumInt 0 (exprType e1) -- Do the shift at type Integer, but shift length is Int Lit (LitNumber nt x t) @@ -701,7 +700,27 @@ can't constant fold it, but if it gets to the assember we get Error: operand type mismatch for `shl' So the best thing to do is to rewrite the shift with a call to error, -when the second arg is stupid. +when the second arg is large. However, in general we cannot do this; consider +this case + + let x = I# (uncheckedIShiftL# n 80) + in ... + +Here x contains an invalid shift and consequently we would like to rewrite it +as follows: + + let x = I# (error "invalid shift) + in ... + +This was originally done in the fix to #16449 but this breaks the let/app +invariant (see Note [CoreSyn let/app invariant] in CoreSyn) as noted in #16742. +For the reasons discussed in Note [Checking versus non-checking primops] (in +the PrimOp module) there is no safe way rewrite the argument of I# such that +it bottoms. + +Consequently we instead take advantage of the fact that large shifts are +undefined behavior (see associated documentation in primops.txt.pp) and +transform the invalid shift into an "obviously incorrect" value. There are two cases: ===================================== compiler/prelude/PrimOp.hs ===================================== @@ -304,6 +304,27 @@ primOpOutOfLine :: PrimOp -> Bool * * ************************************************************************ +Note [Checking versus non-checking primops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + In GHC primops break down into two classes: + + a. Checking primops behave, for instance, like division. In this + case the primop may throw an exception (e.g. division-by-zero) + and is consequently is marked with the can_fail flag described below. + The ability to fail comes at the expense of precluding some optimizations. + + b. Non-checking primops behavior, for instance, like addition. While + addition can overflow it does not produce an exception. So can_fail is + set to False, and we get more optimisation opportunities. But we must + never throw an exception, so we cannot rewrite to a call to error. + + It is important that a non-checking primop never be transformed in a way that + would cause it to bottom. Doing so would violate Core's let/app invariant + (see Note [CoreSyn let/app invariant] in CoreSyn) which is critical to + the simplifier's ability to float without fear of changing program meaning. + + Note [PrimOp can_fail and has_side_effects] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Both can_fail and has_side_effects mean that the primop has ===================================== testsuite/tests/codeGen/should_run/T16449_2.hs ===================================== @@ -5,5 +5,9 @@ module Main where import GHC.Prim import GHC.Int +-- Test that large unchecked shifts, which constitute undefined behavior, do +-- not crash the compiler and instead evaluate to 0. +-- See Note [Guarding against silly shifts] in PrelRules. + -- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test. main = print (I# (uncheckedIShiftL# 1# 1000#)) ===================================== testsuite/tests/codeGen/should_run/T16449_2.stderr deleted ===================================== @@ -1 +0,0 @@ -T16449_2: Bad shift length 1000 ===================================== testsuite/tests/codeGen/should_run/T16449_2.stdout ===================================== @@ -0,0 +1,2 @@ +0 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -196,4 +196,4 @@ test('T15892', extra_run_opts('+RTS -G1 -A32k -RTS') ], compile_and_run, ['-O']) test('T16617', normal, compile_and_run, ['']) -test('T16449_2', exit_code(1), compile_and_run, ['']) +test('T16449_2', exit_code(0), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/041960356df883d5883f973acefe44f15b678f4e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/041960356df883d5883f973acefe44f15b678f4e You're receiving 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 Jun 11 23:15:25 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 11 Jun 2019 19:15:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Warn about unused packages Message-ID: <5d00360d12177_6f7b1cf9ac23561c@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 3c2059e4 by Ben Gamari at 2019-06-11T23:15:09Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - f1d02c17 by Ben Gamari at 2019-06-11T23:15:10Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - fa88f240 by Ben Gamari at 2019-06-11T23:15:10Z rts/linker: Make elf_got.c a bit more legible - - - - - 04514f13 by Ben Gamari at 2019-06-11T23:15:10Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 8bb558f4 by Krzysztof Gogolewski at 2019-06-11T23:15:11Z Use DeriveFunctor throughout the codebase (#15654) - - - - - 2d527565 by Ben Gamari at 2019-06-11T23:15:11Z users-guide: Fix a few markup issues Strangely these were only causing the build to fail in the aarch64-linux job, despite Sphinx throwing errors in all jobs I checked. Also changes some `#ifdef`s to `#if defined` to satisfy the linter. - - - - - cfd22bfb by Ben Gamari at 2019-06-11T23:15:12Z Clean up .circleci Move prepare-system.sh to .gitlab and remove everything else. - - - - - 30 changed files: - − .circleci/config.yml - − .circleci/fetch-submodules.sh - − .circleci/push-test-metrics.sh - .gitlab-ci.yml - .circleci/prepare-system.sh → .gitlab/prepare-system.sh - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/ghci/GHCi.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e25ff26d89a0b89103d8905ef126dea0973dd78b...cfd22bfbc04daf1051dcbe49c3ef55e206e6ff5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e25ff26d89a0b89103d8905ef126dea0973dd78b...cfd22bfbc04daf1051dcbe49c3ef55e206e6ff5c You're receiving 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 Jun 11 23:49:36 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 19:49:36 -0400 Subject: [Git][ghc/ghc][wip/fix-users-guide] gitlab-ci: Don't build PDF user's guide on AArch64 Message-ID: <5d003e1078b8d_6f73fe5ce7cf170237112a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-users-guide at Glasgow Haskell Compiler / GHC Commits: b16c2d5d by Ben Gamari at 2019-06-11T23:48:56Z gitlab-ci: Don't build PDF user's guide on AArch64 For reasons I don't understand sphinx seems to fail to produce a .idx file for makeindex. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -375,6 +375,8 @@ validate-x86_64-darwin: variables: TEST_ENV: "aarch64-linux-deb9" BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-aarch64-linux-deb9.tar.xz" + # Inexplicably makeindex fails + BUILD_SPHINX_PDF: "NO" cache: key: linux-aarch64-deb9 tags: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b16c2d5d4a1b5c16e4460435cd899f647d2910f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b16c2d5d4a1b5c16e4460435cd899f647d2910f6 You're receiving 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 Jun 12 00:07:36 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 20:07:36 -0400 Subject: [Git][ghc/ghc][wip/backport-fragile] 7 commits: testsuite: Introduce fragile modifier Message-ID: <5d004248b9dc2_6f73fe5e1290d402375586@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-fragile at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - 4 changed files: - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/profiling/should_run/all.T Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/086814df9fb89a9e1fb1e0f736d3a3ebedd48135...5e6f261aee196eb5984d192dcb01710b070452b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/086814df9fb89a9e1fb1e0f736d3a3ebedd48135...5e6f261aee196eb5984d192dcb01710b070452b3 You're receiving 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 Jun 12 01:06:34 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 11 Jun 2019 21:06:34 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 7 commits: gitlab-ci: Build alpine release bindists Message-ID: <5d00501a93115_738b9c080ec913d6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: 52c3d3b9 by Ben Gamari at 2019-06-12T00:58:02Z gitlab-ci: Build alpine release bindists - - - - - 39b79271 by Ben Gamari at 2019-06-12T00:58:02Z base/Event/Poll: Drop POLLRDHUP enum item Previously the Event enumeration produced by hsc2hs would sometimes include a currently-unused POLLRDHUP item. This unused binding would result in a build failure. Drop it. - - - - - 7dfa2c7e by Ben Gamari at 2019-06-12T00:58:02Z testsuite: Fix T8602 on musl Musl wants hash-bangs on all executables. - - - - - e4d3761b by Ben Gamari at 2019-06-12T00:58:02Z testsuite: Ensure T5423 flushes C output buffer Previously T5423 would fail to flush the printf output buffer. Consequently it was platform-dependent whether the C or Haskell print output would be emitted first. - - - - - 8bf1c800 by Ben Gamari at 2019-06-12T00:58:02Z testsuite: Flush conc059's printf buffer Otherwise it the order out the Haskell and C output will be system-dependent. - - - - - 7b3a66a6 by Ben Gamari at 2019-06-12T00:58:02Z testsuite: Ensure that ffi005 output order is predictable The libc output buffer wasn't being flushed, making the order system-depedent. - - - - - de355bfd by Ben Gamari at 2019-06-12T00:58:02Z XXX: Test alpine job - - - - - 11 changed files: - .gitlab-ci.yml - libraries/base/GHC/Event/Poll.hsc - testsuite/tests/concurrent/should_run/conc059.stdout - testsuite/tests/concurrent/should_run/conc059_c.c - testsuite/tests/driver/T8602/T8602.script - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi005.hs - testsuite/tests/ffi/should_run/ffi005.stdout - + testsuite/tests/ffi/should_run/ffi005_c.c - testsuite/tests/rts/T5423.stdout - testsuite/tests/rts/T5423_cmm.cmm 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 7aebd67ecd6bdc0ee89dd4aff5d0bbc5e87a28a1 # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -535,6 +535,26 @@ release-x86_64-linux-deb8: when: always expire_in: 2 week +################################# +# x86_64-linux-alpine +################################# + +release-x86_64-linux-alpine: + extends: .validate-linux + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + variables: + BUILD_SPHINX_PDF: "NO" + TEST_ENV: "x86_64-linux-alpine" + BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz" + # Can't use ld.gold due to #13958. + CONFIGURE_ARGS: "--disable-ld-override" + cache: + key: linux-x86_64-alpine + artifacts: + when: always + expire_in: 2 week + ################################# # x86_64-linux-centos7 ################################# ===================================== libraries/base/GHC/Event/Poll.hsc ===================================== @@ -162,24 +162,12 @@ newtype Event = Event CShort , FiniteBits -- ^ @since 4.7.0.0 ) --- We have to duplicate the whole enum like this in order for the --- hsc2hs cross-compilation mode to work -#if defined(POLLRDHUP) #{enum Event, Event , pollIn = POLLIN , pollOut = POLLOUT - , pollRdHup = POLLRDHUP , pollErr = POLLERR , pollHup = POLLHUP } -#else -#{enum Event, Event - , pollIn = POLLIN - , pollOut = POLLOUT - , pollErr = POLLERR - , pollHup = POLLHUP - } -#endif fromEvent :: E.Event -> Event fromEvent e = remap E.evtRead pollIn .|. ===================================== testsuite/tests/concurrent/should_run/conc059.stdout ===================================== @@ -1,3 +1,3 @@ -500000 exiting... +500000 exited. ===================================== testsuite/tests/concurrent/should_run/conc059_c.c ===================================== @@ -16,6 +16,7 @@ int main(int argc, char *argv[]) usleep(100000); #endif printf("exiting...\n"); + fflush(stdout); hs_exit(); printf("exited.\n"); #if mingw32_HOST_OS ===================================== testsuite/tests/driver/T8602/T8602.script ===================================== @@ -1,3 +1,4 @@ -:! echo 'echo $4 $5 $6; exit 1' > t8602.sh +:! echo '#!/bin/sh' > t8602.sh +:! echo 'echo $4 $5 $6; exit 1' >> t8602.sh :! chmod +x t8602.sh :load A ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -32,7 +32,7 @@ test('ffi005', [ omit_ways(prof_ways), when(arch('i386'), skip), when(platform('i386-apple-darwin'), expect_broken(4105)), exit_code(3) ], - compile_and_run, ['']) + compile_and_run, ['ffi005_c.c']) test('ffi006', normal, compile_and_run, ['']) ===================================== testsuite/tests/ffi/should_run/ffi005.hs ===================================== @@ -20,10 +20,12 @@ main = do -- putStrLn $ "errno == " ++ show err putStrLn "\nTesting puts (and withString)" - withCString "Test successful" puts + hFlush stdout + withCString "Test puts successful" puts + flushStdout -- Flush the libc output buffer putStrLn "\nTesting peekArray0" - s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0')) + s <- withCString "Test peekArray0 successful" (peekArray0 (castCharToCChar '\0')) putStr (map castCCharToChar s) -- disabled due to use of non-portable constants in arguments to open: @@ -71,6 +73,7 @@ withBuffer sz m = do return s foreign import ccall puts :: CString -> IO CInt +foreign import ccall "flush_stdout" flushStdout :: IO () -- foreign import ccall "open" open' :: CString -> CInt -> IO CInt -- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt ===================================== testsuite/tests/ffi/should_run/ffi005.stdout ===================================== @@ -3,9 +3,10 @@ Testing sin==mysin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] Testing puts (and withString) +Test puts successful Testing peekArray0 -Test successful +Test peekArray0 successful Testing sin==dynamic_sin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] @@ -16,4 +17,3 @@ Testing sin==Id wrapped_sin (should return lots of Trues) [True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] Testing exit -Test successful ===================================== testsuite/tests/ffi/should_run/ffi005_c.c ===================================== @@ -0,0 +1,5 @@ +#include +void flush_stdout(void) +{ + fflush(stdout); +} ===================================== testsuite/tests/rts/T5423.stdout ===================================== @@ -1,2 +1,2 @@ -120 111 112 113 114 115 116 117 118 119 120 +120 ===================================== testsuite/tests/rts/T5423_cmm.cmm ===================================== @@ -12,5 +12,6 @@ test (W_ r1, { foreign "C" printf("%d %d %d %d %d %d %d %d %d %d\n", r1, r2, r3, r4, r5, r6, r7, r8, r9, r10); + foreign "C" fflush(W_[stdout]); return (r10); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6f12aa63c67f8d252f0ad0487a031abb01beadc6...de355bfdcec0853527f51f657f04ad8f48911fe3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/6f12aa63c67f8d252f0ad0487a031abb01beadc6...de355bfdcec0853527f51f657f04ad8f48911fe3 You're receiving 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 Jun 12 04:19:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 00:19:29 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] 4 commits: testsuite: Mark OldModLocation as broken on Windows Message-ID: <5d007d519933d_3b3ae7ffa2c61057@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: f24bada7 by Ben Gamari at 2019-06-12T04:19:17Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - 96962bef by Ben Gamari at 2019-06-12T04:19:17Z testsuite: Mark T7170 as broken on Windows Due to #16801. - - - - - 882543ff by Ben Gamari at 2019-06-12T04:19:17Z testsuite: Mark T7702 as broken on Windows Due to #16799. - - - - - 62c0248a by Ben Gamari at 2019-06-12T04:19:17Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 4 changed files: - .gitlab-ci.yml - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -654,8 +654,6 @@ nightly-i386-windows-hadrian: .build-windows-make: extends: .build-windows stage: full-build - # due to #16084 - allow_failure: true variables: BUILD_FLAVOUR: "quick" GHC_VERSION: "8.6.5" ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -169,7 +169,9 @@ test('ffi_parsing_001', [omit_ways(['ghci'])], compile_and_run, test('capi_value', [omit_ways(['ghci'])], compile_and_run, ['capi_value_c.c']) -test('T7170', exit_code(1), compile_and_run, ['']) +test('T7170', + [when(opsys('mingw32'), expect_broken(16801))], + exit_code(1)], compile_and_run, ['']) test('T4012', [expect_broken_for(7388, ['ghci'])], multimod_compile_and_run, ['T4012', '']) ===================================== testsuite/tests/ghc-api/downsweep/all.T ===================================== @@ -9,6 +9,7 @@ test('PartialDownsweep', test('OldModLocation', [ extra_run_opts('"' + config.libdir + '"') + , when(opsys('mingw32'), expect_broken(16772)) ], compile_and_run, ['-package ghc']) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -144,6 +144,7 @@ test('T7702', # a large effect on allocation which is hard to separate from the # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), + when(opsys('mingw'), expect_broken_for(16799, ['normal'])) ], compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8f0f3f0aed918000cd0d82f65579e5244db8033d...62c0248a72fc18cb43f2a87c5b8d5a55ff47351e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8f0f3f0aed918000cd0d82f65579e5244db8033d...62c0248a72fc18cb43f2a87c5b8d5a55ff47351e You're receiving 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 Jun 12 05:15:48 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 01:15:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/disable-llvm-ci Message-ID: <5d008a84597d8_3b3ae7efd206627d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/disable-llvm-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/disable-llvm-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 Wed Jun 12 05:38:07 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 01:38:07 -0400 Subject: [Git][ghc/ghc][wip/disable-llvm-ci] gitlab-ci: Disable validate-x86_64-linux-deb9 job to reduce load Message-ID: <5d008fbf2eaf6_3b3ae7efb6868985@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/disable-llvm-ci at Glasgow Haskell Compiler / GHC Commits: 400b8ca4 by Ben Gamari at 2019-06-12T05:36:33Z gitlab-ci: Disable validate-x86_64-linux-deb9 job to reduce load Enable artifacts on to ensure we have bindist coverage. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -441,7 +441,8 @@ nightly-i386-linux-deb9: cache: key: linux-x86_64-deb9 -validate-x86_64-linux-deb9: +# Disabled to reduce CI load +.validate-x86_64-linux-deb9: extends: .build-x86_64-linux-deb9 artifacts: when: always @@ -464,6 +465,9 @@ validate-x86_64-linux-deb9-debug: variables: BUILD_FLAVOUR: validate TEST_ENV: "x86_64-linux-deb9-debug" + artifacts: + when: always + expire_in: 2 week # Disabled to alleviate CI load .validate-x86_64-linux-deb9-llvm: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/400b8ca42b3ed90e5d47ab53dad7cb760f60f3c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/400b8ca42b3ed90e5d47ab53dad7cb760f60f3c8 You're receiving 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 Jun 12 11:35:28 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 12 Jun 2019 07:35:28 -0400 Subject: [Git][ghc/ghc][master] llvm-targets: Add armv7l-unknown-linux-gnueabi Message-ID: <5d00e3805b4df_3b3a3f9f3aa4de40884db@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - 2 changed files: - llvm-targets - utils/llvm-targets/gen-data-layout.sh Changes: ===================================== llvm-targets ===================================== @@ -7,6 +7,7 @@ ,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) +,("armv7l-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ===================================== utils/llvm-targets/gen-data-layout.sh ===================================== @@ -24,6 +24,7 @@ TARGETS=( # Linux ARM "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "armv7l-unknown-linux-gnueabi" "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" # Linux x86 "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9b4ff57d71eebf6dd71a5d81d0f9c9c2aef80e65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9b4ff57d71eebf6dd71a5d81d0f9c9c2aef80e65 You're receiving 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 Jun 12 11:36:03 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 12 Jun 2019 07:36:03 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add haddock perf test output to gitignore Message-ID: <5d00e3a36780b_3b3a3f9f3a9c29f8918fd@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - 1 changed file: - + testsuite/tests/perf/haddock/.gitignore Changes: ===================================== testsuite/tests/perf/haddock/.gitignore ===================================== @@ -0,0 +1,2 @@ +# RTS performance metrics output from haddock perf tests +*.t View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c05ca251620ff2589f21192208a1e500285eb5c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c05ca251620ff2589f21192208a1e500285eb5c3 You're receiving 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 Jun 12 11:36:40 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 12 Jun 2019 07:36:40 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts/linker: Make elf_got.c a bit more legible Message-ID: <5d00e3c8ab4eb_3b3ae7efed896292@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1 changed file: - rts/linker/elf_got.c Changes: ===================================== rts/linker/elf_got.c ===================================== @@ -52,18 +52,18 @@ makeGot(ObjectCode * oc) { errorBelch("MAP_FAILED. errno=%d", errno); return EXIT_FAILURE; } + oc->info->got_start = (void*)mem; /* update got_addr */ size_t slot = 0; for(ElfSymbolTable *symTab = oc->info->symbolTables; - symTab != NULL; symTab = symTab->next) + symTab != NULL; symTab = symTab->next) { + for(size_t i=0; i < symTab->n_symbols; i++) if(needGotSlot(symTab->symbols[i].elf_sym)) symTab->symbols[i].got_addr = (uint8_t *)oc->info->got_start + (slot++ * sizeof(void*)); - if(mprotect(mem, oc->info->got_size, PROT_READ) != 0) { - sysErrorBelch("unable to protect memory"); } } return EXIT_SUCCESS; @@ -74,9 +74,12 @@ fillGot(ObjectCode * oc) { /* fill the GOT table */ for(ElfSymbolTable *symTab = oc->info->symbolTables; symTab != NULL; symTab = symTab->next) { + for(size_t i=0; i < symTab->n_symbols; i++) { ElfSymbol * symbol = &symTab->symbols[i]; + if(needGotSlot(symbol->elf_sym)) { + /* no type are undefined symbols */ if( STT_NOTYPE == ELF_ST_TYPE(symbol->elf_sym->st_info) || STB_WEAK == ELF_ST_BIND(symbol->elf_sym->st_info)) { @@ -93,22 +96,31 @@ fillGot(ObjectCode * oc) { } /* else it was defined somewhere in the same object, and * we should have the address already. */ + if(0x0 == symbol->addr) { errorBelch( "Something went wrong! Symbol %s has null address.\n", symbol->name); return EXIT_FAILURE; } + if(0x0 == symbol->got_addr) { errorBelch("Not good either!"); return EXIT_FAILURE; } + *(void**)symbol->got_addr = symbol->addr; } } } + + // We are done initializing the GOT; freeze it. + if(mprotect(oc->info->got_start, oc->info->got_size, PROT_READ) != 0) { + sysErrorBelch("unable to protect memory"); + } return EXIT_SUCCESS; } + bool verifyGot(ObjectCode * oc) { for(ElfSymbolTable *symTab = oc->info->symbolTables; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c05ca251620ff2589f21192208a1e500285eb5c3...217e6db4af6752b13c586d4e8925a4a9a2f47245 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c05ca251620ff2589f21192208a1e500285eb5c3...217e6db4af6752b13c586d4e8925a4a9a2f47245 You're receiving 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 Jun 12 11:37:15 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 12 Jun 2019 07:37:15 -0400 Subject: [Git][ghc/ghc][master] Use DeriveFunctor throughout the codebase (#15654) Message-ID: <5d00e3eb40e8f_3b3a53131fc99478@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - 30 changed files: - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/prelude/PrelRules.hs - compiler/rename/RnPat.hs - compiler/simplCore/CoreMonad.hs - compiler/simplCore/SimplMonad.hs - compiler/specialise/Specialise.hs - compiler/stgSyn/CoreToStg.hs - compiler/stgSyn/StgLint.hs - compiler/typecheck/TcCanonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1219f8e8a3d1b58263bea76822322b746a632778 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1219f8e8a3d1b58263bea76822322b746a632778 You're receiving 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 Jun 12 12:15:45 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:15:45 -0400 Subject: [Git][ghc/ghc][ghc-8.8] 7 commits: testsuite: Introduce fragile modifier Message-ID: <5d00ecf18c519_3b3a3f9f561a2f04110049@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - 4 changed files: - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/profiling/should_run/all.T Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/983ada70a013c7642a751f6e41587ff95b57d0f8...5e6f261aee196eb5984d192dcb01710b070452b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/983ada70a013c7642a751f6e41587ff95b57d0f8...5e6f261aee196eb5984d192dcb01710b070452b3 You're receiving 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 Jun 12 12:20:39 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:20:39 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 44 commits: Warn about unused packages Message-ID: <5d00ee17ca01b_3b3a3f9f3030a4d0117111@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - bd2d13ff by Ben Gamari at 2019-06-12T12:19:59Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 381c3ae3 by Ben Gamari at 2019-06-12T12:19:59Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 0354c7de by Ben Gamari at 2019-06-12T12:19:59Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e0b16eaa by Ben Gamari at 2019-06-12T12:19:59Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 2ce320b0 by Ben Gamari at 2019-06-12T12:19:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 90e7c450 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 488187f8 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 9b583320 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - eb644865 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 1a204e07 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 8d482e45 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 68cfdfdb by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - a3929a4f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - bb7ed32f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 329dcd7a by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix fragile_for test modifier - - - - - 55b5bb14 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 264ad286 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 587bef66 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - dc5a37fd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - e3f71d0e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - b5a13a1e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - b09374a4 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - a798c130 by Ben Gamari at 2019-06-12T12:20:25Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 0782141e by Ben Gamari at 2019-06-12T12:20:25Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 898f7e92 by Ben Gamari at 2019-06-12T12:20:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0a13a04c by Ben Gamari at 2019-06-12T12:20:25Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - f7d7b815 by Ben Gamari at 2019-06-12T12:20:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - a2d19acd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 7c28208d by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 55b78aa5 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/ghci/GHCi.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/edda3103b6a6284aff12f041c640313c2222cc13...55b78aa5a0b6b613ddedb45024560f785b37889a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/edda3103b6a6284aff12f041c640313c2222cc13...55b78aa5a0b6b613ddedb45024560f785b37889a You're receiving 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 Jun 12 12:22:21 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:22:21 -0400 Subject: [Git][ghc/ghc][wip/ghc-8.8-merges] 8 commits: testsuite: Introduce fragile modifier Message-ID: <5d00ee7d22e73_3b3a3f9f31cdca701177e3@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/ghc-8.8-merges at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - 1976b624 by Ben Gamari at 2019-06-12T12:22:17Z Bump process submodule to 1.6.5.1 - - - - - 5 changed files: - libraries/base/tests/all.T - libraries/process - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/profiling/should_run/all.T Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/719d4c7b5abd2fa02603eda8a0dfbebd47b3d748...1976b624ea1ab1d29f9f697c38ed363f6f4e3969 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/719d4c7b5abd2fa02603eda8a0dfbebd47b3d748...1976b624ea1ab1d29f9f697c38ed363f6f4e3969 You're receiving 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 Jun 12 12:27:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:27:33 -0400 Subject: [Git][ghc/ghc][wip/slowtest] 4 commits: process: Bump submodule Message-ID: <5d00efb5b89e8_3b3a3f9f3aa4de401201a8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/slowtest at Glasgow Haskell Compiler / GHC Commits: a8579e5b by Ben Gamari at 2019-06-12T12:27:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 3f1022c5 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 1cbfef47 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 20160f1a by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 9 changed files: - libraries/process - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/all.T - testsuite/tests/parser/should_compile/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/programs/galois_raytrace/test.T - testsuite/tests/quotes/all.T - testsuite/tests/roles/should_compile/all.T Changes: ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402 +Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e ===================================== testsuite/driver/testlib.py ===================================== @@ -434,6 +434,14 @@ def unless(b, f): def doing_ghci(): return 'ghci' in config.run_ways +def requires_th(name, opts): + """ + Mark a test as requiring TemplateHaskell. Currently this means + that we don't run the test in the profasm when when GHC is + dynamically-linked since we can't load profiled objects in this case. + """ + return when(ghc_dynamic(), omit_ways(['profasm'])) + def ghc_dynamic(): return config.ghc_dynamic ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -83,7 +83,7 @@ test('cgrun072', normal, compile_and_run, ['']) test('cgrun075', normal, compile_and_run, ['']) test('cgrun076', normal, compile_and_run, ['']) test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], compile_and_run, ['']) -test('cgrun078', normal, compile_and_run, ['']) +test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/driver/all.T ===================================== @@ -272,5 +272,7 @@ test('inline-check', omit_ways(['hpc', 'profasm']) test('T14452', [], makefile_test, []) test('T15396', normal, compile_and_run, ['-package ghc']) test('T16737', - [extra_files(['T16737include/']), expect_broken_for(16541, ['ghci'])], + [extra_files(['T16737include/']), + requires_th, + expect_broken_for(16541, ['ghci'])], compile_and_run, ['-optP=-isystem -optP=T16737include']) ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -142,5 +142,5 @@ test('T15457', normal, compile, ['']) test('T15675', normal, compile, ['']) test('T15781', normal, compile, ['']) test('T16339', normal, compile, ['']) -test('T16619', [], multimod_compile, ['T16619', '-v0']) +test('T16619', requires_th, multimod_compile, ['T16619', '-v0']) test('T504', normal, compile, ['']) ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -404,7 +404,7 @@ test ('WWRec', ['-v0 -O']) test('T16190', - collect_stats(), + [requires_th, collect_stats()], multimod_compile, ['T16190.hs', '-v0']) ===================================== testsuite/tests/programs/galois_raytrace/test.T ===================================== @@ -1,8 +1,3 @@ -# Floating point differences on x86 using the NCG -if config.platform.startswith('i386-') and \ - config.platform != 'i386-unknown-openbsd': - setTestOpts(expect_fail_for(['hpc','optasm','profasm','threaded2','profthreaded'])) - test('galois_raytrace', [extra_files(['CSG.hs', 'Construct.hs', 'Data.hs', 'Eval.hs', 'Geometry.hs', 'Illumination.hs', 'Intersections.hs', 'Interval.hs', 'Main.hs', 'Misc.hs', 'Parse.hs', 'Primitives.hs', 'Surface.hs', 'galois.gml']), when(fast(), skip)], multimod_compile_and_run, ['Main', '-package parsec']) ===================================== testsuite/tests/quotes/all.T ===================================== @@ -15,7 +15,7 @@ test('T8633', normal, compile_and_run, ['']) test('T8759a', normal, compile, ['-v0']) test('T9824', normal, compile, ['-v0']) test('T10384', normal, compile_fail, ['']) -test('T16384', normal, compile, ['']) +test('T16384', requires_th, compile, ['']) test('TH_tf2', normal, compile, ['-v0']) test('TH_ppr1', normal, compile_and_run, ['']) ===================================== testsuite/tests/roles/should_compile/all.T ===================================== @@ -10,4 +10,4 @@ test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, [ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) -test('T16718', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T16718', requires_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/55b78aa5a0b6b613ddedb45024560f785b37889a...20160f1a8a8ed69c168bee5c8d43373191303b3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/55b78aa5a0b6b613ddedb45024560f785b37889a...20160f1a8a8ed69c168bee5c8d43373191303b3f You're receiving 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 Jun 12 12:39:19 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:39:19 -0400 Subject: [Git][ghc/ghc][wip/backport-MR951] 8 commits: testsuite: Introduce fragile modifier Message-ID: <5d00f27720073_3b3a3f9f31c8fb08130884@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-MR951 at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - 6a8a4483 by Richard Eisenberg at 2019-06-12T12:39:07Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 (cherry picked from commit a22e51ea6f7a046c87d57ce30d143eef6abee9ff) - - - - - 20 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - + testsuite/tests/ghci/scripts/T16767.script - + testsuite/tests/ghci/scripts/T16767.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/profiling/should_run/all.T - + testsuite/tests/typecheck/should_fail/T16517.hs - + testsuite/tests/typecheck/should_fail/T16517.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail134.stderr Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -2079,13 +2079,6 @@ What do we do when we have an equality where k1 and k2 differ? This Note explores this treacherous area. -First off, the question above is slightly the wrong question. Flattening -a tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening -the kind might introduce a cast. So we might have a casted tyvar on the -left. We thus revise our test case to - - (tv |> co :: k1) ~ (rhs :: k2) - We must proceed differently here depending on whether we have a Wanted or a Given. Consider this: @@ -2109,36 +2102,33 @@ The reason for this odd behavior is much the same as Note [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the new `co` is a Wanted. - The solution is then not to use `co` to "rewrite" -- that is, cast - -- `w`, but instead to keep `w` heterogeneous and - irreducible. Given that we're not using `co`, there is no reason to - collect evidence for it, so `co` is born a Derived, with a CtOrigin - of KindEqOrigin. +The solution is then not to use `co` to "rewrite" -- that is, cast -- `w`, but +instead to keep `w` heterogeneous and irreducible. Given that we're not using +`co`, there is no reason to collect evidence for it, so `co` is born a +Derived, with a CtOrigin of KindEqOrigin. When the Derived is solved (by +unification), the original wanted (`w`) will get kicked out. We thus get -When the Derived is solved (by unification), the original wanted (`w`) -will get kicked out. +[D] _ :: k ~ Type +[W] w :: (alpha :: k) ~ (Int :: Type) -Note that, if we had [G] co1 :: k ~ Type available, then none of this code would -trigger, because flattening would have rewritten k to Type. That is, -`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar -case will trigger, correctly rewriting alpha to (Int |> sym co1). +Note that the Wanted is unchanged and will be irreducible. This all happens +in canEqTyVarHetero. + +Note that, if we had [G] co1 :: k ~ Type available, then we never get +to canEqTyVarHetero: canEqTyVar tries flattening the kinds first. If +we have [G] co1 :: k ~ Type, then flattening the kind of alpha would +rewrite k to Type, and we would end up in canEqTyVarHomo. Successive canonicalizations of the same Wanted may produce duplicate Deriveds. Similar duplications can happen with fundeps, and there seems to be no easy way to avoid. I expect this case to be rare. -For Givens, this problem doesn't bite, so a heterogeneous Given gives +For Givens, this problem (the Wanteds-rewriting-Wanteds action of +a kind coercion) doesn't bite, so a heterogeneous Given gives rise to a Given kind equality. No Deriveds here. We thus homogenise -the Given (see the "homo_co" in the Given case in canEqTyVar) and +the Given (see the "homo_co" in the Given case in canEqTyVarHetero) and carry on with a homogeneous equality constraint. -Separately, I (Richard E) spent some time pondering what to do in the case -that we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2 -differ. Note that the tv is the same. (This case is handled as the first -case in canEqTyVarHomo.) At one point, I thought we could solve this limited -form of heterogeneous Wanted, but I then reconsidered and now treat this case -just like any other heterogeneous Wanted. - Note [Type synonyms and canonicalization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We treat type synonym applications as xi types, that is, they do not ===================================== compiler/typecheck/TcErrors.hs ===================================== @@ -158,14 +158,22 @@ reportUnsolved wanted -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on -- However, do not make any evidence bindings, because we don't -- have any convenient place to put them. +-- NB: Type-level holes are OK, because there are no bindings. -- See Note [Deferring coercion errors to runtime] -- Used by solveEqualities for kind equalities --- (see Note [Fail fast on kind errors] in TcSimplify] +-- (see Note [Fail fast on kind errors] in TcSimplify) -- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = do { ev_binds <- newNoTcEvBinds - ; report_unsolved TypeError HoleError HoleError HoleError + + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures + ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures + ; let type_holes | not partial_sigs = HoleError + | warn_partial_sigs = HoleWarn + | otherwise = HoleDefer + + ; report_unsolved TypeError HoleError type_holes HoleError ev_binds wanted } -- | Report all unsolved goals as warnings (but without deferring any errors to ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -11,7 +11,7 @@ module TcHsType ( -- Type signatures - kcHsSigType, tcClassSigType, + kcClassSigType, tcClassSigType, tcHsSigType, tcHsSigWcType, tcHsPartialSigType, funsSigCtxt, addSigCtxt, pprSigCtxt, @@ -187,24 +187,40 @@ tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type -- already checked this, so we can simply ignore it. tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty) -kcHsSigType :: [Located Name] -> LHsSigType GhcRn -> TcM () -kcHsSigType names (HsIB { hsib_body = hs_ty - , hsib_ext = sig_vars }) - = addSigCtxt (funsSigCtxt names) hs_ty $ - discardResult $ - bindImplicitTKBndrs_Skol sig_vars $ - tc_lhs_type typeLevelMode hs_ty liftedTypeKind - -kcHsSigType _ (XHsImplicitBndrs _) = panic "kcHsSigType" +kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () +kcClassSigType skol_info names sig_ty + = discardResult $ + tcClassSigType skol_info names sig_ty + -- tcClassSigType does a fair amount of extra work that we don't need, + -- such as ordering quantified variables. But we absolutely do need + -- to push the level when checking method types and solve local equalities, + -- and so it seems easier just to call tcClassSigType than selectively + -- extract the lines of code from tc_hs_sig_type that we really need. + -- If we don't push the level, we get #16517, where GHC accepts + -- class C a where + -- meth :: forall k. Proxy (a :: k) -> () + -- Note that k is local to meth -- this is hogwash. 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) $ - tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) -- Do not zonk-to-Type, nor perform a validity check -- We are in a knot with the class and associated types -- Zonking and validity checking is done by tcClassDecl + -- No need to fail here if the type has an error: + -- If we're in the kind-checking phase, the solveEqualities + -- in kcTyClGroup catches the error + -- If we're in the type-checking phase, the solveEqualities + -- in tcClassDecl1 gets it + -- Failing fast here degrades the error message in, e.g., tcfail135: + -- class Foo f where + -- baa :: f a -> f + -- If we fail fast, we're told that f has kind `k1` when we wanted `*`. + -- It should be that f has kind `k2 -> *`, but we never get a chance + -- to run the solver where the kind of f is touchable. This is + -- painfully delicate. tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type -- Does validity checking @@ -214,10 +230,13 @@ tcHsSigType ctxt sig_ty do { traceTc "tcHsSigType {" (ppr sig_ty) -- Generalise here: see Note [Kind generalisation] - ; ty <- tc_hs_sig_type skol_info sig_ty - (expectedKindInCtxt ctxt) + ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty + (expectedKindInCtxt ctxt) ; ty <- zonkTcType ty + ; when insol failM + -- See Note [Fail fast if there are insoluble kind equalities] in TcSimplify + ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) ; return ty } @@ -225,12 +244,14 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM Type + -> ContextKind -> TcM (Bool, TcType) -- Kind-checks/desugars an 'LHsSigType', -- solve equalities, -- and then kind-generalizes. -- This will never emit constraints, as it uses solveEqualities interally. -- No validity checking or zonking +-- Returns also a Bool indicating whether the type induced an insoluble constraint; +-- True <=> constraint is insoluble tc_hs_sig_type skol_info hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { (tc_lvl, (wanted, (spec_tkvs, ty))) @@ -238,7 +259,6 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind solveLocalEqualitiesX "tc_hs_sig_type" $ bindImplicitTKBndrs_Skol sig_vars $ do { kind <- newExpectedKind ctxt_kind - ; tc_lhs_type typeLevelMode hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- should be in the global tyvars, and therefore won't be quantified @@ -249,9 +269,11 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs) tc_lvl wanted + ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) } + ; return (mkInvForAllTys kvs ty1) } -tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type_and_gen" +tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type" tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type -- tcTopLHsType is used for kind-checking top-level HsType where @@ -2056,7 +2078,8 @@ kindGeneralize :: TcType -> TcM [KindVar] -- Quantify the free kind variables of a kind or type -- In the latter case the type is closed, so it has no free -- type variables. So in both cases, all the free vars are kind vars --- Input needn't be zonked. +-- Input needn't be zonked. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. -- NB: You must call solveEqualities or solveLocalEqualities before -- kind generalization -- @@ -2074,7 +2097,8 @@ kindGeneralize kind_or_type -- | This variant of 'kindGeneralize' refuses to generalize over any -- variables free in the given WantedConstraints. Instead, it promotes --- these variables into an outer TcLevel. See also +-- these variables into an outer TcLevel. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. See also -- Note [Promoting unification variables] in TcSimplify kindGeneralizeLocal :: WantedConstraints -> TcType -> TcM [KindVar] kindGeneralizeLocal wanted kind_or_type ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -759,14 +759,14 @@ writeMetaTyVar tyvar ty -- Everything from here on only happens if DEBUG is on | not (isTcTyVar tyvar) - = WARN( True, text "Writing to non-tc tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar ) return () | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar = writeMetaTyVarRef tyvar ref ty | otherwise - = WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar ) return () -------------------- @@ -1066,18 +1066,18 @@ we are trying to generalise this type: forall arg. ... (alpha[tau]:arg) ... We have a metavariable alpha whose kind mentions a skolem variable -boudn inside the very type we are generalising. +bound inside the very type we are generalising. This can arise while type-checking a user-written type signature (see the test case for the full code). We cannot generalise over alpha! That would produce a type like forall {a :: arg}. forall arg. ...blah... The fact that alpha's kind mentions arg renders it completely -ineligible for generaliation. +ineligible for generalisation. However, we are not going to learn any new constraints on alpha, -because its kind isn't even in scope in the outer context. So alpha -is entirely unconstrained. +because its kind isn't even in scope in the outer context (but see Wrinkle). +So alpha is entirely unconstrained. What then should we do with alpha? During generalization, every metavariable is either (A) promoted, (B) generalized, or (C) zapped @@ -1098,6 +1098,17 @@ We do this eager zapping in candidateQTyVars, which always precedes generalisation, because at that moment we have a clear picture of what skolems are in scope. +Wrinkle: + +We must make absolutely sure that alpha indeed is not +from an outer context. (Otherwise, we might indeed learn more information +about it.) This can be done easily: we just check alpha's TcLevel. +That level must be strictly greater than the ambient TcLevel in order +to treat it as naughty. We say "strictly greater than" because the call to +candidateQTyVars is made outside the bumped TcLevel, as stated in the +comment to candidateQTyVarsOfType. The level check is done in go_tv +in collect_cant_qtvs. Skipping this check caused #16517. + -} data CandidatesQTvs @@ -1145,13 +1156,17 @@ candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs) -- | Gathers free variables to use as quantification candidates (in -- 'quantifyTyVars'). This might output the same var -- in both sets, if it's used in both a type and a kind. +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) -- See Note [CandidatesQTvs determinism and order] -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty --- | Like 'splitDepVarsOfType', but over a list of types +-- | Like 'candidateQTyVarsOfType', but over a list of types +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys @@ -1175,7 +1190,7 @@ delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars collect_cand_qtvs :: Bool -- True <=> consider every fv in Type to be dependent - -> VarSet -- Bound variables (both locally bound and globally bound) + -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked -> TcM CandidatesQTvs @@ -1220,16 +1235,26 @@ collect_cand_qtvs is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv - | tv `elemDVarSet` kvs = return dv -- We have met this tyvar aleady + | tv `elemDVarSet` kvs + = return dv -- We have met this tyvar aleady + | not is_dep - , tv `elemDVarSet` tvs = return dv -- We have met this tyvar aleady + , tv `elemDVarSet` tvs + = return dv -- We have met this tyvar aleady + | otherwise = do { tv_kind <- zonkTcType (tyVarKind tv) -- This zonk is annoying, but it is necessary, both to -- ensure that the collected candidates have zonked kinds -- (Trac #15795) and to make the naughty check -- (which comes next) works correctly - ; if intersectsVarSet bound (tyCoVarsOfType tv_kind) + + ; cur_lvl <- getTcLevel + ; if tcTyVarLevel tv `strictlyDeeperThan` cur_lvl && + -- this tyvar is from an outer context: see Wrinkle + -- in Note [Naughty quantification candidates] + + intersectsVarSet bound (tyCoVarsOfType tv_kind) then -- See Note [Naughty quantification candidates] do { traceTc "Zapping naughty quantifier" (pprTyVar tv) ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2427,12 +2427,13 @@ tcRnType hsc_env normalise rdr_type -- It can have any rank or kind -- First bring into scope any wildcards ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; ((ty, kind), lie) <- - captureConstraints $ + ; (ty, kind) <- pushTcLevelM_ $ + -- must push level to satisfy level precondition of + -- kindGeneralize, below + solveEqualities $ tcWildCardBinders wcs $ \ wcs' -> do { emitWildCardHoleConstraints wcs' ; tcLHsTypeUnsaturated rn_type } - ; _ <- checkNoErrs (simplifyInteractive lie) -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -2095,6 +2095,16 @@ see dropDerivedWC. For example [D] Int ~ Bool, and we don't want to report that because it's incomprehensible. That is why we don't rewrite wanteds with wanteds! + * We might float out some Wanteds from an implication, leaving behind + their insoluble Deriveds. For example: + + forall a[2]. [W] alpha[1] ~ Int + [W] alpha[1] ~ Bool + [D] Int ~ Bool + + The Derived is insoluble, but we very much want to drop it when floating + out. + But (tiresomely) we do keep *some* Derived constraints: * Type holes are derived constraints, because they have no evidence @@ -2103,8 +2113,7 @@ But (tiresomely) we do keep *some* Derived constraints: * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with KindEqOrigin, may arise from a type equality a ~ Int#, say. See Note [Equalities with incompatible kinds] in TcCanonical. - These need to be kept because the kind equalities might have different - source locations and hence different error messages. + Keeping these around produces better error messages, in practice. E.g., test case dependent/should_fail/T11471 * We keep most derived equalities arising from functional dependencies ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -152,8 +152,26 @@ solveLocalEqualities :: String -> TcM a -> TcM a solveLocalEqualities callsite thing_inside = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside ; emitConstraints wanted + + -- See Note [Fail fast if there are insoluble kind equalities] + ; when (insolubleWC wanted) $ + failM + ; return res } +{- Note [Fail fast if there are insoluble kind equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Rather like in simplifyInfer, fail fast if there is an insoluble +constraint. Otherwise we'll just succeed in kind-checking a nonsense +type, with a cascade of follow-up errors. + +For example polykinds/T12593, T15577, and many others. + +Take care to ensure that you emit the insoluble constraints before +failing, because they are what will ulimately lead to the error +messsage! +-} + solveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a) solveLocalEqualitiesX callsite thing_inside = do { traceTc "solveLocalEqualitiesX {" (vcat [ text "Called from" <+> text callsite ]) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -542,10 +542,15 @@ generaliseTcTyCon tc tc_res_kind = tyConResKind tc tc_tvs = tyConTyVars tc user_tyvars = tcTyConUserTyVars tc -- ToDo: nuke + spec_req_prs = tcTyConScopedTyVars tc - (scoped_tv_names, scoped_tvs) = unzip (tcTyConScopedTyVars tc) - -- NB: scoped_tvs includes both specified and required (tc_tvs) - -- ToDo: Is this a good idea? + (spec_req_names, spec_req_tvs) = unzip spec_req_prs + -- NB: spec_req_tvs includes both Specified and Required + -- Running example in Note [Inferring kinds for type declarations] + -- spec_req_prs = [ ("k1",kk1), ("a", (aa::kk1)) + -- , ("k2",kk2), ("x", (xx::kk2))] + -- where "k1" dnotes the Name k1, and kk1, aa, etc are MetaTyVars, + -- specifically TyVarTvs -- Step 1: find all the variables we want to quantify over, -- including Inferred, Specfied, and Required @@ -1038,9 +1043,11 @@ kcTyClDecl (ClassDecl { tcdLName = (dL->L _ name) do { _ <- tcHsContext ctxt ; mapM_ (wrapLocM_ kc_sig) sigs } where - kc_sig (ClassOpSig _ _ nms op_ty) = kcHsSigType nms op_ty + kc_sig (ClassOpSig _ _ nms op_ty) = kcClassSigType skol_info nms op_ty kc_sig _ = return () + skol_info = TyConSkol ClassFlavour name + kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name) , fdInfo = fd_info })) -- closed type families look at their equations, but other families don't ===================================== compiler/typecheck/TcType.hs ===================================== @@ -516,6 +516,17 @@ superSkolemTv = SkolemTv topTcLevel True -- Treat this as a completely disti -- The choice of level number here is a bit dodgy, but -- topTcLevel works in the places that vanillaSkolemTv is used +instance Outputable TcTyVarDetails where + ppr = pprTcTyVarDetails + +pprTcTyVarDetails :: TcTyVarDetails -> SDoc +-- For debugging +pprTcTyVarDetails (RuntimeUnk {}) = text "rt" +pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl +pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl +pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) + = ppr info <> colon <> ppr tclvl + ----------------------------- data MetaDetails = Flexi -- Flexi type variables unify to become Indirects @@ -544,20 +555,11 @@ instance Outputable MetaDetails where ppr Flexi = text "Flexi" ppr (Indirect ty) = text "Indirect" <+> ppr ty -pprTcTyVarDetails :: TcTyVarDetails -> SDoc --- For debugging -pprTcTyVarDetails (RuntimeUnk {}) = text "rt" -pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl -pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl -pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) - = pp_info <> colon <> ppr tclvl - where - pp_info = case info of - TauTv -> text "tau" - TyVarTv -> text "tyv" - FlatMetaTv -> text "fmv" - FlatSkolTv -> text "fsk" - +instance Outputable MetaInfo where + ppr TauTv = text "tau" + ppr TyVarTv = text "tyv" + ppr FlatMetaTv = text "fmv" + ppr FlatSkolTv = text "fsk" {- ********************************************************************* * * @@ -795,10 +797,10 @@ checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl +-- Returns topTcLevel for non-TcTyVars tcTyVarLevel :: TcTyVar -> TcLevel tcTyVarLevel tv - = ASSERT2( tcIsTcTyVar tv, ppr tv ) - case tcTyVarDetails tv of + = case tcTyVarDetails tv of MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl SkolemTv tv_lvl _ -> tv_lvl RuntimeUnk -> topTcLevel ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/ghci/scripts/T16767.script ===================================== @@ -0,0 +1,3 @@ +:set -fprint-explicit-foralls -fprint-explicit-kinds -XTypeApplications -XDataKinds +import Data.Proxy +:kind! 'Proxy @_ ===================================== testsuite/tests/ghci/scripts/T16767.stdout ===================================== @@ -0,0 +1,2 @@ +'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _ += 'Proxy @{k} @_ ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -296,3 +296,4 @@ test('T16030', normal, ghci_script, ['T16030.script']) test('T11606', normal, ghci_script, ['T11606.script']) test('T16089', normal, ghci_script, ['T16089.script']) test('T16527', normal, ghci_script, ['T16527.script']) +test('T16767', normal, ghci_script, ['T16767.script']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_fail/T16517.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE PolyKinds #-} +module T16517 where + +import Data.Proxy +class C a where m :: Proxy (a :: k) ===================================== testsuite/tests/typecheck/should_fail/T16517.stderr ===================================== @@ -0,0 +1,6 @@ + +T16517.hs:5:29: error: + • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘Proxy’, namely ‘(a :: k)’ + In the type signature: m :: Proxy (a :: k) + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -511,3 +511,4 @@ test('T16059e', [extra_files(['T16059b.hs'])], multimod_compile_fail, ['T16059e', '-v0']) test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) +test('T16517', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail134.stderr ===================================== @@ -2,6 +2,5 @@ tcfail134.hs:5:33: error: • Expecting one more argument to ‘XML’ Expected a type, but ‘XML’ has kind ‘* -> Constraint’ - • In the type signature: - toXML :: a -> XML + • In the type signature: toXML :: a -> XML In the class declaration for ‘XML’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/db09cb59b386073f53ac5dad8d320f7a5ed22bee...6a8a448319cbfc7af23dffec33015562d992101b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/db09cb59b386073f53ac5dad8d320f7a5ed22bee...6a8a448319cbfc7af23dffec33015562d992101b You're receiving 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 Jun 12 12:40:43 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:40:43 -0400 Subject: [Git][ghc/ghc][wip/backport-MR706] 8 commits: testsuite: Introduce fragile modifier Message-ID: <5d00f2cbb71c7_3b3a3f9f3030a4d01315a7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-MR706 at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - ce1e6538 by Phuong Trinh at 2019-06-12T12:40:33Z Use binary search to speedup checkUnload We are iterating through all object code for each heap objects when checking whether object code can be unloaded. For large projects in GHCi, this can be very expensive due to the large number of object code that needs to be loaded/unloaded. To speed it up, this arrangess all mapped sections of unloaded object code in a sorted array and use binary search to check if an address location fall on them. (cherry picked from commit f81f3964b718eab21f0cfe65067c195f2f2a84bd) - - - - - 13 changed files: - libraries/base/tests/all.T - rts/CheckUnload.c - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/profiling/should_run/all.T - + testsuite/tests/rts/unload_multiple_objs/A.hs - + testsuite/tests/rts/unload_multiple_objs/B.hs - + testsuite/tests/rts/unload_multiple_objs/C.hs - + testsuite/tests/rts/unload_multiple_objs/D.hs - + testsuite/tests/rts/unload_multiple_objs/Makefile - + testsuite/tests/rts/unload_multiple_objs/all.T - + testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.c - + testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.stdout Changes: ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== rts/CheckUnload.c ===================================== @@ -38,30 +38,130 @@ // object as referenced so that it won't get unloaded in this round. // -static void checkAddress (HashTable *addrs, const void *addr) +// Note [Speeding up checkUnload] +// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +// In certain circumstances, there may be a lot of unloaded ObjectCode structs +// chained in `unloaded_objects` (such as when users `:load` a module in a very +// big repo in GHCi). To speed up checking whether an address lies within any of +// these objects, we populate the addresses of their mapped sections in +// an array sorted by their `start` address and do binary search for our address +// on that array. Note that this works because the sections are mapped to mutual +// exclusive memory regions, so we can simply find the largest lower bound among +// the `start` addresses of the sections and then check if our address is inside +// that section. In particular, we store the start address and end address of +// each mapped section in a OCSectionIndex, arrange them all on a contiguous +// memory range and then sort by start address. We then put this array in an +// OCSectionIndices struct to be passed into `checkAddress` to do binary search +// on. +// + +typedef struct { + W_ start; + W_ end; + ObjectCode *oc; +} OCSectionIndex; + +typedef struct { + int n_sections; + OCSectionIndex *indices; +} OCSectionIndices; + +static OCSectionIndices *createOCSectionIndices(int n_sections) +{ + OCSectionIndices *s_indices; + s_indices = stgMallocBytes(sizeof(OCSectionIndices), "OCSectionIndices"); + s_indices->n_sections = n_sections; + s_indices->indices = stgMallocBytes(n_sections*sizeof(OCSectionIndex), + "OCSectionIndices::indices"); + return s_indices; +} + +static int cmpSectionIndex(const void* indexa, const void *indexb) +{ + W_ s1 = ((OCSectionIndex*)indexa)->start; + W_ s2 = ((OCSectionIndex*)indexb)->start; + if (s1 < s2) { + return -1; + } else if (s1 > s2) { + return 1; + } + return 0; +} + +static OCSectionIndices* buildOCSectionIndices(ObjectCode *ocs) +{ + int cnt_sections = 0; + ObjectCode *oc; + for (oc = ocs; oc; oc = oc->next) { + cnt_sections += oc->n_sections; + } + OCSectionIndices* s_indices = createOCSectionIndices(cnt_sections); + int s_i = 0, i; + for (oc = ocs; oc; oc = oc->next) { + for (i = 0; i < oc->n_sections; i++) { + if (oc->sections[i].kind != SECTIONKIND_OTHER) { + s_indices->indices[s_i].start = (W_)oc->sections[i].start; + s_indices->indices[s_i].end = (W_)oc->sections[i].start + + oc->sections[i].size; + s_indices->indices[s_i].oc = oc; + s_i++; + } + } + } + s_indices->n_sections = s_i; + qsort(s_indices->indices, + s_indices->n_sections, + sizeof(OCSectionIndex), + cmpSectionIndex); + return s_indices; +} + +static void freeOCSectionIndices(OCSectionIndices *section_indices) +{ + free(section_indices->indices); + free(section_indices); +} + +static ObjectCode *findOC(OCSectionIndices *s_indices, const void *addr) { + W_ w_addr = (W_)addr; + if (s_indices->n_sections <= 0) return NULL; + if (w_addr < s_indices->indices[0].start) return NULL; + + int left = 0, right = s_indices->n_sections; + while (left + 1 < right) { + int mid = (left + right)/2; + W_ w_mid = s_indices->indices[mid].start; + if (w_mid <= w_addr) { + left = mid; + } else { + right = mid; + } + } + ASSERT(w_addr >= s_indices->indices[left].start); + if (w_addr < s_indices->indices[left].end) { + return s_indices->indices[left].oc; + } + return NULL; +} + +static void checkAddress (HashTable *addrs, const void *addr, + OCSectionIndices *s_indices) { ObjectCode *oc; - int i; if (!lookupHashTable(addrs, (W_)addr)) { insertHashTable(addrs, (W_)addr, addr); - for (oc = unloaded_objects; oc; oc = oc->next) { - for (i = 0; i < oc->n_sections; i++) { - if (oc->sections[i].kind != SECTIONKIND_OTHER) { - if ((W_)addr >= (W_)oc->sections[i].start && - (W_)addr < (W_)oc->sections[i].start - + oc->sections[i].size) { - oc->referenced = 1; - return; - } - } - } + oc = findOC(s_indices, addr); + if (oc != NULL) { + oc->referenced = 1; + return; } } } -static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) +static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end, + OCSectionIndices *s_indices) { StgPtr p; const StgRetInfoTable *info; @@ -73,7 +173,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) switch (info->i.type) { case RET_SMALL: case RET_BIG: - checkAddress(addrs, (const void*)info); + checkAddress(addrs, (const void*)info, s_indices); break; default: @@ -85,7 +185,8 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end) } -static void searchHeapBlocks (HashTable *addrs, bdescr *bd) +static void searchHeapBlocks (HashTable *addrs, bdescr *bd, + OCSectionIndices *s_indices) { StgPtr p; const StgInfoTable *info; @@ -189,7 +290,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) prim = true; size = ap_stack_sizeW(ap); searchStackChunk(addrs, (StgPtr)ap->payload, - (StgPtr)ap->payload + ap->size); + (StgPtr)ap->payload + ap->size, s_indices); break; } @@ -223,7 +324,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) StgStack *stack = (StgStack*)p; prim = true; searchStackChunk(addrs, stack->sp, - stack->stack + stack->stack_size); + stack->stack + stack->stack_size, s_indices); size = stack_sizeW(stack); break; } @@ -238,7 +339,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) } if (!prim) { - checkAddress(addrs,info); + checkAddress(addrs,info, s_indices); } p += size; @@ -251,15 +352,16 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd) // Do not unload the object if the CCS tree refers to a CCS or CC which // originates in the object. // -static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs) +static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs, + OCSectionIndices* s_indices) { IndexTable *i; - checkAddress(addrs, ccs); - checkAddress(addrs, ccs->cc); + checkAddress(addrs, ccs, s_indices); + checkAddress(addrs, ccs->cc, s_indices); for (i = ccs->indexTable; i != NULL; i = i->next) { if (!i->back_edge) { - searchCostCentres(addrs, i->ccs); + searchCostCentres(addrs, i->ccs, s_indices); } } } @@ -288,6 +390,7 @@ void checkUnload (StgClosure *static_objects) ACQUIRE_LOCK(&linker_unloaded_mutex); + OCSectionIndices *s_indices = buildOCSectionIndices(unloaded_objects); // Mark every unloadable object as unreferenced initially for (oc = unloaded_objects; oc; oc = oc->next) { IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n", @@ -299,7 +402,7 @@ void checkUnload (StgClosure *static_objects) for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); info = get_itbl(p); link = *STATIC_LINK(info, p); } @@ -309,32 +412,33 @@ void checkUnload (StgClosure *static_objects) p != END_OF_CAF_LIST; p = ((StgIndStatic *)p)->static_link) { p = UNTAG_STATIC_LIST_PTR(p); - checkAddress(addrs, p); + checkAddress(addrs, p, s_indices); } for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - searchHeapBlocks (addrs, generations[g].blocks); - searchHeapBlocks (addrs, generations[g].large_objects); + searchHeapBlocks (addrs, generations[g].blocks, s_indices); + searchHeapBlocks (addrs, generations[g].large_objects, s_indices); for (n = 0; n < n_capabilities; n++) { ws = &gc_threads[n]->gens[g]; - searchHeapBlocks(addrs, ws->todo_bd); - searchHeapBlocks(addrs, ws->part_list); - searchHeapBlocks(addrs, ws->scavd_list); + searchHeapBlocks(addrs, ws->todo_bd, s_indices); + searchHeapBlocks(addrs, ws->part_list, s_indices); + searchHeapBlocks(addrs, ws->scavd_list, s_indices); } } #if defined(PROFILING) /* Traverse the cost centre tree, calling checkAddress on each CCS/CC */ - searchCostCentres(addrs, CCS_MAIN); + searchCostCentres(addrs, CCS_MAIN, s_indices); /* Also check each cost centre in the CC_LIST */ CostCentre *cc; for (cc = CC_LIST; cc != NULL; cc = cc->link) { - checkAddress(addrs, cc); + checkAddress(addrs, cc, s_indices); } #endif /* PROFILING */ + freeOCSectionIndices(s_indices); // Look through the unloadable objects, and any object that is still // marked as unreferenced can be physically unloaded, because we // have no references to it. ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) ===================================== testsuite/tests/rts/unload_multiple_objs/A.hs ===================================== @@ -0,0 +1,16 @@ +module A where + +import Foreign.StablePtr + +id1 :: Int +id1 = 1 + +createHeapObjectA :: IO (StablePtr [Int]) +createHeapObjectA = do + newStablePtr [2+id1] + +freeHeapObjectA :: StablePtr [Int] -> IO () +freeHeapObjectA obj = freeStablePtr obj + +foreign export ccall createHeapObjectA :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectA :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/unload_multiple_objs/B.hs ===================================== @@ -0,0 +1,16 @@ +module B where + +import Foreign.StablePtr + +id2 :: Int +id2 = 2 + +createHeapObjectB :: IO (StablePtr [Int]) +createHeapObjectB = do + newStablePtr [2+id2] + +freeHeapObjectB :: StablePtr [Int] -> IO () +freeHeapObjectB obj = freeStablePtr obj + +foreign export ccall createHeapObjectB :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectB :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/unload_multiple_objs/C.hs ===================================== @@ -0,0 +1,16 @@ +module C where + +import Foreign.StablePtr + +id3 :: Int +id3 = 3 + +createHeapObjectC :: IO (StablePtr [Int]) +createHeapObjectC = do + newStablePtr [2+id3] + +freeHeapObjectC :: StablePtr [Int] -> IO () +freeHeapObjectC obj = freeStablePtr obj + +foreign export ccall createHeapObjectC :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectC :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/unload_multiple_objs/D.hs ===================================== @@ -0,0 +1,16 @@ +module D where + +import Foreign.StablePtr + +id4 :: Int +id4 = 4 + +createHeapObjectD :: IO (StablePtr [Int]) +createHeapObjectD = do + newStablePtr [2+id4] + +freeHeapObjectD :: StablePtr [Int] -> IO () +freeHeapObjectD obj = freeStablePtr obj + +foreign export ccall createHeapObjectD :: IO (StablePtr [Int]) +foreign export ccall freeHeapObjectD :: StablePtr [Int] -> IO () ===================================== testsuite/tests/rts/unload_multiple_objs/Makefile ===================================== @@ -0,0 +1,17 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: linker_unload_multiple_objs +linker_unload_multiple_objs: + $(RM) A.o B.o C.o D.o + $(RM) A.hi B.hi C.hi D.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c B.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c C.hs -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) -c D.hs -v0 + # -rtsopts causes a warning + "$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload_multiple_objs.c -o linker_unload_multiple_objs -no-hs-main -optc-Werror + ./linker_unload_multiple_objs "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + + ===================================== testsuite/tests/rts/unload_multiple_objs/all.T ===================================== @@ -0,0 +1,4 @@ +test('linker_unload_multiple_objs', + [extra_files(['../LinkerUnload.hs', 'A.hs', 'B.hs', 'C.hs', 'D.hs',]), + when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], + run_command, ['$MAKE -s --no-print-directory linker_unload_multiple_objs']) ===================================== testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.c ===================================== @@ -0,0 +1,147 @@ +#include "ghcconfig.h" +#include +#include +#include "Rts.h" +#include +#include "HsFFI.h" + +extern void loadPackages(void); + +#define NUM_OBJS 4 + +static char *objs[NUM_OBJS] = {"A.o", "B.o", "C.o", "D.o"}; + +pathchar* toPathchar(char* path) +{ +#if defined(mingw32_HOST_OS) + size_t required = strlen(path); + pathchar *ret = (pathchar*)malloc(sizeof(pathchar) * (required + 1)); + if (mbstowcs(ret, path, required) == (size_t)-1) + { + errorBelch("toPathchar failed converting char* to wchar_t*: %s", path); + exit(1); + } + ret[required] = '\0'; + return ret; +#else + return path; +#endif +} + +void load_and_resolve_all_objects() { + int i, r; + for (i = 0; i < NUM_OBJS; i++) { + r = loadObj(toPathchar(objs[i])); + if (!r) { + errorBelch("loadObj(%s) failed", objs[i]); + exit(1); + } + } + + r = resolveObjs(); + if (!r) { + errorBelch("resolveObjs failed"); + exit(1); + } + + for (i = 0; i < NUM_OBJS; i++) { + char sym_name[138] = {0}; +#if LEADING_UNDERSCORE + sprintf(sym_name, "_createHeapObject%c", 'A'+i); +#else + sprintf(sym_name, "createHeapObject%c", 'A'+i); +#endif + void *sym_addr = lookupSymbol(sym_name); + if (!sym_addr) { + errorBelch("lookupSymbol(%s) failed", sym_name); + exit(1); + } + } +} + +void check_object_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_NOT_LOADED) { + errorBelch("object %s status != OBJECT_NOT_LOADED", obj_path); + exit(1); + } +} + +void check_object_unloaded_but_not_freed(char *obj_path) { + OStatus st; + st = getObjectLoadStatus(toPathchar(obj_path)); + if (st != OBJECT_UNLOADED) { + errorBelch("object %s status != OBJECT_UNLOADED, is %d instead", obj_path, st); + exit(1); + } +} + +void test_no_dangling_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); + +} + +typedef HsStablePtr stableptrfun_t(void); +typedef void freeptrfun_t(HsStablePtr); + +void test_still_has_references_to_unloaded_objects() +{ + load_and_resolve_all_objects(); +#if LEADING_UNDERSCORE + stableptrfun_t *createHeapObject = lookupSymbol("_createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("_freeHeapObjectD"); +#else + stableptrfun_t *createHeapObject = lookupSymbol("createHeapObjectD"); + freeptrfun_t *freeHeapObject = lookupSymbol("freeHeapObjectD"); +#endif + HsStablePtr ptr = createHeapObject(); + + unloadObj(toPathchar("A.o")); + unloadObj(toPathchar("B.o")); + unloadObj(toPathchar("C.o")); + unloadObj(toPathchar("D.o")); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_unloaded_but_not_freed("D.o"); + + + freeHeapObject(ptr); + performMajorGC(); + + check_object_freed("A.o"); + check_object_freed("B.o"); + check_object_freed("C.o"); + check_object_freed("D.o"); +} + +int main (int argc, char *argv[]) +{ + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + initLinker_(0); + loadPackages(); + + test_still_has_references_to_unloaded_objects(); + test_no_dangling_references_to_unloaded_objects(); + + hs_exit(); + exit(0); +} ===================================== testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 1] Compiling LinkerUnload ( LinkerUnload.hs, LinkerUnload.o ) +Linking linker_unload_multiple_objs ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48f58fbcecbdc650fef4a7292c814bbf101fd9bd...ce1e6538dd15c145394497aa6721b17c610ac1d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48f58fbcecbdc650fef4a7292c814bbf101fd9bd...ce1e6538dd15c145394497aa6721b17c610ac1d6 You're receiving 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 Jun 12 12:40:52 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:40:52 -0400 Subject: [Git][ghc/ghc][wip/backport-MR769] 10 commits: testsuite: Introduce fragile modifier Message-ID: <5d00f2d4a15f4_3b3a3f9f3aa4de401321e4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-MR769 at Glasgow Haskell Compiler / GHC Commits: 175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Introduce fragile modifier Now since we have been a bit more stringent in testsuite cleanliness we have been marking a lot of tests as fragile using the `skip` modifier. However, this unfortunately means that we lose the association with the ticket number documenting the fragility. Here we introduce `fragile` and `fragile_for` to retain this information. (cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6) - - - - - 18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on i386 (cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682) - - - - - a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark heapprof001 as fragile on all platforms See #15382. (cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2) - - - - - 9c385294 by Ben Gamari at 2019-06-12T00:07:25Z base: Mark CPUTime001 as fragile As noted in #16224, CPUTime001 has been quite problematic, reporting non-monotonic timestamps in CI. Unfortunately I've been unable to reproduce this locally. (cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097) - - - - - c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. (cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503) - - - - - 5993703c by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Fix fragile_for test modifier (cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d) - - - - - 5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. (cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39) - - - - - c4b501b1 by Takenobu Tani at 2019-06-12T12:39:41Z Add `-haddock` option under ci condition to fix #16415 In order to use the `:doc` command in ghci, it is necessary to compile for core libraries with `-haddock` option. Especially, the `-haddock` option is essential for release building. Note: * The `-haddock` option may affect compile time and binary size. * But hadrian has already set `-haddock` as the default. * This patch affects the make-based building. This patch has been split from !532. (cherry picked from commit 33e37d0619a9d1d0b8088a109f7eeb4c6fd21027) - - - - - b51f9ecd by Takenobu Tani at 2019-06-12T12:39:41Z Add `-haddock` to perf.mk rather than prepare-system.sh To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `mk/flavours/perf.mk` rather than `.circleci/prepare-system.sh`. Because in windows condition of ghc-8.9, `mk/flavours/*` is included after `prepare-system.sh`. In addition, in linux condition of ghc-8.6, `mk/flavors/perf.mk` is used. (cherry picked from commit 43a39c3c2195d5b4400efc845a54f153184b1d7f) - - - - - ca7173a9 by Takenobu Tani at 2019-06-12T12:39:41Z Add `-haddock` to prepare-system.sh and .gitlab-ci.yml To cover ci conditions from ghc8.6 to 8.9, I add `-haddock` option to `.circleci/prepare-system.sh` and .gitlab-ci.yml. after including `mk/flavours/*`. (cherry picked from commit c4f94320a7048a7f263d8d952d4e12cc0227cf72) - - - - - 6 changed files: - .circleci/prepare-system.sh - .gitlab-ci.yml - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/profiling/should_run/all.T Changes: ===================================== .circleci/prepare-system.sh ===================================== @@ -30,6 +30,7 @@ BuildFlavour=$BUILD_FLAVOUR ifneq "\$(BuildFlavour)" "" include mk/flavours/\$(BuildFlavour).mk endif +GhcLibHcOpts+=-haddock EOF case "$(uname)" in ===================================== .gitlab-ci.yml ===================================== @@ -563,6 +563,7 @@ nightly-i386-windows-hadrian: python boot bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" + - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1" - bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' ===================================== libraries/base/tests/all.T ===================================== @@ -20,7 +20,7 @@ test('tempfiles', normal, 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']) -test('CPUTime001', normal, compile_and_run, ['']) +test('CPUTime001', fragile(16224), compile_and_run, ['']) test('readLitChar', normal, compile_and_run, ['']) test('unicode001', when(platform('i386-unknown-openbsd'), expect_fail), @@ -231,5 +231,5 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', normal, compile_and_run, ['']) +test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, ['']) ===================================== testsuite/driver/testlib.py ===================================== @@ -225,11 +225,35 @@ def _expect_pass(way): # ----- +def fragile( bug ): + """ + Indicates that the test should be skipped due to fragility documented in + the given ticket. + """ + def helper( name, opts, bug=bug ): + record_broken(name, opts, bug) + opts.skip = True + + return helper + +def fragile_for( bug, ways ): + """ + Indicates that the test should be skipped due to fragility in the given + test ways as documented in the given ticket. + """ + def helper( name, opts, bug=bug, ways=ways ): + record_broken(name, opts, bug) + opts.omit_ways += ways + + return helper + +# ----- + def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, ['']) test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 -test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, ['']) test('T9379', normal, compile_and_run, ['']) ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for( test('heapprof001', [when(have_profiling(), extra_ways(extra_prof_ways)), - when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])), + fragile(15382), extra_run_opts('7')], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b867c2c379330d212b3c223e4b5cfc49defc0e61...ca7173a9902184d4f76957765a352715d75c2670 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b867c2c379330d212b3c223e4b5cfc49defc0e61...ca7173a9902184d4f76957765a352715d75c2670 You're receiving 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 Jun 12 12:45:23 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:45:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR1137 Message-ID: <5d00f3e3a6eef_3b3a3f9f31c8fb081327a7@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR1137 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR1137 You're receiving 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 Jun 12 12:46:52 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:46:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR1160 Message-ID: <5d00f43c87ae1_3b3a3f9f561a2f041342a9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR1160 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR1160 You're receiving 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 Jun 12 12:48:00 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 08:48:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-MR1139 Message-ID: <5d00f48038ca6_3b3addedfac1359f9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backport-MR1139 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/backport-MR1139 You're receiving 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 Jun 12 13:19:29 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 09:19:29 -0400 Subject: [Git][ghc/ghc][wip/backport-MR951] Fix #16517 by bumping the TcLevel for method sigs Message-ID: <5d00fbe12c48c_3b3a3f9f34788b70140311@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-MR951 at Glasgow Haskell Compiler / GHC Commits: e2447c00 by Richard Eisenberg at 2019-06-12T13:19:18Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 (cherry picked from commit a22e51ea6f7a046c87d57ce30d143eef6abee9ff) - - - - - 16 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - + testsuite/tests/ghci/scripts/T16767.script - + testsuite/tests/ghci/scripts/T16767.stdout - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/typecheck/should_fail/T16517.hs - + testsuite/tests/typecheck/should_fail/T16517.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail134.stderr Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -2079,13 +2079,6 @@ What do we do when we have an equality where k1 and k2 differ? This Note explores this treacherous area. -First off, the question above is slightly the wrong question. Flattening -a tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening -the kind might introduce a cast. So we might have a casted tyvar on the -left. We thus revise our test case to - - (tv |> co :: k1) ~ (rhs :: k2) - We must proceed differently here depending on whether we have a Wanted or a Given. Consider this: @@ -2109,36 +2102,33 @@ The reason for this odd behavior is much the same as Note [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the new `co` is a Wanted. - The solution is then not to use `co` to "rewrite" -- that is, cast - -- `w`, but instead to keep `w` heterogeneous and - irreducible. Given that we're not using `co`, there is no reason to - collect evidence for it, so `co` is born a Derived, with a CtOrigin - of KindEqOrigin. +The solution is then not to use `co` to "rewrite" -- that is, cast -- `w`, but +instead to keep `w` heterogeneous and irreducible. Given that we're not using +`co`, there is no reason to collect evidence for it, so `co` is born a +Derived, with a CtOrigin of KindEqOrigin. When the Derived is solved (by +unification), the original wanted (`w`) will get kicked out. We thus get -When the Derived is solved (by unification), the original wanted (`w`) -will get kicked out. +[D] _ :: k ~ Type +[W] w :: (alpha :: k) ~ (Int :: Type) -Note that, if we had [G] co1 :: k ~ Type available, then none of this code would -trigger, because flattening would have rewritten k to Type. That is, -`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar -case will trigger, correctly rewriting alpha to (Int |> sym co1). +Note that the Wanted is unchanged and will be irreducible. This all happens +in canEqTyVarHetero. + +Note that, if we had [G] co1 :: k ~ Type available, then we never get +to canEqTyVarHetero: canEqTyVar tries flattening the kinds first. If +we have [G] co1 :: k ~ Type, then flattening the kind of alpha would +rewrite k to Type, and we would end up in canEqTyVarHomo. Successive canonicalizations of the same Wanted may produce duplicate Deriveds. Similar duplications can happen with fundeps, and there seems to be no easy way to avoid. I expect this case to be rare. -For Givens, this problem doesn't bite, so a heterogeneous Given gives +For Givens, this problem (the Wanteds-rewriting-Wanteds action of +a kind coercion) doesn't bite, so a heterogeneous Given gives rise to a Given kind equality. No Deriveds here. We thus homogenise -the Given (see the "homo_co" in the Given case in canEqTyVar) and +the Given (see the "homo_co" in the Given case in canEqTyVarHetero) and carry on with a homogeneous equality constraint. -Separately, I (Richard E) spent some time pondering what to do in the case -that we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2 -differ. Note that the tv is the same. (This case is handled as the first -case in canEqTyVarHomo.) At one point, I thought we could solve this limited -form of heterogeneous Wanted, but I then reconsidered and now treat this case -just like any other heterogeneous Wanted. - Note [Type synonyms and canonicalization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We treat type synonym applications as xi types, that is, they do not ===================================== compiler/typecheck/TcErrors.hs ===================================== @@ -158,14 +158,22 @@ reportUnsolved wanted -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on -- However, do not make any evidence bindings, because we don't -- have any convenient place to put them. +-- NB: Type-level holes are OK, because there are no bindings. -- See Note [Deferring coercion errors to runtime] -- Used by solveEqualities for kind equalities --- (see Note [Fail fast on kind errors] in TcSimplify] +-- (see Note [Fail fast on kind errors] in TcSimplify) -- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = do { ev_binds <- newNoTcEvBinds - ; report_unsolved TypeError HoleError HoleError HoleError + + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures + ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures + ; let type_holes | not partial_sigs = HoleError + | warn_partial_sigs = HoleWarn + | otherwise = HoleDefer + + ; report_unsolved TypeError HoleError type_holes HoleError ev_binds wanted } -- | Report all unsolved goals as warnings (but without deferring any errors to ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -11,7 +11,7 @@ module TcHsType ( -- Type signatures - kcHsSigType, tcClassSigType, + kcClassSigType, tcClassSigType, tcHsSigType, tcHsSigWcType, tcHsPartialSigType, funsSigCtxt, addSigCtxt, pprSigCtxt, @@ -187,24 +187,40 @@ tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type -- already checked this, so we can simply ignore it. tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty) -kcHsSigType :: [Located Name] -> LHsSigType GhcRn -> TcM () -kcHsSigType names (HsIB { hsib_body = hs_ty - , hsib_ext = sig_vars }) - = addSigCtxt (funsSigCtxt names) hs_ty $ - discardResult $ - bindImplicitTKBndrs_Skol sig_vars $ - tc_lhs_type typeLevelMode hs_ty liftedTypeKind - -kcHsSigType _ (XHsImplicitBndrs _) = panic "kcHsSigType" +kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () +kcClassSigType skol_info names sig_ty + = discardResult $ + tcClassSigType skol_info names sig_ty + -- tcClassSigType does a fair amount of extra work that we don't need, + -- such as ordering quantified variables. But we absolutely do need + -- to push the level when checking method types and solve local equalities, + -- and so it seems easier just to call tcClassSigType than selectively + -- extract the lines of code from tc_hs_sig_type that we really need. + -- If we don't push the level, we get #16517, where GHC accepts + -- class C a where + -- meth :: forall k. Proxy (a :: k) -> () + -- Note that k is local to meth -- this is hogwash. 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) $ - tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) -- Do not zonk-to-Type, nor perform a validity check -- We are in a knot with the class and associated types -- Zonking and validity checking is done by tcClassDecl + -- No need to fail here if the type has an error: + -- If we're in the kind-checking phase, the solveEqualities + -- in kcTyClGroup catches the error + -- If we're in the type-checking phase, the solveEqualities + -- in tcClassDecl1 gets it + -- Failing fast here degrades the error message in, e.g., tcfail135: + -- class Foo f where + -- baa :: f a -> f + -- If we fail fast, we're told that f has kind `k1` when we wanted `*`. + -- It should be that f has kind `k2 -> *`, but we never get a chance + -- to run the solver where the kind of f is touchable. This is + -- painfully delicate. tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type -- Does validity checking @@ -214,10 +230,13 @@ tcHsSigType ctxt sig_ty do { traceTc "tcHsSigType {" (ppr sig_ty) -- Generalise here: see Note [Kind generalisation] - ; ty <- tc_hs_sig_type skol_info sig_ty - (expectedKindInCtxt ctxt) + ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty + (expectedKindInCtxt ctxt) ; ty <- zonkTcType ty + ; when insol failM + -- See Note [Fail fast if there are insoluble kind equalities] in TcSimplify + ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) ; return ty } @@ -225,12 +244,14 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM Type + -> ContextKind -> TcM (Bool, TcType) -- Kind-checks/desugars an 'LHsSigType', -- solve equalities, -- and then kind-generalizes. -- This will never emit constraints, as it uses solveEqualities interally. -- No validity checking or zonking +-- Returns also a Bool indicating whether the type induced an insoluble constraint; +-- True <=> constraint is insoluble tc_hs_sig_type skol_info hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { (tc_lvl, (wanted, (spec_tkvs, ty))) @@ -238,7 +259,6 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind solveLocalEqualitiesX "tc_hs_sig_type" $ bindImplicitTKBndrs_Skol sig_vars $ do { kind <- newExpectedKind ctxt_kind - ; tc_lhs_type typeLevelMode hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- should be in the global tyvars, and therefore won't be quantified @@ -249,9 +269,9 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs) tc_lvl wanted - ; return (mkInvForAllTys kvs ty1) } + ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) } -tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type_and_gen" +tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type" tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type -- tcTopLHsType is used for kind-checking top-level HsType where @@ -2056,7 +2076,8 @@ kindGeneralize :: TcType -> TcM [KindVar] -- Quantify the free kind variables of a kind or type -- In the latter case the type is closed, so it has no free -- type variables. So in both cases, all the free vars are kind vars --- Input needn't be zonked. +-- Input needn't be zonked. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. -- NB: You must call solveEqualities or solveLocalEqualities before -- kind generalization -- @@ -2074,7 +2095,8 @@ kindGeneralize kind_or_type -- | This variant of 'kindGeneralize' refuses to generalize over any -- variables free in the given WantedConstraints. Instead, it promotes --- these variables into an outer TcLevel. See also +-- these variables into an outer TcLevel. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. See also -- Note [Promoting unification variables] in TcSimplify kindGeneralizeLocal :: WantedConstraints -> TcType -> TcM [KindVar] kindGeneralizeLocal wanted kind_or_type ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -759,14 +759,14 @@ writeMetaTyVar tyvar ty -- Everything from here on only happens if DEBUG is on | not (isTcTyVar tyvar) - = WARN( True, text "Writing to non-tc tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar ) return () | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar = writeMetaTyVarRef tyvar ref ty | otherwise - = WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar ) return () -------------------- @@ -1066,18 +1066,18 @@ we are trying to generalise this type: forall arg. ... (alpha[tau]:arg) ... We have a metavariable alpha whose kind mentions a skolem variable -boudn inside the very type we are generalising. +bound inside the very type we are generalising. This can arise while type-checking a user-written type signature (see the test case for the full code). We cannot generalise over alpha! That would produce a type like forall {a :: arg}. forall arg. ...blah... The fact that alpha's kind mentions arg renders it completely -ineligible for generaliation. +ineligible for generalisation. However, we are not going to learn any new constraints on alpha, -because its kind isn't even in scope in the outer context. So alpha -is entirely unconstrained. +because its kind isn't even in scope in the outer context (but see Wrinkle). +So alpha is entirely unconstrained. What then should we do with alpha? During generalization, every metavariable is either (A) promoted, (B) generalized, or (C) zapped @@ -1098,6 +1098,17 @@ We do this eager zapping in candidateQTyVars, which always precedes generalisation, because at that moment we have a clear picture of what skolems are in scope. +Wrinkle: + +We must make absolutely sure that alpha indeed is not +from an outer context. (Otherwise, we might indeed learn more information +about it.) This can be done easily: we just check alpha's TcLevel. +That level must be strictly greater than the ambient TcLevel in order +to treat it as naughty. We say "strictly greater than" because the call to +candidateQTyVars is made outside the bumped TcLevel, as stated in the +comment to candidateQTyVarsOfType. The level check is done in go_tv +in collect_cant_qtvs. Skipping this check caused #16517. + -} data CandidatesQTvs @@ -1145,13 +1156,17 @@ candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs) -- | Gathers free variables to use as quantification candidates (in -- 'quantifyTyVars'). This might output the same var -- in both sets, if it's used in both a type and a kind. +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) -- See Note [CandidatesQTvs determinism and order] -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty --- | Like 'splitDepVarsOfType', but over a list of types +-- | Like 'candidateQTyVarsOfType', but over a list of types +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys @@ -1175,7 +1190,7 @@ delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars collect_cand_qtvs :: Bool -- True <=> consider every fv in Type to be dependent - -> VarSet -- Bound variables (both locally bound and globally bound) + -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked -> TcM CandidatesQTvs @@ -1220,16 +1235,26 @@ collect_cand_qtvs is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv - | tv `elemDVarSet` kvs = return dv -- We have met this tyvar aleady + | tv `elemDVarSet` kvs + = return dv -- We have met this tyvar aleady + | not is_dep - , tv `elemDVarSet` tvs = return dv -- We have met this tyvar aleady + , tv `elemDVarSet` tvs + = return dv -- We have met this tyvar aleady + | otherwise = do { tv_kind <- zonkTcType (tyVarKind tv) -- This zonk is annoying, but it is necessary, both to -- ensure that the collected candidates have zonked kinds -- (Trac #15795) and to make the naughty check -- (which comes next) works correctly - ; if intersectsVarSet bound (tyCoVarsOfType tv_kind) + + ; cur_lvl <- getTcLevel + ; if tcTyVarLevel tv `strictlyDeeperThan` cur_lvl && + -- this tyvar is from an outer context: see Wrinkle + -- in Note [Naughty quantification candidates] + + intersectsVarSet bound (tyCoVarsOfType tv_kind) then -- See Note [Naughty quantification candidates] do { traceTc "Zapping naughty quantifier" (pprTyVar tv) ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2427,12 +2427,13 @@ tcRnType hsc_env normalise rdr_type -- It can have any rank or kind -- First bring into scope any wildcards ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; ((ty, kind), lie) <- - captureConstraints $ + ; (ty, kind) <- pushTcLevelM_ $ + -- must push level to satisfy level precondition of + -- kindGeneralize, below + solveEqualities $ tcWildCardBinders wcs $ \ wcs' -> do { emitWildCardHoleConstraints wcs' ; tcLHsTypeUnsaturated rn_type } - ; _ <- checkNoErrs (simplifyInteractive lie) -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -2095,6 +2095,16 @@ see dropDerivedWC. For example [D] Int ~ Bool, and we don't want to report that because it's incomprehensible. That is why we don't rewrite wanteds with wanteds! + * We might float out some Wanteds from an implication, leaving behind + their insoluble Deriveds. For example: + + forall a[2]. [W] alpha[1] ~ Int + [W] alpha[1] ~ Bool + [D] Int ~ Bool + + The Derived is insoluble, but we very much want to drop it when floating + out. + But (tiresomely) we do keep *some* Derived constraints: * Type holes are derived constraints, because they have no evidence @@ -2103,8 +2113,7 @@ But (tiresomely) we do keep *some* Derived constraints: * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with KindEqOrigin, may arise from a type equality a ~ Int#, say. See Note [Equalities with incompatible kinds] in TcCanonical. - These need to be kept because the kind equalities might have different - source locations and hence different error messages. + Keeping these around produces better error messages, in practice. E.g., test case dependent/should_fail/T11471 * We keep most derived equalities arising from functional dependencies ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -152,8 +152,26 @@ solveLocalEqualities :: String -> TcM a -> TcM a solveLocalEqualities callsite thing_inside = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside ; emitConstraints wanted + + -- See Note [Fail fast if there are insoluble kind equalities] + ; when (insolubleWC wanted) $ + failM + ; return res } +{- Note [Fail fast if there are insoluble kind equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Rather like in simplifyInfer, fail fast if there is an insoluble +constraint. Otherwise we'll just succeed in kind-checking a nonsense +type, with a cascade of follow-up errors. + +For example polykinds/T12593, T15577, and many others. + +Take care to ensure that you emit the insoluble constraints before +failing, because they are what will ulimately lead to the error +messsage! +-} + solveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a) solveLocalEqualitiesX callsite thing_inside = do { traceTc "solveLocalEqualitiesX {" (vcat [ text "Called from" <+> text callsite ]) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -542,10 +542,15 @@ generaliseTcTyCon tc tc_res_kind = tyConResKind tc tc_tvs = tyConTyVars tc user_tyvars = tcTyConUserTyVars tc -- ToDo: nuke + spec_req_prs = tcTyConScopedTyVars tc - (scoped_tv_names, scoped_tvs) = unzip (tcTyConScopedTyVars tc) - -- NB: scoped_tvs includes both specified and required (tc_tvs) - -- ToDo: Is this a good idea? + (spec_req_names, spec_req_tvs) = unzip spec_req_prs + -- NB: spec_req_tvs includes both Specified and Required + -- Running example in Note [Inferring kinds for type declarations] + -- spec_req_prs = [ ("k1",kk1), ("a", (aa::kk1)) + -- , ("k2",kk2), ("x", (xx::kk2))] + -- where "k1" dnotes the Name k1, and kk1, aa, etc are MetaTyVars, + -- specifically TyVarTvs -- Step 1: find all the variables we want to quantify over, -- including Inferred, Specfied, and Required @@ -1038,9 +1043,11 @@ kcTyClDecl (ClassDecl { tcdLName = (dL->L _ name) do { _ <- tcHsContext ctxt ; mapM_ (wrapLocM_ kc_sig) sigs } where - kc_sig (ClassOpSig _ _ nms op_ty) = kcHsSigType nms op_ty + kc_sig (ClassOpSig _ _ nms op_ty) = kcClassSigType skol_info nms op_ty kc_sig _ = return () + skol_info = TyConSkol ClassFlavour name + kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name) , fdInfo = fd_info })) -- closed type families look at their equations, but other families don't ===================================== compiler/typecheck/TcType.hs ===================================== @@ -516,6 +516,17 @@ superSkolemTv = SkolemTv topTcLevel True -- Treat this as a completely disti -- The choice of level number here is a bit dodgy, but -- topTcLevel works in the places that vanillaSkolemTv is used +instance Outputable TcTyVarDetails where + ppr = pprTcTyVarDetails + +pprTcTyVarDetails :: TcTyVarDetails -> SDoc +-- For debugging +pprTcTyVarDetails (RuntimeUnk {}) = text "rt" +pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl +pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl +pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) + = ppr info <> colon <> ppr tclvl + ----------------------------- data MetaDetails = Flexi -- Flexi type variables unify to become Indirects @@ -544,20 +555,11 @@ instance Outputable MetaDetails where ppr Flexi = text "Flexi" ppr (Indirect ty) = text "Indirect" <+> ppr ty -pprTcTyVarDetails :: TcTyVarDetails -> SDoc --- For debugging -pprTcTyVarDetails (RuntimeUnk {}) = text "rt" -pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl -pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl -pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) - = pp_info <> colon <> ppr tclvl - where - pp_info = case info of - TauTv -> text "tau" - TyVarTv -> text "tyv" - FlatMetaTv -> text "fmv" - FlatSkolTv -> text "fsk" - +instance Outputable MetaInfo where + ppr TauTv = text "tau" + ppr TyVarTv = text "tyv" + ppr FlatMetaTv = text "fmv" + ppr FlatSkolTv = text "fsk" {- ********************************************************************* * * @@ -795,10 +797,10 @@ checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl +-- Returns topTcLevel for non-TcTyVars tcTyVarLevel :: TcTyVar -> TcLevel tcTyVarLevel tv - = ASSERT2( tcIsTcTyVar tv, ppr tv ) - case tcTyVarDetails tv of + = case tcTyVarDetails tv of MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl SkolemTv tv_lvl _ -> tv_lvl RuntimeUnk -> topTcLevel ===================================== testsuite/tests/ghci/scripts/T16767.script ===================================== @@ -0,0 +1,3 @@ +:set -fprint-explicit-foralls -fprint-explicit-kinds -XTypeApplications -XDataKinds +import Data.Proxy +:kind! 'Proxy @_ ===================================== testsuite/tests/ghci/scripts/T16767.stdout ===================================== @@ -0,0 +1,2 @@ +'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _ += 'Proxy @{k} @_ ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -296,3 +296,4 @@ test('T16030', normal, ghci_script, ['T16030.script']) test('T11606', normal, ghci_script, ['T11606.script']) test('T16089', normal, ghci_script, ['T16089.script']) test('T16527', normal, ghci_script, ['T16527.script']) +test('T16767', normal, ghci_script, ['T16767.script']) ===================================== testsuite/tests/typecheck/should_fail/T16517.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE PolyKinds #-} +module T16517 where + +import Data.Proxy +class C a where m :: Proxy (a :: k) ===================================== testsuite/tests/typecheck/should_fail/T16517.stderr ===================================== @@ -0,0 +1,6 @@ + +T16517.hs:5:29: error: + • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘Proxy’, namely ‘(a :: k)’ + In the type signature: m :: Proxy (a :: k) + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -511,3 +511,4 @@ test('T16059e', [extra_files(['T16059b.hs'])], multimod_compile_fail, ['T16059e', '-v0']) test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) +test('T16517', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail134.stderr ===================================== @@ -2,6 +2,5 @@ tcfail134.hs:5:33: error: • Expecting one more argument to ‘XML’ Expected a type, but ‘XML’ has kind ‘* -> Constraint’ - • In the type signature: - toXML :: a -> XML + • In the type signature: toXML :: a -> XML In the class declaration for ‘XML’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e2447c00d38e973da14c49014e5afa9bed6d2081 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e2447c00d38e973da14c49014e5afa9bed6d2081 You're receiving 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 Jun 12 13:40:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 09:40:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/lint-testsuite Message-ID: <5d0100c943721_3b3ae7ffa2c143192@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/lint-testsuite You're receiving 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 Jun 12 13:44:31 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 09:44:31 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] 2 commits: gitlab-ci: Lint testsuite for framework failures Message-ID: <5d0101bf44d41_3b3ae7ffa2c1433fc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: 8c0b6aba by Ben Gamari at 2019-06-12T13:43:02Z gitlab-ci: Lint testsuite for framework failures This introduces a new lint job checking for framework failures and listing broken tests. - - - - - 57dfc10b by Ben Gamari at 2019-06-12T13:44:22Z testsuite: Fix fragile_for test modifier - - - - - 4 changed files: - .gitlab-ci.yml - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/mk/test.mk Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +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 + dependencies: [] + tags: + - lint + # We allow the submodule checker to fail when run on merge requests (to # accomodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. ===================================== testsuite/driver/runtests.py ===================================== @@ -350,7 +350,7 @@ for name in config.only: if config.list_broken: print('') print('Broken tests:') - print(' '.join(map (lambda bdn: '#' + str(bdn[0]) + '(' + bdn[1] + '/' + bdn[2] + ')', brokens))) + print('\n '.join(map (lambda bdn: '#' + str(bdn[0]) + '(' + bdn[1] + '/' + bdn[2] + ')', brokens))) print('') if t.framework_failures: ===================================== testsuite/driver/testlib.py ===================================== @@ -257,14 +257,14 @@ def fragile( bug ): return helper -def fragile_for( name, opts, bug, ways ): +def fragile_for( bug, ways ): """ Indicates that the test should be skipped due to fragility in the given test ways as documented in the given ticket. """ def helper( name, opts, bug=bug, ways=ways ): record_broken(name, opts, bug) - opts.omit_ways = ways + opts.omit_ways += ways return helper @@ -274,7 +274,7 @@ def omit_ways( ways ): return lambda name, opts, w=ways: _omit_ways( name, opts, w ) def _omit_ways( name, opts, ways ): - opts.omit_ways = ways + opts.omit_ways += ways # ----- ===================================== testsuite/mk/test.mk ===================================== @@ -81,7 +81,11 @@ endif RUNTEST_OPTS += -e "ghc_compiler_always_flags='$(TEST_HC_OPTS)'" -RUNTEST_OPTS += -e config.compiler_debugged=$(GhcDebugged) +ifeq "$(GhcDebugged)" "YES" +RUNTEST_OPTS += -e "config.compiler_debugged=True" +else +RUNTEST_OPTS += -e "config.compiler_debugged=False" +endif ifeq "$(GhcWithNativeCodeGen)" "YES" RUNTEST_OPTS += -e ghc_with_native_codegen=True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9aff2d922edbfda0cd05008761883a3387b77498...57dfc10b675e5d3ac5b59edafeabe513b825a300 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9aff2d922edbfda0cd05008761883a3387b77498...57dfc10b675e5d3ac5b59edafeabe513b825a300 You're receiving 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 Jun 12 13:54:25 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 09:54:25 -0400 Subject: [Git][ghc/ghc][wip/fix-windows] 21 commits: Warn about unused packages Message-ID: <5d010411b5f66_3b3ae7ffa2c145679@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-windows at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - 26398749 by Ben Gamari at 2019-06-12T13:54:16Z testsuite: Skip dynamicToo006 when dynamic linking is not available This was previously failling on Windows. - - - - - 6229e3b8 by Ben Gamari at 2019-06-12T13:54:16Z testsuite: Mark T3372 as fragile on Windows On Windows we must lock package databases even when opening for read-only access. This means that concurrent GHC sessions are very likely to fail with file lock contention. See #16773. - - - - - ce815fbd by Ben Gamari at 2019-06-12T13:54:16Z testsuite: Add stderr output for UnsafeInfered02 on Windows This test uses TemplateHaskell causing GHC to build dynamic objects on platforms where dynamic linking is available. However, Windows doesn't support dynamic linking. Consequently the test would fail on Windows with: ```patch --- safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.stderr.normalised 2019-06-04 15:10:10.521594200 +0000 +++ safeHaskell/safeInfered/UnsafeInfered02.run/UnsafeInfered02.comp.stderr.normalised 2019-06-04 15:10:10.523546200 +0000 @@ -1,5 +1,5 @@ -[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o, UnsafeInfered02_A.dyn_o ) -[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o, UnsafeInfered02.dyn_o ) +[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o ) +[2 of 2] Compiling UnsafeInfered02 ( UnsafeInfered02.hs, UnsafeInfered02.o ) UnsafeInfered02.hs:4:1: UnsafeInfered02_A: Can't be safely imported! ``` The other approach I considered for this issue is to pass `-v0` to GHC. However, I felt we should probably do this consistently for all of the tests in this directory and this would take more time than I currently have. - - - - - 5b37bbc8 by Ben Gamari at 2019-06-12T13:54:17Z testsuite: Mark OldModLocation as broken on Windows Strangely the path it emits contains duplicate path delimiters (#16772), ```patch --- ghc-api/downsweep/OldModLocation.run/OldModLocation.stderr.normalised 2019-06-04 14:40:26.326075000 +0000 +++ ghc-api/downsweep/OldModLocation.run/OldModLocation.run.stderr.normalised 2019-06-04 14:40:26.328029200 +0000 @@ -1 +1 @@ -[Just "A.hs",Just "mydir/B.hs"] +[Just "A.hs",Just "mydir//B.hs"] ``` - - - - - 4cd114e1 by Ben Gamari at 2019-06-12T13:54:17Z testsuite: Mark T7170 as broken on Windows Due to #16801. - - - - - af635867 by Ben Gamari at 2019-06-12T13:54:17Z testsuite: Mark T7702 as broken on Windows Due to #16799. - - - - - cfa28aa9 by Ben Gamari at 2019-06-12T13:54:17Z gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/ghci/GHCi.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs - compiler/nativeGen/RegAlloc/Linear/State.hs - compiler/prelude/PrelRules.hs - compiler/rename/RnExpr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/62c0248a72fc18cb43f2a87c5b8d5a55ff47351e...cfa28aa9ad83c205d5c5328b290ca90f38e351c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/62c0248a72fc18cb43f2a87c5b8d5a55ff47351e...cfa28aa9ad83c205d5c5328b290ca90f38e351c2 You're receiving 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 Jun 12 15:11:49 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:11:49 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] 2 commits: lint: Only apply --interactive lint to testsuite .T files Message-ID: <5d011635ce7be_3b3ae4ed0dc1660b3@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: d117bb78 by Ben Gamari at 2019-06-12T15:07:16Z lint: Only apply --interactive lint to testsuite .T files - - - - - e6f8160a by Ben Gamari at 2019-06-12T15:11:31Z gitlab-ci: Lint the linters - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,8 +12,10 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`." + ).add_path_filter(lambda path: path.suffix == '.T') ] if __name__ == '__main__': - run_linters(linters, subdir='testsuite') + run_linters(linters, + subdir='testsuite') ===================================== .gitlab/linters/linter.py ===================================== @@ -7,7 +7,8 @@ import sys import re import textwrap import subprocess -from typing import List, Optional +from pathlib import Path +from typing import List, Optional, Callable, Sequence from collections import namedtuple def lint_failure(file, line_no, line_content, message): @@ -46,12 +47,21 @@ class Linter(object): """ def __init__(self): self.warnings = [] # type: List[Warning] + self.path_filters = [] # type: List[Callable[[Path], bool]] def add_warning(self, w: Warning): self.warnings.append(w) + def add_path_filter(self, f: Callable[[Path], bool]) -> "Linter": + self.path_filters.append(f) + return self + + def do_lint(self, path): + if all(f(path) for f in self.path_filters): + self.lint(path) + def lint(self, path): - pass + raise NotImplementedError class LineLinter(Linter): """ @@ -66,7 +76,7 @@ class LineLinter(Linter): self.lint_line(path, line_no+1, line) def lint_line(self, path, line_no, line): - pass + raise NotImplementedError class RegexpLinter(LineLinter): """ @@ -84,7 +94,7 @@ class RegexpLinter(LineLinter): message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/57dfc10b675e5d3ac5b59edafeabe513b825a300...e6f8160a268563622cf8aafaf8f27abcbb657bc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/57dfc10b675e5d3ac5b59edafeabe513b825a300...e6f8160a268563622cf8aafaf8f27abcbb657bc6 You're receiving 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 Jun 12 15:14:17 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:14:17 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] 2 commits: lint: Only apply --interactive lint to testsuite .T files Message-ID: <5d0116c93a950_3b3a3f9f3030a4d01668c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: dab60c71 by Ben Gamari at 2019-06-12T15:14:12Z lint: Only apply --interactive lint to testsuite .T files - - - - - 0d20b215 by Ben Gamari at 2019-06-12T15:14:12Z gitlab-ci: Lint the linters - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/check-makefiles.py ===================================== @@ -12,8 +12,10 @@ from linter import run_linters, RegexpLinter linters = [ RegexpLinter(r'--interactive', - message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.") + message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`." + ).add_path_filter(lambda path: path.suffix == '.T') ] if __name__ == '__main__': - run_linters(linters, subdir='testsuite') + run_linters(linters, + subdir='testsuite') ===================================== .gitlab/linters/linter.py ===================================== @@ -7,7 +7,8 @@ import sys import re import textwrap import subprocess -from typing import List, Optional +from pathlib import Path +from typing import List, Optional, Callable, Sequence from collections import namedtuple def lint_failure(file, line_no, line_content, message): @@ -46,12 +47,21 @@ class Linter(object): """ def __init__(self): self.warnings = [] # type: List[Warning] + self.path_filters = [] # type: List[Callable[[Path], bool]] def add_warning(self, w: Warning): self.warnings.append(w) + def add_path_filter(self, f: Callable[[Path], bool]) -> "Linter": + self.path_filters.append(f) + return self + + def do_lint(self, path): + if all(f(path) for f in self.path_filters): + self.lint(path) + def lint(self, path): - pass + raise NotImplementedError class LineLinter(Linter): """ @@ -66,7 +76,7 @@ class LineLinter(Linter): self.lint_line(path, line_no+1, line) def lint_line(self, path, line_no, line): - pass + raise NotImplementedError class RegexpLinter(LineLinter): """ @@ -84,7 +94,7 @@ class RegexpLinter(LineLinter): message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -96,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.lint(path) + linter.do_lint(path) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e6f8160a268563622cf8aafaf8f27abcbb657bc6...0d20b215e72cd0f4cae0709564af027846d4f8bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e6f8160a268563622cf8aafaf8f27abcbb657bc6...0d20b215e72cd0f4cae0709564af027846d4f8bf You're receiving 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 Jun 12 15:19:27 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:19:27 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d0117ffc0a80_3b3ae4ed0dc16907b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: ef60d554 by Ben Gamari at 2019-06-12T15:19:20Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): + def lint(self, path: Path): if os.path.isfile(path): with open(path, 'r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ef60d554a0411f5ecbc3640eea0470b249424700 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/ef60d554a0411f5ecbc3640eea0470b249424700 You're receiving 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 Jun 12 15:24:11 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:24:11 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d01191b51ff2_3b3a3f9f3030a4d01718ee@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: e9879a22 by Ben Gamari at 2019-06-12T15:24:04Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): + def lint(self, path: Path): if os.path.isfile(path): with open(path, 'r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e9879a221888ed659342b2c7c90ad60b0225b30b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/e9879a221888ed659342b2c7c90ad60b0225b30b You're receiving 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 Jun 12 15:27:11 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:27:11 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d0119cf6de17_3b3a39620dc175073@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: 199feb32 by Ben Gamari at 2019-06-12T15:27:03Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): + def lint(self, path: Path): + if path.isfile(path): with open(path, 'r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/199feb323f0035d7e492463046c2f8549774e917 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/199feb323f0035d7e492463046c2f8549774e917 You're receiving 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 Jun 12 15:29:22 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:29:22 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d011a5214190_3b3a3f9f3030a4d01758a2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: f4158698 by Ben Gamari at 2019-06-12T15:29:15Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): + def lint(self, path: Path): + if path.is_file(path): with open(path, 'r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f4158698cafa6cd276d456917ff709c16f87d142 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f4158698cafa6cd276d456917ff709c16f87d142 You're receiving 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 Jun 12 15:30:55 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:30:55 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d011aaf349d5_3b3addedfac17809@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: 2239e4b8 by Ben Gamari at 2019-06-12T15:30:49Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): + def lint(self, path: Path): + if path.is_file(): with open(path, 'r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2239e4b8eb81a9c595374f543cd11251c61828ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/2239e4b8eb81a9c595374f543cd11251c61828ed You're receiving 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 Jun 12 15:33:16 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:33:16 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d011b3ccbf5f_3b3a3f9f4fb2691017924a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: c93c5d7e by Ben Gamari at 2019-06-12T15:33:09Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -70,6 +70,15 @@ ghc-linters: refs: - merge_requests +lint-linters: + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): - with open(path, 'r') as f: + def lint(self, path: Path): + if path.is_file(): + with path.open('r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c93c5d7e4ae6407374311de293f3724200ff9527 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c93c5d7e4ae6407374311de293f3724200ff9527 You're receiving 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 Jun 12 15:36:32 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:36:32 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d011c00595e4_3b3ae7ffa2c1806ee@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: 6df39f66 by Ben Gamari at 2019-06-12T15:36:26Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -27,6 +27,7 @@ stages: - hackage # head.hackage testing - deploy # push documentation +# N.B.Don't run on wip/ branches, instead on run on merge requests. .only-default: &only-default only: - master @@ -70,7 +71,18 @@ ghc-linters: refs: - merge_requests +lint-linters: + <<: *only-default + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: @@ -83,6 +95,7 @@ lint-testsuite: # accomodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: @@ -125,6 +138,7 @@ lint-submods-branch: - /ghc-[0-9]+\.[0-9]+/ .lint-changelogs: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" dependencies: [] ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): - with open(path, 'r') as f: + def lint(self, path: Path): + if path.is_file(): + with path.open('r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6df39f66b0562e11a63c959e5d1639a1c40c6d33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6df39f66b0562e11a63c959e5d1639a1c40c6d33 You're receiving 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 Jun 12 15:54:18 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 11:54:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-containers Message-ID: <5d01202af0e57_3b3a3f9f30570a44187098@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/bump-containers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/bump-containers You're receiving 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 Jun 12 16:19:41 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 12:19:41 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d01261da81b1_3b3a3f9f3bf5b094191377@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: d3a8595f by Ben Gamari at 2019-06-12T16:19:32Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 88e952f165f48cfb956ac9a2486a9263aa4f777c # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -27,6 +27,7 @@ stages: - hackage # head.hackage testing - deploy # push documentation +# N.B.Don't run on wip/ branches, instead on run on merge requests. .only-default: &only-default only: - master @@ -70,7 +71,18 @@ ghc-linters: refs: - merge_requests +lint-linters: + <<: *only-default + stage: lint + image: "nixos/nix" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: @@ -83,6 +95,7 @@ lint-testsuite: # accomodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: @@ -125,6 +138,7 @@ lint-submods-branch: - /ghc-[0-9]+\.[0-9]+/ .lint-changelogs: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" dependencies: [] ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): - with open(path, 'r') as f: + def lint(self, path: Path): + if path.is_file(): + with path.open('r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d3a8595f561d5d63a4710cfac300c90f910bca71 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d3a8595f561d5d63a4710cfac300c90f910bca71 You're receiving 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 Jun 12 16:29:14 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 12:29:14 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d01285a54eec_3b3addedfac19473b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: c083e74d by Ben Gamari at 2019-06-12T16:29:03Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 88e952f165f48cfb956ac9a2486a9263aa4f777c # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -27,6 +27,7 @@ stages: - hackage # head.hackage testing - deploy # push documentation +# N.B.Don't run on wip/ branches, instead on run on merge requests. .only-default: &only-default only: - master @@ -70,7 +71,18 @@ ghc-linters: refs: - merge_requests +lint-linters: + <<: *only-default + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" + script: + - nix run nixpkgs.python3Packages.mypy -c mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: @@ -83,6 +95,7 @@ lint-testsuite: # accomodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: @@ -125,6 +138,7 @@ lint-submods-branch: - /ghc-[0-9]+\.[0-9]+/ .lint-changelogs: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" dependencies: [] ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): - with open(path, 'r') as f: + def lint(self, path: Path): + if path.is_file(): + with path.open('r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c083e74d7da662bb63f018a534d795522bc7f6cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/c083e74d7da662bb63f018a534d795522bc7f6cc You're receiving 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 Jun 12 16:31:33 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 12:31:33 -0400 Subject: [Git][ghc/ghc][master] 30 commits: Bump binary to 0.8.7.0 Message-ID: <5d0128e56aee0_3b3a39620dc1958c7@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bd2d13ff by Ben Gamari at 2019-06-12T12:19:59Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 381c3ae3 by Ben Gamari at 2019-06-12T12:19:59Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 0354c7de by Ben Gamari at 2019-06-12T12:19:59Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e0b16eaa by Ben Gamari at 2019-06-12T12:19:59Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 2ce320b0 by Ben Gamari at 2019-06-12T12:19:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 90e7c450 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 488187f8 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 9b583320 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - eb644865 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 1a204e07 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 8d482e45 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 68cfdfdb by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - a3929a4f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - bb7ed32f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 329dcd7a by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix fragile_for test modifier - - - - - 55b5bb14 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 264ad286 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 587bef66 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - dc5a37fd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - e3f71d0e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - b5a13a1e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - b09374a4 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - a798c130 by Ben Gamari at 2019-06-12T12:20:25Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 0782141e by Ben Gamari at 2019-06-12T12:20:25Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 898f7e92 by Ben Gamari at 2019-06-12T12:20:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0a13a04c by Ben Gamari at 2019-06-12T12:20:25Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - a8579e5b by Ben Gamari at 2019-06-12T12:27:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 3f1022c5 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 1cbfef47 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 20160f1a by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/Cabal - libraries/base/tests/all.T - libraries/binary - libraries/process - libraries/terminfo - libraries/time - libraries/unix - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/parser/should_compile/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/programs/barton-mangler-bug/test.T - testsuite/tests/programs/galois_raytrace/test.T - testsuite/tests/quotes/all.T - testsuite/tests/roles/should_compile/all.T - testsuite/tests/rts/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1219f8e8a3d1b58263bea76822322b746a632778...20160f1a8a8ed69c168bee5c8d43373191303b3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1219f8e8a3d1b58263bea76822322b746a632778...20160f1a8a8ed69c168bee5c8d43373191303b3f You're receiving 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 Jun 12 16:32:51 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 12:32:51 -0400 Subject: [Git][ghc/ghc][wip/lint-testsuite] gitlab-ci: Lint the linters Message-ID: <5d012933a17fb_3b3a3f9f315b8a14196917@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/lint-testsuite at Glasgow Haskell Compiler / GHC Commits: 1a03d259 by Ben Gamari at 2019-06-12T16:32:40Z gitlab-ci: Lint the linters - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/linters/linter.py 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: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f + DOCKER_REV: 88e952f165f48cfb956ac9a2486a9263aa4f777c # Sequential version number capturing the versions of all tools fetched by # .gitlab/win32-init.sh. @@ -27,6 +27,7 @@ stages: - hackage # head.hackage testing - deploy # push documentation +# N.B.Don't run on wip/ branches, instead on run on merge requests. .only-default: &only-default only: - master @@ -70,7 +71,18 @@ ghc-linters: refs: - merge_requests +lint-linters: + <<: *only-default + stage: lint + image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" + script: + - mypy .gitlab/linters/*.py + dependencies: [] + tags: + - lint + lint-testsuite: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: @@ -83,6 +95,7 @@ lint-testsuite: # accomodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" script: @@ -125,6 +138,7 @@ lint-submods-branch: - /ghc-[0-9]+\.[0-9]+/ .lint-changelogs: + <<: *only-default stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" dependencies: [] ===================================== .gitlab/linters/linter.py ===================================== @@ -8,10 +8,10 @@ import re import textwrap import subprocess from pathlib import Path -from typing import List, Optional, Callable +from typing import List, Optional, Callable, Sequence from collections import namedtuple -def lint_failure(file, line_no, line_content, message): +def lint_failure(file, line_no: int, line_content: str, message: str): """ Print a lint failure message. """ wrapper = textwrap.TextWrapper(initial_indent=' ', subsequent_indent=' ') @@ -30,7 +30,7 @@ def lint_failure(file, line_no, line_content, message): print(textwrap.dedent(msg)) -def get_changed_files(base_commit, head_commit, +def get_changed_files(base_commit: str, head_commit: str, subdir: str = '.'): """ Get the files changed by the given range of commits. """ cmd = ['git', 'diff', '--name-only', @@ -56,11 +56,11 @@ class Linter(object): self.path_filters.append(f) return self - def do_lint(self, path): + def do_lint(self, path: Path): if all(f(path) for f in self.path_filters): self.lint(path) - def lint(self, path): + def lint(self, path: Path): raise NotImplementedError class LineLinter(Linter): @@ -69,13 +69,13 @@ class LineLinter(Linter): the given line from a file and calls :func:`add_warning` for any lint issues found. """ - def lint(self, path): - if os.path.isfile(path): - with open(path, 'r') as f: + def lint(self, path: Path): + if path.is_file(): + with path.open('r') as f: for line_no, line in enumerate(f): self.lint_line(path, line_no+1, line) - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): raise NotImplementedError class RegexpLinter(LineLinter): @@ -83,18 +83,18 @@ class RegexpLinter(LineLinter): A :class:`RegexpLinter` produces the given warning message for all lines matching the given regular expression. """ - def __init__(self, regex, message): + def __init__(self, regex: str, message: str): LineLinter.__init__(self) self.re = re.compile(regex) self.message = message - def lint_line(self, path, line_no, line): + def lint_line(self, path: Path, line_no: int, line: str): if self.re.search(line): w = Warning(path=path, line_no=line_no, line_content=line[:-1], message=self.message) self.add_warning(w) -def run_linters(linters: List[Linter], +def run_linters(linters: Sequence[Linter], subdir: str = '.') -> None: import argparse parser = argparse.ArgumentParser() @@ -106,7 +106,7 @@ def run_linters(linters: List[Linter], if path.startswith('.gitlab/linters'): continue for linter in linters: - linter.do_lint(path) + linter.do_lint(Path(path)) warnings = [warning for linter in linters View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a03d2596823a4e788f70c8cfc49ff6f200a83e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1a03d2596823a4e788f70c8cfc49ff6f200a83e8 You're receiving 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 Jun 12 16:37:53 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 12:37:53 -0400 Subject: [Git][ghc/ghc][wip/submod-bumps] 44 commits: Warn about unused packages Message-ID: <5d012a614851e_3b3a3f9f3030a4d02018cf@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/submod-bumps at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - bd2d13ff by Ben Gamari at 2019-06-12T12:19:59Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 381c3ae3 by Ben Gamari at 2019-06-12T12:19:59Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 0354c7de by Ben Gamari at 2019-06-12T12:19:59Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e0b16eaa by Ben Gamari at 2019-06-12T12:19:59Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 2ce320b0 by Ben Gamari at 2019-06-12T12:19:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 90e7c450 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 488187f8 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 9b583320 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - eb644865 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 1a204e07 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 8d482e45 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 68cfdfdb by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - a3929a4f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - bb7ed32f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 329dcd7a by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix fragile_for test modifier - - - - - 55b5bb14 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 264ad286 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 587bef66 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - dc5a37fd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - e3f71d0e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - b5a13a1e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - b09374a4 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - a798c130 by Ben Gamari at 2019-06-12T12:20:25Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 0782141e by Ben Gamari at 2019-06-12T12:20:25Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 898f7e92 by Ben Gamari at 2019-06-12T12:20:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0a13a04c by Ben Gamari at 2019-06-12T12:20:25Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - a8579e5b by Ben Gamari at 2019-06-12T12:27:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 3f1022c5 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 1cbfef47 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 20160f1a by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/ghci/GHCi.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/34876db83aab33fafcce4922f80aab5bb0d8bc1a...20160f1a8a8ed69c168bee5c8d43373191303b3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/34876db83aab33fafcce4922f80aab5bb0d8bc1a...20160f1a8a8ed69c168bee5c8d43373191303b3f You're receiving 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 Jun 12 17:56:27 2019 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 12 Jun 2019 13:56:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 42 commits: llvm-targets: Add armv7l-unknown-linux-gnueabi Message-ID: <5d013ccb28daa_3b3ae7ffa2c22917e@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - bd2d13ff by Ben Gamari at 2019-06-12T12:19:59Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 381c3ae3 by Ben Gamari at 2019-06-12T12:19:59Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 0354c7de by Ben Gamari at 2019-06-12T12:19:59Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e0b16eaa by Ben Gamari at 2019-06-12T12:19:59Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 2ce320b0 by Ben Gamari at 2019-06-12T12:19:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 90e7c450 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 488187f8 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 9b583320 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - eb644865 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 1a204e07 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 8d482e45 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 68cfdfdb by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - a3929a4f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - bb7ed32f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 329dcd7a by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix fragile_for test modifier - - - - - 55b5bb14 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 264ad286 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 587bef66 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - dc5a37fd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - e3f71d0e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - b5a13a1e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - b09374a4 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - a798c130 by Ben Gamari at 2019-06-12T12:20:25Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 0782141e by Ben Gamari at 2019-06-12T12:20:25Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 898f7e92 by Ben Gamari at 2019-06-12T12:20:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0a13a04c by Ben Gamari at 2019-06-12T12:20:25Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - a8579e5b by Ben Gamari at 2019-06-12T12:27:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 3f1022c5 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 1cbfef47 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 20160f1a by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - d4cb9e53 by Ben Gamari at 2019-06-12T17:56:15Z PrelRules: Ensure that string unpack/append rule fires with source notes Previously the presence of source notes could hide nested applications of `unpackFoldrCString#` from our constant folding logic. For instance, consider the expression: ```haskell unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) ``` Specifically, ticks appearing in two places can defeat the rule: a. Surrounding the inner application of `unpackFoldrCString#` b. Surrounding the fold function, `c` The latter caused the `str_rules` testcase to fail when `base` was built with `-g3`. Fixes #16740. - - - - - c8b0f274 by David Eichmann at 2019-06-12T17:56:15Z Hadrian: Track RTS library symlink targets This requires creating RTS library symlinks when registering, outside of the rule for the registered library file. - - - - - 23513717 by Alp Mestanogullari at 2019-06-12T17:56:18Z Hadrian: Do not allow the Linux jobs to fail anymore MR !1151 makes the Hadrian/Linux job pass by fixing the last two test failures, so we can now be stricter and not allow those jobs to fail anymore, easily letting us see when patches introduce test failures. - - - - - c164fb9f by Ben Gamari at 2019-06-12T17:56:18Z users-guide: Fix a few markup issues Strangely these were only causing the build to fail in the aarch64-linux job, despite Sphinx throwing errors in all jobs I checked. Also changes some `#ifdef`s to `#if defined` to satisfy the linter. - - - - - 8620f798 by Ben Gamari at 2019-06-12T17:56:18Z gitlab-ci: Don't build PDF user's guide on AArch64 For reasons I don't understand sphinx seems to fail to produce a .idx file for makeindex. - - - - - 748e55ff by Ben Gamari at 2019-06-12T17:56:19Z Clean up .circleci Move prepare-system.sh to .gitlab and remove everything else. - - - - - ea3487cb by Ben Gamari at 2019-06-12T17:56:19Z testsuite: A more portable solution to #9399 Previously we used an awful hybrid batch script/Bourne shell script to allow this test to run both on Windows and Linux (fixing #9399). However, this breaks on some libc implementations (e.g. musl). Fix this. Fixes #16798. - - - - - 30 changed files: - − .circleci/config.yml - − .circleci/fetch-submodules.sh - − .circleci/push-test-metrics.sh - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - .circleci/prepare-system.sh → .gitlab/prepare-system.sh - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGen.hs - compiler/nativeGen/NCGMonad.hs - compiler/nativeGen/RegAlloc/Linear/State.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cfd22bfbc04daf1051dcbe49c3ef55e206e6ff5c...ea3487cb124a8aca036e63017e67f6594ba1070f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/cfd22bfbc04daf1051dcbe49c3ef55e206e6ff5c...ea3487cb124a8aca036e63017e67f6594ba1070f You're receiving 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 Jun 12 17:58:50 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 13:58:50 -0400 Subject: [Git][ghc/ghc][wip/backport-MR951] Fix #16517 by bumping the TcLevel for method sigs Message-ID: <5d013d5a2e7b5_3b3ade3cf802393f4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backport-MR951 at Glasgow Haskell Compiler / GHC Commits: 19ab32c5 by Richard Eisenberg at 2019-06-12T17:58:36Z Fix #16517 by bumping the TcLevel for method sigs There were actually two bugs fixed here: 1. candidateQTyVarsOfType needs to be careful that it does not try to zap metavariables from an outer scope as "naughty" quantification candidates. This commit adds a simple check to avoid doing so. 2. We weren't bumping the TcLevel in kcHsKindSig, which was used only for class method sigs. This mistake led to the acceptance of class C a where meth :: forall k. Proxy (a :: k) -> () Note that k is *locally* quantified. This patch fixes the problem by using tcClassSigType, which correctly bumps the level. It's a bit inefficient because tcClassSigType does other work, too, but it would be tedious to repeat much of the code there with only a few changes. This version works well and is simple. And, while updating comments, etc., I noticed that tcRnType was missing a pushTcLevel, leading to #16767, which this patch also fixes, by bumping the level. In the refactoring here, I also use solveEqualities. This initially failed ghci/scripts/T15415, but that was fixed by teaching solveEqualities to respect -XPartialTypeSignatures. This patch also cleans up some Notes around error generation that came up in conversation. Test case: typecheck/should_fail/T16517, ghci/scripts/T16767 (cherry picked from commit a22e51ea6f7a046c87d57ce30d143eef6abee9ff) - - - - - 16 changed files: - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcType.hs - + testsuite/tests/ghci/scripts/T16767.script - + testsuite/tests/ghci/scripts/T16767.stdout - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/typecheck/should_fail/T16517.hs - + testsuite/tests/typecheck/should_fail/T16517.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail134.stderr Changes: ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -2079,13 +2079,6 @@ What do we do when we have an equality where k1 and k2 differ? This Note explores this treacherous area. -First off, the question above is slightly the wrong question. Flattening -a tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening -the kind might introduce a cast. So we might have a casted tyvar on the -left. We thus revise our test case to - - (tv |> co :: k1) ~ (rhs :: k2) - We must proceed differently here depending on whether we have a Wanted or a Given. Consider this: @@ -2109,36 +2102,33 @@ The reason for this odd behavior is much the same as Note [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the new `co` is a Wanted. - The solution is then not to use `co` to "rewrite" -- that is, cast - -- `w`, but instead to keep `w` heterogeneous and - irreducible. Given that we're not using `co`, there is no reason to - collect evidence for it, so `co` is born a Derived, with a CtOrigin - of KindEqOrigin. +The solution is then not to use `co` to "rewrite" -- that is, cast -- `w`, but +instead to keep `w` heterogeneous and irreducible. Given that we're not using +`co`, there is no reason to collect evidence for it, so `co` is born a +Derived, with a CtOrigin of KindEqOrigin. When the Derived is solved (by +unification), the original wanted (`w`) will get kicked out. We thus get -When the Derived is solved (by unification), the original wanted (`w`) -will get kicked out. +[D] _ :: k ~ Type +[W] w :: (alpha :: k) ~ (Int :: Type) -Note that, if we had [G] co1 :: k ~ Type available, then none of this code would -trigger, because flattening would have rewritten k to Type. That is, -`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar -case will trigger, correctly rewriting alpha to (Int |> sym co1). +Note that the Wanted is unchanged and will be irreducible. This all happens +in canEqTyVarHetero. + +Note that, if we had [G] co1 :: k ~ Type available, then we never get +to canEqTyVarHetero: canEqTyVar tries flattening the kinds first. If +we have [G] co1 :: k ~ Type, then flattening the kind of alpha would +rewrite k to Type, and we would end up in canEqTyVarHomo. Successive canonicalizations of the same Wanted may produce duplicate Deriveds. Similar duplications can happen with fundeps, and there seems to be no easy way to avoid. I expect this case to be rare. -For Givens, this problem doesn't bite, so a heterogeneous Given gives +For Givens, this problem (the Wanteds-rewriting-Wanteds action of +a kind coercion) doesn't bite, so a heterogeneous Given gives rise to a Given kind equality. No Deriveds here. We thus homogenise -the Given (see the "homo_co" in the Given case in canEqTyVar) and +the Given (see the "homo_co" in the Given case in canEqTyVarHetero) and carry on with a homogeneous equality constraint. -Separately, I (Richard E) spent some time pondering what to do in the case -that we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2 -differ. Note that the tv is the same. (This case is handled as the first -case in canEqTyVarHomo.) At one point, I thought we could solve this limited -form of heterogeneous Wanted, but I then reconsidered and now treat this case -just like any other heterogeneous Wanted. - Note [Type synonyms and canonicalization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We treat type synonym applications as xi types, that is, they do not ===================================== compiler/typecheck/TcErrors.hs ===================================== @@ -158,14 +158,22 @@ reportUnsolved wanted -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on -- However, do not make any evidence bindings, because we don't -- have any convenient place to put them. +-- NB: Type-level holes are OK, because there are no bindings. -- See Note [Deferring coercion errors to runtime] -- Used by solveEqualities for kind equalities --- (see Note [Fail fast on kind errors] in TcSimplify] +-- (see Note [Fail fast on kind errors] in TcSimplify) -- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = do { ev_binds <- newNoTcEvBinds - ; report_unsolved TypeError HoleError HoleError HoleError + + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures + ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures + ; let type_holes | not partial_sigs = HoleError + | warn_partial_sigs = HoleWarn + | otherwise = HoleDefer + + ; report_unsolved TypeError HoleError type_holes HoleError ev_binds wanted } -- | Report all unsolved goals as warnings (but without deferring any errors to ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -11,7 +11,7 @@ module TcHsType ( -- Type signatures - kcHsSigType, tcClassSigType, + kcClassSigType, tcClassSigType, tcHsSigType, tcHsSigWcType, tcHsPartialSigType, funsSigCtxt, addSigCtxt, pprSigCtxt, @@ -187,24 +187,40 @@ tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type -- already checked this, so we can simply ignore it. tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty) -kcHsSigType :: [Located Name] -> LHsSigType GhcRn -> TcM () -kcHsSigType names (HsIB { hsib_body = hs_ty - , hsib_ext = sig_vars }) - = addSigCtxt (funsSigCtxt names) hs_ty $ - discardResult $ - bindImplicitTKBndrs_Skol sig_vars $ - tc_lhs_type typeLevelMode hs_ty liftedTypeKind - -kcHsSigType _ (XHsImplicitBndrs _) = panic "kcHsSigType" +kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () +kcClassSigType skol_info names sig_ty + = discardResult $ + tcClassSigType skol_info names sig_ty + -- tcClassSigType does a fair amount of extra work that we don't need, + -- such as ordering quantified variables. But we absolutely do need + -- to push the level when checking method types and solve local equalities, + -- and so it seems easier just to call tcClassSigType than selectively + -- extract the lines of code from tc_hs_sig_type that we really need. + -- If we don't push the level, we get #16517, where GHC accepts + -- class C a where + -- meth :: forall k. Proxy (a :: k) -> () + -- Note that k is local to meth -- this is hogwash. 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) $ - tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) -- Do not zonk-to-Type, nor perform a validity check -- We are in a knot with the class and associated types -- Zonking and validity checking is done by tcClassDecl + -- No need to fail here if the type has an error: + -- If we're in the kind-checking phase, the solveEqualities + -- in kcTyClGroup catches the error + -- If we're in the type-checking phase, the solveEqualities + -- in tcClassDecl1 gets it + -- Failing fast here degrades the error message in, e.g., tcfail135: + -- class Foo f where + -- baa :: f a -> f + -- If we fail fast, we're told that f has kind `k1` when we wanted `*`. + -- It should be that f has kind `k2 -> *`, but we never get a chance + -- to run the solver where the kind of f is touchable. This is + -- painfully delicate. tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type -- Does validity checking @@ -214,10 +230,13 @@ tcHsSigType ctxt sig_ty do { traceTc "tcHsSigType {" (ppr sig_ty) -- Generalise here: see Note [Kind generalisation] - ; ty <- tc_hs_sig_type skol_info sig_ty - (expectedKindInCtxt ctxt) + ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty + (expectedKindInCtxt ctxt) ; ty <- zonkTcType ty + ; when insol failM + -- See Note [Fail fast if there are insoluble kind equalities] in TcSimplify + ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) ; return ty } @@ -225,12 +244,14 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM Type + -> ContextKind -> TcM (Bool, TcType) -- Kind-checks/desugars an 'LHsSigType', -- solve equalities, -- and then kind-generalizes. -- This will never emit constraints, as it uses solveEqualities interally. -- No validity checking or zonking +-- Returns also a Bool indicating whether the type induced an insoluble constraint; +-- True <=> constraint is insoluble tc_hs_sig_type skol_info hs_sig_type ctxt_kind | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type = do { (tc_lvl, (wanted, (spec_tkvs, ty))) @@ -238,7 +259,6 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind solveLocalEqualitiesX "tc_hs_sig_type" $ bindImplicitTKBndrs_Skol sig_vars $ do { kind <- newExpectedKind ctxt_kind - ; tc_lhs_type typeLevelMode hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- should be in the global tyvars, and therefore won't be quantified @@ -249,9 +269,9 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs) tc_lvl wanted - ; return (mkInvForAllTys kvs ty1) } + ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) } -tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type_and_gen" +tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type" tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type -- tcTopLHsType is used for kind-checking top-level HsType where @@ -2056,7 +2076,8 @@ kindGeneralize :: TcType -> TcM [KindVar] -- Quantify the free kind variables of a kind or type -- In the latter case the type is closed, so it has no free -- type variables. So in both cases, all the free vars are kind vars --- Input needn't be zonked. +-- Input needn't be zonked. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. -- NB: You must call solveEqualities or solveLocalEqualities before -- kind generalization -- @@ -2074,7 +2095,8 @@ kindGeneralize kind_or_type -- | This variant of 'kindGeneralize' refuses to generalize over any -- variables free in the given WantedConstraints. Instead, it promotes --- these variables into an outer TcLevel. See also +-- these variables into an outer TcLevel. All variables to be quantified must +-- have a TcLevel higher than the ambient TcLevel. See also -- Note [Promoting unification variables] in TcSimplify kindGeneralizeLocal :: WantedConstraints -> TcType -> TcM [KindVar] kindGeneralizeLocal wanted kind_or_type ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -759,14 +759,14 @@ writeMetaTyVar tyvar ty -- Everything from here on only happens if DEBUG is on | not (isTcTyVar tyvar) - = WARN( True, text "Writing to non-tc tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar ) return () | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar = writeMetaTyVarRef tyvar ref ty | otherwise - = WARN( True, text "Writing to non-meta tyvar" <+> ppr tyvar ) + = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar ) return () -------------------- @@ -1066,18 +1066,18 @@ we are trying to generalise this type: forall arg. ... (alpha[tau]:arg) ... We have a metavariable alpha whose kind mentions a skolem variable -boudn inside the very type we are generalising. +bound inside the very type we are generalising. This can arise while type-checking a user-written type signature (see the test case for the full code). We cannot generalise over alpha! That would produce a type like forall {a :: arg}. forall arg. ...blah... The fact that alpha's kind mentions arg renders it completely -ineligible for generaliation. +ineligible for generalisation. However, we are not going to learn any new constraints on alpha, -because its kind isn't even in scope in the outer context. So alpha -is entirely unconstrained. +because its kind isn't even in scope in the outer context (but see Wrinkle). +So alpha is entirely unconstrained. What then should we do with alpha? During generalization, every metavariable is either (A) promoted, (B) generalized, or (C) zapped @@ -1098,6 +1098,17 @@ We do this eager zapping in candidateQTyVars, which always precedes generalisation, because at that moment we have a clear picture of what skolems are in scope. +Wrinkle: + +We must make absolutely sure that alpha indeed is not +from an outer context. (Otherwise, we might indeed learn more information +about it.) This can be done easily: we just check alpha's TcLevel. +That level must be strictly greater than the ambient TcLevel in order +to treat it as naughty. We say "strictly greater than" because the call to +candidateQTyVars is made outside the bumped TcLevel, as stated in the +comment to candidateQTyVarsOfType. The level check is done in go_tv +in collect_cant_qtvs. Skipping this check caused #16517. + -} data CandidatesQTvs @@ -1145,13 +1156,17 @@ candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs) -- | Gathers free variables to use as quantification candidates (in -- 'quantifyTyVars'). This might output the same var -- in both sets, if it's used in both a type and a kind. +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) -- See Note [CandidatesQTvs determinism and order] -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty --- | Like 'splitDepVarsOfType', but over a list of types +-- | Like 'candidateQTyVarsOfType', but over a list of types +-- The variables to quantify must have a TcLevel strictly greater than +-- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys @@ -1175,7 +1190,7 @@ delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars collect_cand_qtvs :: Bool -- True <=> consider every fv in Type to be dependent - -> VarSet -- Bound variables (both locally bound and globally bound) + -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked -> TcM CandidatesQTvs @@ -1220,16 +1235,26 @@ collect_cand_qtvs is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv - | tv `elemDVarSet` kvs = return dv -- We have met this tyvar aleady + | tv `elemDVarSet` kvs + = return dv -- We have met this tyvar aleady + | not is_dep - , tv `elemDVarSet` tvs = return dv -- We have met this tyvar aleady + , tv `elemDVarSet` tvs + = return dv -- We have met this tyvar aleady + | otherwise = do { tv_kind <- zonkTcType (tyVarKind tv) -- This zonk is annoying, but it is necessary, both to -- ensure that the collected candidates have zonked kinds -- (Trac #15795) and to make the naughty check -- (which comes next) works correctly - ; if intersectsVarSet bound (tyCoVarsOfType tv_kind) + + ; cur_lvl <- getTcLevel + ; if tcTyVarLevel tv `strictlyDeeperThan` cur_lvl && + -- this tyvar is from an outer context: see Wrinkle + -- in Note [Naughty quantification candidates] + + intersectsVarSet bound (tyCoVarsOfType tv_kind) then -- See Note [Naughty quantification candidates] do { traceTc "Zapping naughty quantifier" (pprTyVar tv) ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -2427,12 +2427,13 @@ tcRnType hsc_env normalise rdr_type -- It can have any rank or kind -- First bring into scope any wildcards ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; ((ty, kind), lie) <- - captureConstraints $ + ; (ty, kind) <- pushTcLevelM_ $ + -- must push level to satisfy level precondition of + -- kindGeneralize, below + solveEqualities $ tcWildCardBinders wcs $ \ wcs' -> do { emitWildCardHoleConstraints wcs' ; tcLHsTypeUnsaturated rn_type } - ; _ <- checkNoErrs (simplifyInteractive lie) -- Do kind generalisation; see Note [Kind-generalise in tcRnType] ; kind <- zonkTcType kind ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -2095,6 +2095,16 @@ see dropDerivedWC. For example [D] Int ~ Bool, and we don't want to report that because it's incomprehensible. That is why we don't rewrite wanteds with wanteds! + * We might float out some Wanteds from an implication, leaving behind + their insoluble Deriveds. For example: + + forall a[2]. [W] alpha[1] ~ Int + [W] alpha[1] ~ Bool + [D] Int ~ Bool + + The Derived is insoluble, but we very much want to drop it when floating + out. + But (tiresomely) we do keep *some* Derived constraints: * Type holes are derived constraints, because they have no evidence @@ -2103,8 +2113,7 @@ But (tiresomely) we do keep *some* Derived constraints: * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with KindEqOrigin, may arise from a type equality a ~ Int#, say. See Note [Equalities with incompatible kinds] in TcCanonical. - These need to be kept because the kind equalities might have different - source locations and hence different error messages. + Keeping these around produces better error messages, in practice. E.g., test case dependent/should_fail/T11471 * We keep most derived equalities arising from functional dependencies ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -152,8 +152,26 @@ solveLocalEqualities :: String -> TcM a -> TcM a solveLocalEqualities callsite thing_inside = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside ; emitConstraints wanted + + -- See Note [Fail fast if there are insoluble kind equalities] + ; when (insolubleWC wanted) $ + failM + ; return res } +{- Note [Fail fast if there are insoluble kind equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Rather like in simplifyInfer, fail fast if there is an insoluble +constraint. Otherwise we'll just succeed in kind-checking a nonsense +type, with a cascade of follow-up errors. + +For example polykinds/T12593, T15577, and many others. + +Take care to ensure that you emit the insoluble constraints before +failing, because they are what will ulimately lead to the error +messsage! +-} + solveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a) solveLocalEqualitiesX callsite thing_inside = do { traceTc "solveLocalEqualitiesX {" (vcat [ text "Called from" <+> text callsite ]) ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -1038,9 +1038,11 @@ kcTyClDecl (ClassDecl { tcdLName = (dL->L _ name) do { _ <- tcHsContext ctxt ; mapM_ (wrapLocM_ kc_sig) sigs } where - kc_sig (ClassOpSig _ _ nms op_ty) = kcHsSigType nms op_ty + kc_sig (ClassOpSig _ _ nms op_ty) = kcClassSigType skol_info nms op_ty kc_sig _ = return () + skol_info = TyConSkol ClassFlavour name + kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name) , fdInfo = fd_info })) -- closed type families look at their equations, but other families don't ===================================== compiler/typecheck/TcType.hs ===================================== @@ -516,6 +516,17 @@ superSkolemTv = SkolemTv topTcLevel True -- Treat this as a completely disti -- The choice of level number here is a bit dodgy, but -- topTcLevel works in the places that vanillaSkolemTv is used +instance Outputable TcTyVarDetails where + ppr = pprTcTyVarDetails + +pprTcTyVarDetails :: TcTyVarDetails -> SDoc +-- For debugging +pprTcTyVarDetails (RuntimeUnk {}) = text "rt" +pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl +pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl +pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) + = ppr info <> colon <> ppr tclvl + ----------------------------- data MetaDetails = Flexi -- Flexi type variables unify to become Indirects @@ -544,20 +555,11 @@ instance Outputable MetaDetails where ppr Flexi = text "Flexi" ppr (Indirect ty) = text "Indirect" <+> ppr ty -pprTcTyVarDetails :: TcTyVarDetails -> SDoc --- For debugging -pprTcTyVarDetails (RuntimeUnk {}) = text "rt" -pprTcTyVarDetails (SkolemTv lvl True) = text "ssk" <> colon <> ppr lvl -pprTcTyVarDetails (SkolemTv lvl False) = text "sk" <> colon <> ppr lvl -pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl }) - = pp_info <> colon <> ppr tclvl - where - pp_info = case info of - TauTv -> text "tau" - TyVarTv -> text "tyv" - FlatMetaTv -> text "fmv" - FlatSkolTv -> text "fsk" - +instance Outputable MetaInfo where + ppr TauTv = text "tau" + ppr TyVarTv = text "tyv" + ppr FlatMetaTv = text "fmv" + ppr FlatSkolTv = text "fsk" {- ********************************************************************* * * @@ -795,10 +797,10 @@ checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl) = ctxt_tclvl >= tv_tclvl +-- Returns topTcLevel for non-TcTyVars tcTyVarLevel :: TcTyVar -> TcLevel tcTyVarLevel tv - = ASSERT2( tcIsTcTyVar tv, ppr tv ) - case tcTyVarDetails tv of + = case tcTyVarDetails tv of MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl SkolemTv tv_lvl _ -> tv_lvl RuntimeUnk -> topTcLevel ===================================== testsuite/tests/ghci/scripts/T16767.script ===================================== @@ -0,0 +1,3 @@ +:set -fprint-explicit-foralls -fprint-explicit-kinds -XTypeApplications -XDataKinds +import Data.Proxy +:kind! 'Proxy @_ ===================================== testsuite/tests/ghci/scripts/T16767.stdout ===================================== @@ -0,0 +1,2 @@ +'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _ += 'Proxy @{k} @_ ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -296,3 +296,4 @@ test('T16030', normal, ghci_script, ['T16030.script']) test('T11606', normal, ghci_script, ['T11606.script']) test('T16089', normal, ghci_script, ['T16089.script']) test('T16527', normal, ghci_script, ['T16527.script']) +test('T16767', normal, ghci_script, ['T16767.script']) ===================================== testsuite/tests/typecheck/should_fail/T16517.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE PolyKinds #-} +module T16517 where + +import Data.Proxy +class C a where m :: Proxy (a :: k) ===================================== testsuite/tests/typecheck/should_fail/T16517.stderr ===================================== @@ -0,0 +1,6 @@ + +T16517.hs:5:29: error: + • Expected kind ‘k’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘Proxy’, namely ‘(a :: k)’ + In the type signature: m :: Proxy (a :: k) + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -511,3 +511,4 @@ test('T16059e', [extra_files(['T16059b.hs'])], multimod_compile_fail, ['T16059e', '-v0']) test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) +test('T16517', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail134.stderr ===================================== @@ -2,6 +2,5 @@ tcfail134.hs:5:33: error: • Expecting one more argument to ‘XML’ Expected a type, but ‘XML’ has kind ‘* -> Constraint’ - • In the type signature: - toXML :: a -> XML + • In the type signature: toXML :: a -> XML In the class declaration for ‘XML’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/19ab32c5fb3ebd88927b94acf6b348facc1552a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/19ab32c5fb3ebd88927b94acf6b348facc1552a2 You're receiving 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 Jun 12 18:06:54 2019 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 12 Jun 2019 14:06:54 -0400 Subject: [Git][ghc/ghc][wip/alpine-ci] 50 commits: Warn about unused packages Message-ID: <5d013f3e35b0e_3b3a39620dc240689@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC Commits: fe7e7e4a by Yuras Shumovich at 2019-06-11T22:39:58Z Warn about unused packages Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: hvr, simonpj, mpickering, rwbarton, carter GHC Trac Issues: #15838 Differential Revision: https://phabricator.haskell.org/D5285 - - - - - 39f50bff by Alp Mestanogullari at 2019-06-11T22:40:37Z Refine the GHCI macro into HAVE[_{INTERNAL, EXTERNAL}]_INTERPRETER As discussed in #16331, the GHCI macro, defined through 'ghci' flags in ghc.cabal.in, ghc-bin.cabal.in and ghci.cabal.in, is supposed to indicate whether GHC is built with support for an internal interpreter, that runs in the same process. It is however overloaded in a few places to mean "there is an interpreter available", regardless of whether it's an internal or external interpreter. For the sake of clarity and with the hope of more easily being able to build stage 1 GHCs with external interpreter support, this patch splits the previous GHCI macro into 3 different ones: - HAVE_INTERNAL_INTERPRETER: GHC is built with an internal interpreter - HAVE_EXTERNAL_INTERPRETER: GHC is built with support for external interpreters - HAVE_INTERPRETER: HAVE_INTERNAL_INTERPRETER || HAVE_EXTERNAL_INTERPRETER - - - - - 45616133 by Alec Theriault at 2019-06-11T22:41:14Z Make `haddock_testsuite` respect `--test-accept` Suppose you've made changes that affect the output of `haddockHtmlTest` so that the following is failing: ./hadrian/build.sh -c --only=haddockHtmlTest test Then, the following will accept new output for Haddock's test cases. ./hadrian/build.sh -c --only=haddockHtmlTest test --test-accept You still do need to make sure those new changes (which show up in Haddock's tree) get committed though. Fixes #16694 - - - - - 762098bf by Alp Mestanogullari at 2019-06-11T22:41:52Z rts/RtsFlags.c: mention that -prof too enables support for +RTS -l - - - - - 457fe789 by Alp Mestanogullari at 2019-06-11T22:42:30Z Hadrian: teach the RTS that PROFILING implies TRACING As discussed in #16744, both the Make and Hadrian build systems have special code to always pass -eventlog whenever -prof or -debug are passed. However, there is some similar logic in the RTS itself only for defining TRACING when the DEBUG macro is defined, but no such logic is implemented to define TRACING when the PROFILING macro is defined. This patch adds such a logic and therefore fixes #16744. - - - - - cf7f36ae by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Mmap into low memory on AArch64 This extends mmapForLinker to use the same low-memory mapping strategy used on x86_64 on AArch64. See #16784. - - - - - 0b7f81f5 by Ben Gamari at 2019-06-11T22:43:05Z rts/linker: Use mmapForLinker to map PLT The PLT needs to be located within a close distance of the code calling it under the small memory model. Fixes #16784. - - - - - 1389b2cc by Ömer Sinan Ağacan at 2019-06-11T22:43:43Z Fix an error message in CheckUnload.c:searchHeapBlocks - - - - - aad6115a by Alp Mestanogullari at 2019-06-11T22:44:20Z testsuite/mk/boilerplate.mk: rename 'ghc-config-mk' to 'ghc_config_mk' Make/shell variable names which contain dashes can cause problems under some conditions. The 'ghc-config-mk' variable from testsuite/mk/boilerplate.mk that I made overridable (by Hadrian) in ba0aed2e was working as expected when our Hadrian/Linux job was based off the deb8 Docker image, but broke when I switched the job to use our deb9-based image, in 3d97bad6. The exact circumstances/tool versions that trigger this problem are unknown, but changing the variable's name to 'ghc_config_mk' lets us work around the issue. This fixes the annth_compunits and annth_make test failures that showed up when we switched the Hadrian/Linux job to use the deb9 environment. - - - - - 9b4ff57d by Ben Gamari at 2019-06-12T11:35:25Z llvm-targets: Add armv7l-unknown-linux-gnueabi Fixes #15208. [skip ci] - - - - - c05ca251 by Ben Gamari at 2019-06-12T11:36:01Z testsuite: Add haddock perf test output to gitignore [skip ci] - - - - - bbc752c5 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Make elf_got.c a bit more legible - - - - - 217e6db4 by Ben Gamari at 2019-06-12T11:36:36Z rts/linker: Only mprotect GOT after it is filled This fixes a regression, introduced by 67c422ca, where we mprotect'd the global offset table (GOT) region to PROT_READ before we had finished filling it, resulting in a linker crash. Fixes #16779. - - - - - 1219f8e8 by Krzysztof Gogolewski at 2019-06-12T11:37:12Z Use DeriveFunctor throughout the codebase (#15654) - - - - - bd2d13ff by Ben Gamari at 2019-06-12T12:19:59Z Bump binary to 0.8.7.0 (cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8) - - - - - 381c3ae3 by Ben Gamari at 2019-06-12T12:19:59Z Bump Cabal submodule (cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d) Metric Increase: haddock.Cabal - - - - - 0354c7de by Ben Gamari at 2019-06-12T12:19:59Z Bump time submodule to 1.9.3 (cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368) - - - - - e0b16eaa by Ben Gamari at 2019-06-12T12:19:59Z Bump terminfo to 0.4.1.4 (cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df) - - - - - 2ce320b0 by Ben Gamari at 2019-06-12T12:19:59Z gitlab-ci: Test using slowtest in deb9-debug job - - - - - 90e7c450 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark hWaitForInput-accurate-stdin as broken in threaded ways As noted in #16535. - - - - - 488187f8 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13167 as fragile in threaded2 As noted in #16536. - - - - - 9b583320 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T13910 as broken in optasm Due to #16537. - - - - - eb644865 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T14761c as broken in hpc, profasm, and optasm ways As noted in #16540. - - - - - 1a204e07 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Mark T16180 as broken in ghci and ext-interp ways As noted in #16541. - - - - - 8d482e45 by Ben Gamari at 2019-06-12T12:19:59Z testsuite: Omit tcrun022 in hpc way As noted in #16542, the expected rule doesn't fire. However, this doesn't seem terribly surpring given the circumstances. - - - - - 68cfdfdb by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark Overflow as broken in hpc way As noted in #16543. - - - - - a3929a4f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T2783 as fragile in threaded1 It was previously marked as broken but it passes non-deterministically. See #2783. - - - - - bb7ed32f by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T7919 in ghci way It times out pretty reliably. It's not clear that much is gained by running this test in the ghci way anyways. - - - - - 329dcd7a by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix fragile_for test modifier - - - - - 55b5bb14 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Fix omit_ways usage omit_ways expects a list but this was broken in several cases. - - - - - 264ad286 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark threadstatus-T9333 as fragile in ghci way As noted in #16555. - - - - - 587bef66 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Omit profasm way for cc017 cc017 requires TH but we can't load dynamic profiled objects. - - - - - dc5a37fd by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Skip T493 in ghci way. T493 tests #493, which is an FFI test. FFI tests should be skipped in ghci way. - - - - - e3f71d0e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16449_2 as broken due to #16742 - - - - - b5a13a1e by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Mark T16737 as broken in ghci way due to #16541 - - - - - b09374a4 by Ben Gamari at 2019-06-12T12:20:25Z testsuite: Note intentional typo in T7130 I earlier accidentally corrected it breaking the test. - - - - - a798c130 by Ben Gamari at 2019-06-12T12:20:25Z linters/check-makefiles: Limit lint to Makefiles Previously we would apply this rule, which is only intended for testsuite Makefiles, to all files. This lead to a number of false-positives in all.T files. - - - - - 0782141e by Ben Gamari at 2019-06-12T12:20:25Z gitlab-ci: Fetch submodules before running submodule linter - - - - - 898f7e92 by Ben Gamari at 2019-06-12T12:20:25Z Fix uses of #ifdef/#ifndef The linter now enforces our preference for `#if defined()` and `#if !defined()`. - - - - - 0a13a04c by Ben Gamari at 2019-06-12T12:20:25Z Bump unix submodule Marks posix002 as fragile in threaded2 way due to #16550. - - - - - a8579e5b by Ben Gamari at 2019-06-12T12:27:25Z process: Bump submodule * Skip process005 in ghci way * Mark process002 as fragile in threaded2 - - - - - 3f1022c5 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Skip cgrun078 in ghci way This test requires FFI usage. - - - - - 1cbfef47 by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Unbreak galois_raytrace on i386 galois_raytrace was previously broken on i386 due to use of x87 arithmethic on that platform. However, 42504f4a575395a35eec5c3fd7c9ef6e2b54e68e removes x87 support; this resulted in an unexpected pass. Unmark this test as broken. - - - - - 20160f1a by Ben Gamari at 2019-06-12T12:27:25Z testsuite: Don't run tests requiring TH in profasm way when GhcDynamic Since we can't load profiled objects when GhcDynamic==YES. Affects: * T16737 * T16384 * T16718 * T16619 * T16190 - - - - - 5b05f192 by Ben Gamari at 2019-06-12T18:06:47Z base/Event/Poll: Drop POLLRDHUP enum item Previously the Event enumeration produced by hsc2hs would sometimes include a currently-unused POLLRDHUP item. This unused binding would result in a build failure. Drop it. - - - - - 1e4c7e15 by Ben Gamari at 2019-06-12T18:06:47Z testsuite: Fix T8602 on musl Musl wants hash-bangs on all executables. - - - - - f648b0b8 by Ben Gamari at 2019-06-12T18:06:47Z testsuite: Ensure T5423 flushes C output buffer Previously T5423 would fail to flush the printf output buffer. Consequently it was platform-dependent whether the C or Haskell print output would be emitted first. - - - - - 29b91271 by Ben Gamari at 2019-06-12T18:06:47Z testsuite: Flush conc059's printf buffer Otherwise it the order out the Haskell and C output will be system-dependent. - - - - - f7c5773b by Ben Gamari at 2019-06-12T18:06:47Z testsuite: Ensure that ffi005 output order is predictable The libc output buffer wasn't being flushed, making the order system-depedent. - - - - - 447aae79 by Ben Gamari at 2019-06-12T18:06:47Z gitlab-ci: Build alpine release bindists - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - aclocal.m4 - compiler/basicTypes/UniqSupply.hs - compiler/cmm/CmmLint.hs - compiler/cmm/Hoopl/Block.hs - compiler/cmm/PprC.hs - compiler/codeGen/StgCmmExtCode.hs - compiler/codeGen/StgCmmMonad.hs - compiler/coreSyn/CoreLint.hs - compiler/deSugar/Coverage.hs - compiler/ghc.cabal.in - compiler/ghci/ByteCodeAsm.hs - compiler/ghci/ByteCodeGen.hs - compiler/ghci/GHCi.hs - compiler/hsSyn/Convert.hs - compiler/hsSyn/HsBinds.hs - compiler/llvmGen/LlvmCodeGen/Base.hs - compiler/main/Annotations.hs - compiler/main/CmdLineParser.hs - compiler/main/DynFlags.hs - compiler/main/DynamicLoading.hs - compiler/main/GhcMake.hs - compiler/main/GhcMonad.hs - compiler/main/HscTypes.hs - compiler/main/PipelineMonad.hs - compiler/main/TidyPgm.hs - compiler/nativeGen/AsmCodeGe