[Git][ghc/ghc] Pushed new branch wip/dcoutts/windows-dlls-hacking-branch
by Duncan Coutts (＠dcoutts) 15 Apr '26
by Duncan Coutts (＠dcoutts) 15 Apr '26
15 Apr '26
Duncan Coutts pushed new branch wip/dcoutts/windows-dlls-hacking-branch at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dcoutts/windows-dlls-hacking-…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/ghc-pkg-ospath] Migrate `ghc-pkg` to use `OsPath` and `file-io`
by Hannes Siebenhandl (＠fendor) 15 Apr '26
by Hannes Siebenhandl (＠fendor) 15 Apr '26
15 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/ghc-pkg-ospath at Glasgow Haskell Compiler / GHC
Commits:
1f84c19b by Fendor at 2026-04-15T15:49:37+02:00
Migrate `ghc-pkg` to use `OsPath` and `file-io`
`ghc-pkg` should use UNC paths as much as possible to avoid MAX_PATH
issues on windows.
`file-io` uses UNC Paths by default on windows, ensuring we use the
correct APIs and that we finally are no longer plagued by MAX_PATH
issues in CI and private machines.
On top of it, the higher correctness of `OsPath` is appreciated in this
small codebase. Also, we improve memory usage very slightly, due to the
more efficient memory representation of `OsPath` over `FilePath`
Adds `ghc-pkg` regression test for MAX_PATH on windows
Make sure `ghc-pkg` behaves as expected when long paths (> 255) are
involved on windows.
Let's generate a testcase where we can actually observe that `ghc-pkg`
behaves as epxected.
See the documentation for windows on Maximum Path Length Limitation:
* `https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation`
Adds changelog entry for long path support in ghc-pkg.
- - - - -
9 changed files:
- + changelog.d/ghc-pkg-long-path-support
- compiler/GHC/Unit/State.hs
- libraries/ghc-boot/GHC/Unit/Database.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- testsuite/tests/cabal/Makefile
- testsuite/tests/cabal/all.T
- + testsuite/tests/cabal/ghcpkg10.stdout
- utils/ghc-pkg/Main.hs
- utils/ghc-pkg/ghc-pkg.cabal.in
Changes:
=====================================
changelog.d/ghc-pkg-long-path-support
=====================================
@@ -0,0 +1,15 @@
+section: ghc-pkg
+synopsis: Improve ``ghc-pkg``'s support for long paths on windows.
+issues: #26960
+mrs: !15584
+
+description: {
+ ``ghc-pkg`` can't handle working with file paths longer than the MAX_PATH
+ restrictions on windows as it is not using UNC file paths by default.
+
+ By using UNC file paths whenever possible, we improve ``ghc-pkg`` on windows.
+ Note, this still requires the user to enable the use of long paths in order to opt-in
+ this behaviour on older windows machines.
+}
+
+
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -802,7 +802,7 @@ readUnitDatabase logger cfg conf_file = do
if cache_exists
then do
debugTraceMsg logger 2 $ text "Using binary package database:" <+> ppr filename
- readPackageDbForGhc (OsPath.unsafeDecodeUtf filename)
+ readPackageDbForGhc filename
else do
-- If there is no package.cache file, we check if the database is not
-- empty by inspecting if the directory contains any .conf file. If it
=====================================
libraries/ghc-boot/GHC/Unit/Database.hs
=====================================
@@ -68,6 +68,8 @@ module GHC.Unit.Database
-- * Misc
, mkMungePathUrl
, mungeUnitInfoPaths
+ , writeFileAtomic
+ , unsafeDecodeUtf
)
where
@@ -86,18 +88,23 @@ import Data.Binary.Get as Bin
import Data.List (intersperse)
import Control.Exception as Exception
import Control.Monad (when)
-import System.FilePath as FilePath
+import qualified System.FilePath as FilePath
#if !defined(mingw32_HOST_OS)
import Data.Bits ((.|.))
-import System.Posix.Files
+import System.Posix.Files.PosixString
import System.Posix.Types (FileMode)
+import System.OsString.Internal.Types (getOsString)
#endif
import System.IO
import System.IO.Error
import GHC.IO.Exception (IOErrorType(InappropriateType))
import qualified GHC.Data.ShortText as ST
import GHC.IO.Handle.Lock
-import System.Directory
+import GHC.Stack.Types (HasCallStack)
+import System.OsPath
+import qualified System.Directory.OsPath as OsPath
+import qualified System.Directory.Internal as OsPath.Internal
+import qualified System.File.OsPath as FileIO
-- | @ghc-boot@'s UnitInfo, serialized to the database.
type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
@@ -314,13 +321,13 @@ data DbInstUnitId
newtype PackageDbLock = PackageDbLock Handle
-- | Acquire an exclusive lock related to package DB under given location.
-lockPackageDb :: FilePath -> IO PackageDbLock
+lockPackageDb :: OsPath -> IO PackageDbLock
-- | Release the lock related to package DB.
unlockPackageDb :: PackageDbLock -> IO ()
-- | Acquire a lock of given type related to package DB under given location.
-lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock
+lockPackageDbWith :: LockMode -> OsPath -> IO PackageDbLock
lockPackageDbWith mode file = do
-- We are trying to open the lock file and then lock it. Thus the lock file
-- needs to either exist or we need to be able to create it. Ideally we
@@ -350,10 +357,10 @@ lockPackageDbWith mode file = do
(lockFileOpenIn ReadWriteMode)
(const $ lockFileOpenIn ReadMode)
where
- lock = file <.> "lock"
+ lock = file <.> OsPath.Internal.os "lock"
lockFileOpenIn io_mode = bracketOnError
- (openBinaryFile lock io_mode)
+ (FileIO.openBinaryFile lock io_mode)
hClose
-- If file locking support is not available, ignore the error and proceed
-- normally. Without it the only thing we lose on non-Windows platforms is
@@ -387,7 +394,7 @@ isDbOpenReadMode = \case
-- | Read the part of the package DB that GHC is interested in.
--
-readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]
+readPackageDbForGhc :: OsPath -> IO [DbUnitInfo]
readPackageDbForGhc file =
decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case
(pkgs, DbOpenReadOnly) -> return pkgs
@@ -409,7 +416,7 @@ readPackageDbForGhc file =
-- we additionally receive a PackageDbLock that represents a lock on the
-- database, so that we can safely update it later.
--
-readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->
+readPackageDbForGhcPkg :: Binary pkgs => OsPath -> DbOpenMode mode t ->
IO (pkgs, DbOpenMode mode PackageDbLock)
readPackageDbForGhcPkg file mode =
decodeFromFile file mode getDbForGhcPkg
@@ -425,7 +432,7 @@ readPackageDbForGhcPkg file mode =
-- | Write the whole of the package DB, both parts.
--
-writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()
+writePackageDb :: Binary pkgs => OsPath -> [DbUnitInfo] -> pkgs -> IO ()
writePackageDb file ghcPkgs ghcPkgPart = do
writeFileAtomic file (runPut putDbForGhcPkg)
#if !defined(mingw32_HOST_OS)
@@ -446,10 +453,10 @@ writePackageDb file ghcPkgs ghcPkgPart = do
ghcPart = encode ghcPkgs
#if !defined(mingw32_HOST_OS)
-addFileMode :: FilePath -> FileMode -> IO ()
+addFileMode :: OsPath -> FileMode -> IO ()
addFileMode file m = do
- o <- fileMode <$> getFileStatus file
- setFileMode file (m .|. o)
+ o <- fileMode <$> getFileStatus (getOsString file)
+ setFileMode (getOsString file) (m .|. o)
#endif
getHeader :: Get (Word32, Word32)
@@ -496,7 +503,7 @@ headerMagic = BS.Char8.pack "\0ghcpkg\0"
-- | Feed a 'Get' decoder with data chunks from a file.
--
-decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->
+decodeFromFile :: OsPath -> DbOpenMode mode t -> Get pkgs ->
IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile file mode decoder = case mode of
DbOpenReadOnly -> do
@@ -517,7 +524,7 @@ decodeFromFile file mode decoder = case mode of
bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do
(, DbOpenReadWrite lock) <$> decodeFileContents
where
- decodeFileContents = withBinaryFile file ReadMode $ \hnd ->
+ decodeFileContents = FileIO.withBinaryFile file ReadMode $ \hnd ->
feed hnd (runGetIncremental decoder)
feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
@@ -527,21 +534,21 @@ decodeFromFile file mode decoder = case mode of
feed _ (Done _ _ res) = return res
feed _ (Fail _ _ msg) = ioError err
where
- err = mkIOError InappropriateType loc Nothing (Just file)
+ err = mkIOError InappropriateType loc Nothing (Just $ unsafeDecodeUtf file)
`ioeSetErrorString` msg
loc = "GHC.Unit.Database.readPackageDb"
-- Copied from Cabal's Distribution.Simple.Utils.
-writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
+writeFileAtomic :: OsPath -> BS.Lazy.ByteString -> IO ()
writeFileAtomic targetPath content = do
let (targetDir, targetFile) = splitFileName targetPath
Exception.bracketOnError
- (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")
- (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
+ (FileIO.openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> OsPath.Internal.os "tmp")
+ (\(tmpPath, handle) -> hClose handle >> OsPath.removeFile tmpPath)
(\(tmpPath, handle) -> do
BS.Lazy.hPut handle content
hClose handle
- renameFile tmpPath targetPath)
+ OsPath.renameFile tmpPath targetPath)
instance Binary DbUnitInfo where
put (GenericUnitInfo
@@ -711,7 +718,7 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- rather than letting FilePath change it to use \ as the separator
stripVarPrefix var path = case ST.stripPrefix var path of
Just "" -> Just ""
- Just cs | isPathSeparator (ST.head cs) -> Just cs
+ Just cs | FilePath.isPathSeparator (ST.head cs) -> Just cs
_ -> Nothing
@@ -742,3 +749,8 @@ mungeUnitInfoPaths top_dir pkgroot pkg =
munge_paths = map munge_path
munge_urls = map munge_url
(munge_path,munge_url) = mkMungePathUrl top_dir pkgroot
+
+-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
+-- Prefer 'decodeUtf' and gracious error handling.
+unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
+unsafeDecodeUtf = OsPath.Internal.so
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -82,6 +82,8 @@ Library
containers >= 0.5 && < 0.9,
directory >= 1.2 && < 1.4,
filepath >= 1.3 && < 1.6,
+ file-io >= 0.1.5 && < 0.3,
+ os-string >= 2.0.1 && < 2.1,
deepseq >= 1.4 && < 1.6,
ghc-platform >= 0.1,
ghc-toolchain >= 0.1
=====================================
testsuite/tests/cabal/Makefile
=====================================
@@ -79,6 +79,25 @@ ghcpkg04 :
@: # testpkg-1.2.3.4 and newtestpkg-2.0 are both exposed now
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONF04) -c ghcpkg04.hs || true
+PKGCONF20=local20.package.conf
+LOCAL_GHC_PKG20 = '$(GHC_PKG)' --no-user-package-db
+
+DIR1=asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf
+DIR2=zxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcv
+DIR3=uiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiop
+DIR4=qwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwer
+WDIR=$(DIR1)/$(DIR2)/$(DIR3)/$(DIR4)
+.PHONY: ghcpkg10
+ghcpkg10 :
+ @mkdir -p $(WDIR)
+ @rm -rf $(WDIR)/$(PKGCONF20)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) init $(WDIR)/$(PKGCONF20)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) list
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) register --force test.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) describe testpkg | $(STRIP_PKGROOT)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) describe testpkg-1.2.3.4 | $(STRIP_PKGROOT)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) field testpkg-1.2.3.4 import-dirs
+
# Test stacking of package.confs (also #2441)
PKGCONF05a=local05a.package.conf
PKGCONF05b=local05b.package.conf
=====================================
testsuite/tests/cabal/all.T
=====================================
@@ -5,6 +5,7 @@ def ignore_warnings(str):
return re.sub(r'Warning:.*\n', '', str)
test('ghcpkg01', [extra_files(['test.pkg', 'test2.pkg', 'test3.pkg'])], makefile_test, [])
+test('ghcpkg10', [extra_files(['test.pkg', 'test2.pkg', 'test3.pkg'])], makefile_test, [])
# Use ignore_stderr to prevent (when HADDOCK_DOCS=NO):
# warning: haddock-interfaces .. doesn't exist or isn't a file
=====================================
testsuite/tests/cabal/ghcpkg10.stdout
=====================================
@@ -0,0 +1,50 @@
+asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf/zxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcv/uiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiop/qwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwer/local20.package.conf
+ (no packages)
+Reading package info from "test.pkg" ... done.
+name: testpkg
+version: 1.2.3.4
+visibility: public
+id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4-XXX
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users(a)haskell.org
+author: simonmar(a)microsoft.com
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+exposed: True
+exposed-modules: A
+hidden-modules: B C.D
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+hs-libraries: testpkg-1.2.3.4-XXX
+include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
+pkgroot:
+
+name: testpkg
+version: 1.2.3.4
+visibility: public
+id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4-XXX
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users(a)haskell.org
+author: simonmar(a)microsoft.com
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+exposed: True
+exposed-modules: A
+hidden-modules: B C.D
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+hs-libraries: testpkg-1.2.3.4-XXX
+include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
+pkgroot:
+
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
=====================================
utils/ghc-pkg/Main.hs
=====================================
@@ -47,12 +47,19 @@ import Distribution.Types.UnqualComponentName
import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.MungedPackageId
-import Distribution.Simple.Utils (toUTF8BS, writeUTF8File, readUTF8File)
+import Distribution.Simple.Utils (ignoreBOM, toUTF8BS, toUTF8LBS, fromUTF8LBS)
import qualified Data.Version as Version
-import System.FilePath as FilePath
+import System.OsPath as OsPath
+import qualified System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
-import System.Directory ( getXdgDirectory, createDirectoryIfMissing, getAppUserDataDirectory,
- getModificationTime, XdgDirectory ( XdgData ) )
+import System.Directory.OsPath
+ ( getXdgDirectory, createDirectoryIfMissing, getAppUserDataDirectory,
+ getModificationTime, XdgDirectory ( XdgData ),
+ doesDirectoryExist, getDirectoryContents,
+ doesFileExist, removeFile,
+ getCurrentDirectory )
+import System.Directory.Internal (os)
+import qualified System.File.OsPath as FileIO
import Text.Printf
import Prelude hiding (Foldable(..))
@@ -65,15 +72,13 @@ import Data.Bifunctor
import Data.Char ( toLower )
import Control.Monad
-import System.Directory ( doesDirectoryExist, getDirectoryContents,
- doesFileExist, removeFile,
- getCurrentDirectory )
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
import System.IO.Error
-import GHC.IO ( catchException )
+import GHC.IO ( catchException, unsafePerformIO )
import GHC.IO.Exception (IOErrorType(InappropriateType))
+import GHC.Stack.Types (HasCallStack)
import Data.List ( group, sort, sortBy, nub, partition, find
, intercalate, intersperse, unfoldr
, isInfixOf, isSuffixOf, isPrefixOf, stripPrefix )
@@ -429,8 +434,9 @@ runit verbosity cli nonopts = do
print filename
glob filename >>= print
#endif
- ["init", filename] ->
- initPackageDB filename verbosity cli
+ ["init", filename] -> do
+ filenameOs <- encodeFS filename
+ initPackageDB filenameOs verbosity cli
["register", filename] ->
registerPackage filename verbosity cli
multi_instance
@@ -538,7 +544,7 @@ readPackageArg AsDefault str = Id <$> readGlobPkgId str
data PackageDB (mode :: GhcPkg.DbMode)
= PackageDB {
- location, locationAbsolute :: !FilePath,
+ location, locationAbsolute :: !OsPath,
-- We need both possibly-relative and definitely-absolute package
-- db locations. This is because the relative location is used as
-- an identifier for the db, so it is important we do not modify it.
@@ -570,14 +576,14 @@ allPackagesInStack = concatMap packages
-- specified package DB can depend on, since dependencies can only extend
-- down the stack, not up (e.g. global packages cannot depend on user
-- packages).
-stackUpTo :: FilePath -> PackageDBStack -> PackageDBStack
+stackUpTo :: OsPath -> PackageDBStack -> PackageDBStack
stackUpTo to_modify = dropWhile ((/= to_modify) . location)
-readFromSettingsFile :: FilePath
- -> (FilePath -> RawSettings -> Either String b)
+readFromSettingsFile :: OsPath
+ -> (OsPath -> RawSettings -> Either String b)
-> IO (Either String b)
readFromSettingsFile settingsFile f = do
- settingsStr <- readFile settingsFile
+ settingsStr <- readUtf8File settingsFile
pure $ do
mySettings <- case maybeReadFuzzy settingsStr of
Just s -> pure $ Map.fromList s
@@ -586,11 +592,11 @@ readFromSettingsFile settingsFile f = do
Nothing -> Left $ "Can't parse settings file " ++ show settingsFile
f settingsFile mySettings
-readFromTargetFile :: FilePath
+readFromTargetFile :: OsPath
-> (Target -> b)
-> IO (Either String b)
readFromTargetFile targetFile f = do
- targetStr <- readFile targetFile
+ targetStr <- readUtf8File targetFile
pure $ do
target <- case maybeReadFuzzy targetStr of
Just t -> Right t
@@ -626,33 +632,35 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
case [ f | FlagGlobalConfig f <- my_flags ] of
-- See Note [Base Dir] for more information on the base dir / top dir.
[] -> do mb_dir <- getBaseDir
- case mb_dir of
+ mb_dir_os <- traverse encodeFS mb_dir
+ case mb_dir_os of
Nothing -> die err_msg
Just dir -> do
-- Look for where it is given in the settings file, if marked there.
-- See Note [Settings file] about this file, and why we need GHC to share it with us.
- let settingsFile = dir </> "settings"
+ let settingsFile = dir </> os "settings"
exists_settings_file <- doesFileExist settingsFile
erel_db <-
if exists_settings_file
- then readFromSettingsFile settingsFile getGlobalPackageDb
- else pure (Left ("Settings file doesn't exist: " ++ settingsFile))
+ then do
+ readFromSettingsFile settingsFile (\ settings -> getGlobalPackageDb (unsafeDecodeUtf settings))
+ else pure (Left ("Settings file doesn't exist: " ++ showOsPath settingsFile))
case erel_db of
- Right rel_db -> return (dir, dir </> rel_db)
+ Right rel_db -> return (dir, dir </> unsafeEncodeUtf rel_db)
-- If the version of GHC doesn't have this field or the settings file
-- doesn't exist for some reason, look in the libdir.
Left err -> do
r <- lookForPackageDBIn dir
case r of
- Nothing -> die (unlines [err, ("Fallback: Can't find package database in " ++ dir)])
+ Nothing -> die (unlines [err, ("Fallback: Can't find package database in " ++ showOsPath dir)])
Just path -> return (dir, path)
fs -> do
-- The value of the $topdir variable used in some package descriptions
-- Note that the way we calculate this is slightly different to how it
-- is done in ghc itself. We rely on the convention that the global
-- package db lives in ghc's libdir.
- let pkg_db = last fs
+ let pkg_db = unsafeEncodeUtf $ last fs
top_dir <- absolutePath (takeDirectory pkg_db)
return (top_dir, pkg_db)
@@ -662,10 +670,10 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- getXdgDirectory can fail (e.g. if $HOME isn't set)
mb_user_conf <-
- case [ f | FlagUserConfig f <- my_flags ] of
+ case [ unsafeEncodeUtf f | FlagUserConfig f <- my_flags ] of
_ | no_user_db -> return Nothing
[] -> do
- let targetFile = top_dir </> "targets" </> "default.target"
+ let targetFile = top_dir </> os "targets" </> os "default.target"
exists_settings_file <- doesFileExist targetFile
targetArchOS <- case exists_settings_file of
False -> do
@@ -694,15 +702,15 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR
--
-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version
- m_appdir <- getFirstSuccess $ map (fmap (</> subdir))
- [ getAppUserDataDirectory "ghc" -- this is ~/.ghc/
- , getXdgDirectory XdgData "ghc" -- this is $XDG_DATA_HOME/
+ m_appdir <- getFirstSuccess $ map (fmap (</> unsafeEncodeUtf subdir))
+ [ getAppUserDataDirectory $ os "ghc" -- this is ~/.ghc/
+ , getXdgDirectory XdgData $ os "ghc" -- this is $XDG_DATA_HOME/
]
case m_appdir of
Nothing -> return Nothing
Just dir -> do
lookForPackageDBIn dir >>= \case
- Nothing -> return (Just (dir </> "package.conf.d", False))
+ Nothing -> return (Just (dir </> os "package.conf.d", False))
Just f -> return (Just (f, True))
fs -> return (Just (last fs, True))
@@ -716,11 +724,11 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
e_pkg_path <- tryIO (System.Environment.getEnv "GHC_PACKAGE_PATH")
let env_stack =
- case e_pkg_path of
+ case fmap unsafeEncodeUtf e_pkg_path of
Left _ -> sys_databases
Right path
- | not (null path) && isSearchPathSeparator (last path)
- -> splitSearchPath (init path) ++ sys_databases
+ | hasTrailingPathSeparator path
+ -> splitSearchPath (dropTrailingPathSeparator path) <> sys_databases
| otherwise
-> splitSearchPath path
@@ -733,7 +741,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
| Just (user_conf, _user_exists) <- mb_user_conf
= Just user_conf
is_db_flag FlagGlobal = Just virt_global_conf
- is_db_flag (FlagConfig f) = Just f
+ is_db_flag (FlagConfig f) = Just $ unsafeEncodeUtf f
is_db_flag _ = Nothing
let flag_db_names | null db_flags = env_stack
@@ -748,7 +756,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- stack, unless any of them are present in the stack
-- already.
let final_stack = filter (`notElem` env_stack)
- [ f | FlagConfig f <- reverse my_flags ]
+ [ unsafeEncodeUtf f | FlagConfig f <- reverse my_flags ]
++ env_stack
top_db = if null db_flags
@@ -764,7 +772,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
when (verbosity > Normal) $ do
infoLn ("db stack: " ++ show (map location db_stack))
F.forM_ db_to_operate_on $ \db ->
- infoLn ("modifying: " ++ (location db))
+ infoLn ("modifying: " ++ showOsPath (location db))
infoLn ("flag db stack: " ++ show (map location flag_db_stack))
return (db_stack, db_to_operate_on, flag_db_stack)
@@ -843,17 +851,19 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
return (db_stack, GhcPkg.DbOpenReadWrite to_modify)
where
- couldntOpenDbForModification :: FilePath -> IOError -> IO a
+ couldntOpenDbForModification :: OsPath -> IOError -> IO a
couldntOpenDbForModification db_path e = die $ "Couldn't open database "
- ++ db_path ++ " for modification: " ++ show e
+ ++ showOsPath db_path ++ " for modification: " ++ show e
-- Parse package db in read-only mode.
- readDatabase :: FilePath -> IO (PackageDB 'GhcPkg.DbReadOnly)
+ readDatabase :: OsPath -> IO (PackageDB 'GhcPkg.DbReadOnly)
readDatabase db_path = do
db <- readParseDatabase verbosity mb_user_conf
GhcPkg.DbOpenReadOnly use_cache db_path
if expand_vars
- then return $ mungePackageDBPaths top_dir db
+ then do
+ top_dir_filepath <- decodeFS top_dir
+ return $ mungePackageDBPaths top_dir_filepath db
else return db
stateSequence :: Monad m => s -> [s -> m (a, s)] -> m ([a], s)
@@ -863,20 +873,20 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
(as, s'') <- stateSequence s' ms
return (a : as, s'')
-lookForPackageDBIn :: FilePath -> IO (Maybe FilePath)
+lookForPackageDBIn :: OsPath -> IO (Maybe OsPath)
lookForPackageDBIn dir = do
- let path_dir = dir </> "package.conf.d"
+ let path_dir = dir </> os "package.conf.d"
exists_dir <- doesDirectoryExist path_dir
if exists_dir then return (Just path_dir) else do
- let path_file = dir </> "package.conf"
+ let path_file = dir </> os "package.conf"
exists_file <- doesFileExist path_file
if exists_file then return (Just path_file) else return Nothing
readParseDatabase :: forall mode t. Verbosity
- -> Maybe (FilePath,Bool)
+ -> Maybe (OsPath,Bool)
-> GhcPkg.DbOpenMode mode t
-> Bool -- use cache
- -> FilePath
+ -> OsPath
-> IO (PackageDB mode)
readParseDatabase verbosity mb_user_conf mode use_cache path
-- the user database (only) is allowed to be non-existent
@@ -898,7 +908,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
Just db -> return db
Nothing ->
die $ "ghc no longer supports single-file style package "
- ++ "databases (" ++ path ++ ") use 'ghc-pkg init'"
+ ++ "databases (" ++ showOsPath path ++ ") use 'ghc-pkg init'"
++ "to create the database with the correct format."
| otherwise -> ioError err
@@ -914,7 +924,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
-- It's fine if the cache is not there as long as the
-- database is empty.
when (not $ null confs) $ do
- warn ("WARNING: cache does not exist: " ++ cache)
+ warn ("WARNING: cache does not exist: " ++ showOsPath cache)
warn ("ghc will fail to read this package db. " ++
recacheAdvice)
else do
@@ -923,7 +933,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
ignore_cache (const $ return ())
Right tcache -> do
when (verbosity >= Verbose) $ do
- warn ("Timestamp " ++ show tcache ++ " for " ++ cache)
+ warn ("Timestamp " ++ show tcache ++ " for " ++ showOsPath cache)
-- If any of the .conf files is newer than package.cache, we
-- assume that cache is out of date.
cache_outdated <- (`anyM` confs) $ \conf ->
@@ -931,12 +941,12 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
if not cache_outdated
then do
when (verbosity > Normal) $
- infoLn ("using cache: " ++ cache)
+ infoLn ("using cache: " ++ showOsPath cache)
GhcPkg.readPackageDbForGhcPkg cache mode
>>= uncurry mkPackageDB
else do
whenReportCacheErrors $ do
- warn ("WARNING: cache is out of date: " ++ cache)
+ warn ("WARNING: cache is out of date: " ++ showOsPath cache)
warn ("ghc will see an old view of this " ++
"package db. " ++ recacheAdvice)
ignore_cache $ \file -> do
@@ -947,11 +957,11 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
GT -> " (older than cache)"
EQ -> " (same as cache)"
warn ("Timestamp " ++ show tFile
- ++ " for " ++ file ++ rel)
+ ++ " for " ++ showOsPath file ++ rel)
where
- confs = map (path </>) $ filter (".conf" `isSuffixOf`) fs
+ confs = map (path </>) $ filter (os ".conf" `OsPath.isExtensionOf`) fs
- ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode)
+ ignore_cache :: (OsPath -> IO ()) -> IO (PackageDB mode)
ignore_cache checkTime = do
-- If we're opening for modification, we need to acquire a
-- lock even if we don't open the cache now, because we are
@@ -987,17 +997,18 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
packages = pkgs
}
-parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
+parseSingletonPackageConf :: Verbosity -> OsPath -> IO InstalledPackageInfo
parseSingletonPackageConf verbosity file = do
- when (verbosity > Normal) $ infoLn ("reading package config: " ++ file)
- BS.readFile file >>= fmap fst . parsePackageInfo
+ when (verbosity > Normal) $ infoLn ("reading package config: " ++ showOsPath file)
+ FileIO.readFile file >>= fmap fst . parsePackageInfo . BS.toStrict
+
-cachefilename :: FilePath
-cachefilename = "package.cache"
+cachefilename :: OsPath
+cachefilename = os "package.cache"
mungePackageDBPaths :: FilePath -> PackageDB mode -> PackageDB mode
mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =
- db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
+ db { packages = map (mungePackagePaths top_dir (unsafeDecodeUtf pkgroot)) pkgs }
where
pkgroot = takeDirectory $ dropTrailingPathSeparator (locationAbsolute db)
-- It so happens that for both styles of package db ("package.conf"
@@ -1044,12 +1055,13 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
| Just p' <- stripVarPrefix "$httptopdir" p = toUrlPath top_dir p'
| otherwise = p
+ toUrlPath :: FilePath -> FilePath -> FilePath
toUrlPath r p = "file:///"
-- URLs always use posix style '/' separators:
++ FilePath.Posix.joinPath
(r : -- We need to drop a leading "/" or "\\"
-- if there is one:
- dropWhile (all isPathSeparator)
+ dropWhile (all FilePath.isPathSeparator)
(FilePath.splitDirectories p))
-- We could drop the separator here, and then use </> above. However,
@@ -1057,7 +1069,7 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- rather than letting FilePath change it to use \ as the separator
stripVarPrefix var path = case stripPrefix var path of
Just [] -> Just []
- Just cs@(c : _) | isPathSeparator c -> Just cs
+ Just cs@(c : _) | FilePath.isPathSeparator c -> Just cs
_ -> Nothing
-- -----------------------------------------------------------------------------
@@ -1074,18 +1086,18 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- ghc itself also cooperates in this workaround
-tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool)
- -> GhcPkg.DbOpenMode mode t -> Bool -> FilePath
+tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (OsPath, Bool)
+ -> GhcPkg.DbOpenMode mode t -> Bool -> OsPath
-> IO (Maybe (PackageDB mode))
tryReadParseOldFileStyleDatabase verbosity mb_user_conf
mode use_cache path = do
-- assumes we've already established that path exists and is not a dir
- content <- readFile path `catchIO` \_ -> return ""
+ content <- readUtf8File path `catchIO` \_ -> return ""
if take 2 content == "[]"
then do
path_abs <- absolutePath path
let path_dir = adjustOldDatabasePath path
- warn $ "Warning: ignoring old file-style db and trying " ++ path_dir
+ warn $ "Warning: ignoring old file-style db and trying " ++ showOsPath path_dir
direxists <- doesDirectoryExist path_dir
if direxists
then do
@@ -1112,7 +1124,7 @@ tryReadParseOldFileStyleDatabase verbosity mb_user_conf
adjustOldFileStylePackageDB :: PackageDB mode -> IO (PackageDB mode)
adjustOldFileStylePackageDB db = do
-- assumes we have not yet established if it's an old style or not
- mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing
+ mcontent <- liftM Just (readUtf8File (location db)) `catchIO` \_ -> return Nothing
case fmap (take 2) mcontent of
-- it is an old style and empty db, so look for a dir kind in location.d/
Just "[]" -> return db {
@@ -1121,20 +1133,20 @@ adjustOldFileStylePackageDB db = do
}
-- it is old style but not empty, we have to bail
Just _ -> die $ "ghc no longer supports single-file style package "
- ++ "databases (" ++ location db ++ ") use 'ghc-pkg init'"
+ ++ "databases (" ++ showOsPath (location db) ++ ") use 'ghc-pkg init'"
++ "to create the database with the correct format."
-- probably not old style, carry on as normal
Nothing -> return db
-adjustOldDatabasePath :: FilePath -> FilePath
-adjustOldDatabasePath = (<.> "d")
+adjustOldDatabasePath :: OsPath -> OsPath
+adjustOldDatabasePath = (<.> os "d")
-- -----------------------------------------------------------------------------
-- Creating a new package DB
-initPackageDB :: FilePath -> Verbosity -> [Flag] -> IO ()
+initPackageDB :: OsPath -> Verbosity -> [Flag] -> IO ()
initPackageDB filename verbosity _flags = do
- let eexist = die ("cannot create: " ++ filename ++ " already exists")
+ let eexist = die ("cannot create: " ++ showOsPath filename ++ " already exists")
b1 <- doesFileExist filename
when b1 eexist
b2 <- doesDirectoryExist filename
@@ -1183,7 +1195,8 @@ registerPackage input verbosity my_flags multi_instance
f -> do
when (verbosity >= Normal) $
info ("Reading package info from " ++ show f ++ " ... ")
- readUTF8File f
+ fs <- encodeFS f
+ readUtf8File fs
expanded <- if expand_env_vars then expandEnvVars s force
else return s
@@ -1199,7 +1212,11 @@ registerPackage input verbosity my_flags multi_instance
-- validate the expanded pkg, but register the unexpanded
pkgroot <- absolutePath (takeDirectory to_modify)
let top_dir = takeDirectory (location (last db_stack))
- pkg_expanded = mungePackagePaths top_dir pkgroot pkg
+
+ top_dir_filepath <- decodeFS top_dir
+ pkgroot_filepath <- decodeFS pkgroot
+ let
+ pkg_expanded = mungePackagePaths top_dir_filepath pkgroot_filepath pkg
let truncated_stack = stackUpTo to_modify db_stack
-- truncate the stack for validation, because we don't allow
@@ -1274,13 +1291,13 @@ changeDBDir verbosity cmds db db_stack = do
updateDBCache verbosity db db_stack
where
do_cmd (RemovePackage p) = do
- let file = location db </> display (installedUnitId p) <.> "conf"
- when (verbosity > Normal) $ infoLn ("removing " ++ file)
+ let file = location db </> unsafeEncodeUtf (display (installedUnitId p)) <.> os "conf"
+ when (verbosity > Normal) $ infoLn ("removing " ++ showOsPath file)
removeFileSafe file
do_cmd (AddPackage p) = do
- let file = location db </> display (installedUnitId p) <.> "conf"
- when (verbosity > Normal) $ infoLn ("writing " ++ file)
- writeUTF8File file (showInstalledPackageInfo p)
+ let file = location db </> unsafeEncodeUtf (display (installedUnitId p)) <.> os "conf"
+ when (verbosity > Normal) $ infoLn ("writing " ++ showOsPath file)
+ writeUtf8File file (showInstalledPackageInfo p)
do_cmd (ModifyPackage p) =
do_cmd (AddPackage p)
@@ -1338,13 +1355,13 @@ updateDBCache verbosity db db_stack = do
warn $ " " ++ pkg
when (verbosity > Normal) $
- infoLn ("writing cache " ++ filename)
+ infoLn ("writing cache " ++ showOsPath filename)
let d = fmap (fromPackageCacheFormat . fst) pkgsGhcCacheFormat
GhcPkg.writePackageDb filename d pkgsCabalFormat
`catchIO` \e ->
if isPermissionError e
- then die $ filename ++ ": you don't have permission to modify this file"
+ then die $ showOsPath filename ++ ": you don't have permission to modify this file"
else ioError e
case packageDbLock db of
@@ -1583,7 +1600,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
broken = map installedUnitId (brokenPackages pkg_map)
show_normal PackageDB{ location = db_name, packages = pkg_confs } =
- do hPutStrLn stdout db_name
+ do hPutStrLn stdout (showOsPath db_name)
if null pkg_confs
then hPutStrLn stdout " (no packages)"
else hPutStrLn stdout $ unlines (map (" " ++) (map pp_pkg pkg_confs))
@@ -1610,7 +1627,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
#else
let
show_colour PackageDB{ location = db_name, packages = pkg_confs } =
- do hPutStrLn stdout db_name
+ do hPutStrLn stdout (showOsPath db_name)
if null pkg_confs
then hPutStrLn stdout " (no packages)"
else hPutStrLn stdout $ unlines (map (" " ++) (map pp_pkg pkg_confs))
@@ -1698,7 +1715,7 @@ dumpUnits verbosity my_flags expand_pkgroot = do
doDump expand_pkgroot [ (pkg, locationAbsolute db)
| db <- flag_db_stack, pkg <- packages db ]
-doDump :: Bool -> [(InstalledPackageInfo, FilePath)] -> IO ()
+doDump :: Bool -> [(InstalledPackageInfo, OsPath)] -> IO ()
doDump expand_pkgroot pkgs = do
-- fix the encoding to UTF-8, since this is an interchange format
hSetEncoding stdout utf8
@@ -1731,7 +1748,7 @@ findPackagesByDB db_stack pkgarg
cannotFindPackage :: PackageArg -> Maybe (PackageDB mode) -> IO a
cannotFindPackage pkgarg mdb = die $ "cannot find package " ++ pkg_msg pkgarg
- ++ maybe "" (\db -> " in " ++ location db) mdb
+ ++ maybe "" (\db -> " in " ++ showOsPath (location db)) mdb
where
pkg_msg (Id pkgid) = displayGlobPkgId pkgid
pkg_msg (IUId ipid) = display ipid
@@ -1944,7 +1961,7 @@ checkPackageConfig pkg verbosity db_stack
checkExposedModules db_stack pkg
checkOtherModules pkg
let has_code = Set.null (openModuleSubstFreeHoles (Map.fromList (instantiatedWith pkg)))
- when has_code $ mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)
+ when has_code $ mapM_ (checkHSLib verbosity (fmap unsafeEncodeUtf $ libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)
-- ToDo: check these somehow?
-- extra_libraries :: [String],
-- c_includes :: [String],
@@ -2011,20 +2028,20 @@ checkPath url_ok is_dir warn_only thisfield d
|| "https://" `isPrefixOf` d) = return ()
| url_ok
- , Just d' <- stripPrefix "file://" d
- = checkPath False is_dir warn_only thisfield d'
+ , Just f <- stripPrefix "file://" d
+ = checkPath False is_dir warn_only thisfield f
-- Note: we don't check for $topdir/${pkgroot} here. We rely on these
-- variables having been expanded already, see mungePackagePaths.
- | isRelative d = verror ForceFiles $
+ | isRelative d' = verror ForceFiles $
thisfield ++ ": " ++ d ++ " is a relative path which "
++ "makes no sense (as there is nothing for it to be "
++ "relative to). You can make paths relative to the "
++ "package database itself by using ${pkgroot}."
-- relative paths don't make any sense; #4134
| otherwise = do
- there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d
+ there <- liftIO $ if is_dir then doesDirectoryExist d' else doesFileExist d'
when (not there) $
let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a "
++ if is_dir then "directory" else "file"
@@ -2032,6 +2049,8 @@ checkPath url_ok is_dir warn_only thisfield d
if warn_only
then vwarn msg
else verror ForceFiles msg
+ where
+ d' = unsafeEncodeUtf d
checkDep :: PackageDBStack -> UnitId -> Validate ()
checkDep db_stack pkgid
@@ -2050,24 +2069,25 @@ checkDuplicateDepends deps
where
dups = [ p | (p:_:_) <- group (sort deps) ]
-checkHSLib :: Verbosity -> [String] -> String -> Validate ()
+checkHSLib :: Verbosity -> [OsPath] -> String -> Validate ()
checkHSLib _verbosity dirs lib = do
- let filenames = ["lib" ++ lib ++ ".a",
- "lib" ++ lib ++ "_p.a",
- "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so",
- "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so",
- "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib",
- "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib",
- lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll",
- lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll",
- lib ++ ".bytecodelib"
- ]
+ let filenames = fmap OsPath.unsafeEncodeUtf
+ [ "lib" ++ lib ++ ".a"
+ , "lib" ++ lib ++ "_p.a"
+ , "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so"
+ , "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so"
+ , "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib"
+ , "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib"
+ , lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll"
+ , lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll"
+ , lib ++ ".bytecodelib"
+ ]
b <- liftIO $ doesFileExistOnPath filenames dirs
when (not b) $
verror ForceFiles ("cannot find any of " ++ show filenames ++
" on library path")
-doesFileExistOnPath :: [FilePath] -> [FilePath] -> IO Bool
+doesFileExistOnPath :: [OsPath] -> [OsPath] -> IO Bool
doesFileExistOnPath filenames paths = anyM doesFileExist fullFilenames
where fullFilenames = [ path </> filename
| filename <- filenames
@@ -2096,9 +2116,9 @@ checkModuleFile :: InstalledPackageInfo -> ModuleName -> Validate ()
checkModuleFile pkg modl =
-- there's no interface file for GHC.Prim
unless (modl == ModuleName.fromString "GHC.Prim") $ do
- let files = [ ModuleName.toFilePath modl <.> extension
- | extension <- ["hi", "p_hi", "dyn_hi", "p_dyn_hi"] ]
- b <- liftIO $ doesFileExistOnPath files (importDirs pkg)
+ let files = [ unsafeEncodeUtf (ModuleName.toFilePath modl) <.> extension
+ | extension <- fmap os ["hi", "p_hi", "dyn_hi", "p_dyn_hi"] ]
+ b <- liftIO $ doesFileExistOnPath files (fmap unsafeEncodeUtf $ importDirs pkg)
when (not b) $
verror ForceFiles ("cannot find any of " ++ show files)
@@ -2273,19 +2293,45 @@ installSignalHandlers = do
return ()
#endif
+-- ------------------------------------------------
+-- OsPath Utils
+
+-- | Show an 'OsPath', throwing an exception if we fail to decode it.
+showOsPath :: HasCallStack => OsPath -> FilePath
+showOsPath = unsafePerformIO . decodeFS
+
+-- | Turn a path relative to the current directory into a (normalised)
+-- absolute path.
+absolutePath :: OsPath -> IO OsPath
+absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
+
+-- ------------------------------------------------
+
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = catchException
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO = Exception.try
--- removeFileSave doesn't throw an exceptions, if the file is already deleted
-removeFileSafe :: FilePath -> IO ()
+-----------------------------------------
+-- Adapted from ghc/compiler/utils/Panic
+
+-- | 'removeFileSave' doesn't throw an exceptions, if the file is already deleted
+removeFileSafe :: OsPath -> IO ()
removeFileSafe fn =
removeFile fn `catchIO` \ e ->
when (not $ isDoesNotExistError e) $ ioError e
--- | Turn a path relative to the current directory into a (normalised)
--- absolute path.
-absolutePath :: FilePath -> IO FilePath
-absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
+-- | Read a file using UTF-8 encoding
+--
+-- Taken from https://github.com/haskell/cabal/blob/cea1d8ff1a80df3c3b3148d1556bd3edf656d…
+-- and adapted to 'OsPath'.
+writeUtf8File :: OsPath -> String -> IO ()
+writeUtf8File file contents = writeFileAtomic file (toUTF8LBS contents)
+
+-- | Read a file and interpret its content to be UTF-8 encoded.
+--
+-- Taken from https://github.com/haskell/cabal/blob/cea1d8ff1a80df3c3b3148d1556bd3edf656d…
+-- and adapted to 'OsPath'.
+readUtf8File :: OsPath -> IO String
+readUtf8File file = (ignoreBOM . fromUTF8LBS) <$> FileIO.readFile file
=====================================
utils/ghc-pkg/ghc-pkg.cabal.in
=====================================
@@ -25,6 +25,7 @@ Executable ghc-pkg
process >= 1 && < 1.7,
containers,
filepath,
+ file-io,
Cabal,
Cabal-syntax,
binary,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f84c19b45ce2cc0f806b77e82a89c5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f84c19b45ce2cc0f806b77e82a89c5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Simplify mkTick
by Marge Bot (＠marge-bot) 15 Apr '26
by Marge Bot (＠marge-bot) 15 Apr '26
15 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
05b32bc4 by sheaf at 2026-04-15T09:46:47-04:00
Simplify mkTick
This commit simplifies 'GHC.Core.Utils.mkTick', removing the
accumulating parameter 'rest' which was suspiciously treating a bunch of
different ticks as a group, and moving the group as a whole around the
AST, ignoring that the ticks in the group might have different placement
properties.
The most important change is that we revert the logic (added in 85b0aae2)
that allowed ticks to be placed around coercions, which caused serious
issues (e.g. #27121). It was just a mistake, as it doesn't make sense
to put a tick around a coercion.
Also adds Note [Pushing SCCs inwards] which clarifies the logic for
pushing SCCs into lambdas, constructor applications, and dropping SCCs
around non-function variables (in particular the treatment of splittable
ticks).
A few other changes are also implemented:
- simplify 'can_split' predicate (no functional change)
- combine profiling ticks into one when possible
Fixes #26878, #26941 and #27121
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
bec025f7 by aparker at 2026-04-15T09:46:51-04:00
NCG: Implement constant folding for vector simd ops (Issue #25030)
- - - - -
2c06a6ed by Wolfgang Jeltsch at 2026-04-15T09:46:52-04:00
Move most of the `System.IO` implementation into `base`
This involves a rewrite of the `combine` helper function to avoid the
use of `last`, which would now be flagged as an error.
Metric Increase:
T12227
T12707
T5642
- - - - -
fa7c7a7f by Simon Jakobi at 2026-04-15T09:46:54-04:00
Add regression test for #9074
Closes #9074.
- - - - -
1c776e3b by Sylvain Henry at 2026-04-15T09:47:24-04:00
Add changelog for #15973
- - - - -
53 changed files:
- + changelog.d/T15973
- + changelog.d/T27121.md
- + changelog.d/simd_constant_folding
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Utils/Misc.hs
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-heap/tests/tso_and_stack_closures.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- + testsuite/tests/ghci/T9074/Makefile
- + testsuite/tests/ghci/T9074/T9074.hs
- + testsuite/tests/ghci/T9074/T9074.stdout
- + testsuite/tests/ghci/T9074/T9074a.c
- + testsuite/tests/ghci/T9074/T9074b.c
- + testsuite/tests/ghci/T9074/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/profiling/should_compile/T27121.hs
- + testsuite/tests/profiling/should_compile/T27121_aux.hs
- testsuite/tests/profiling/should_compile/all.T
- + testsuite/tests/simd/should_run/Makefile
- + testsuite/tests/simd/should_run/T25030.hs
- + testsuite/tests/simd/should_run/T25030.stdout
- testsuite/tests/simd/should_run/all.T
- + testsuite/tests/simplCore/should_compile/T26941.hs
- + testsuite/tests/simplCore/should_compile/T26941_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46037ee96bc3926d2a3d09d56d8a76…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46037ee96bc3926d2a3d09d56d8a76…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/mangoiv/cherry-pick-fix-testdir
by Magnus (＠MangoIV) 15 Apr '26
by Magnus (＠MangoIV) 15 Apr '26
15 Apr '26
Magnus pushed new branch wip/mangoiv/cherry-pick-fix-testdir at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mangoiv/cherry-pick-fix-testd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-implementation-into-base] 2 commits: Move code that uses `GHC.Internal.Text.Read` into `base`
by Wolfgang Jeltsch (＠jeltsch) 15 Apr '26
by Wolfgang Jeltsch (＠jeltsch) 15 Apr '26
15 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
c80e2bd9 by Wolfgang Jeltsch at 2026-04-15T16:18:27+03:00
Move code that uses `GHC.Internal.Text.Read` into `base`
This contribution serves to remove all dependencies on
`GHC.Internal.Text.Read` from within `ghc-internal`, so that the
implementation of `Text.Read` and ultimately more reading-related code
can be moved to `base` as well.
The following things are moved from `ghc-internal` to `base`:
* I/O-related `Read` instances
* Most of the `Numeric` implementation
* The instance `Read ByteOrder`
* The `parseVersion` operation
* The `readConstr` operation
Metric Increase:
LinkableUsage01
T12425
T13035
- - - - -
72b64f19 by Wolfgang Jeltsch at 2026-04-15T16:21:19+03:00
Move the `Text.Read` implementation into `base`
- - - - -
27 changed files:
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/src/Text/Read.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- − libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/static-plugins.stdout
Changes:
=====================================
libraries/base/src/Data/Data.hs
=====================================
@@ -99,3 +99,38 @@ module Data.Data (
import GHC.Internal.Data.Data
import Data.Typeable
+
+import GHC.Real (toRational)
+import GHC.Float (Double)
+import Data.Eq ((==))
+import Data.Function ((.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.List (filter)
+import Data.String (String)
+import Text.Read (Read, reads)
+
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+ case dataTypeRep dt of
+ AlgRep cons -> idx cons
+ IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+ FloatRep -> mkReadCon ffloat
+ CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
+ NoRep -> Nothing
+ where
+
+ -- Read a value and build a constructor
+ mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+ mkReadCon f = case (reads str) of
+ [(t,"")] -> Just (f t)
+ _ -> Nothing
+
+ -- Traverse list of algebraic datatype constructors
+ idx :: [Constr] -> Maybe Constr
+ idx cons = case filter ((==) str . showConstr) cons of
+ [] -> Nothing
+ hd : _ -> Just hd
+
+ ffloat :: Double -> Constr
+ ffloat = mkPrimCon dt str . FloatConstr . toRational
=====================================
libraries/base/src/Data/Functor/Classes.hs
=====================================
@@ -85,7 +85,7 @@ import GHC.Internal.Read (expectP, list, paren, readField)
import GHC.Internal.Show (appPrec)
import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
-import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
+import Text.Read (Read(..), parens, prec, step, reset)
import GHC.Internal.Text.Read.Lex (Lexeme(..))
import GHC.Internal.Text.Show (showListWith)
import Prelude
=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Internal.Data.Foldable (Foldable(..))
import GHC.Internal.Data.Monoid (Sum(..), All(..), Any(..), Product(..))
import GHC.Internal.Data.Type.Equality (TestEquality(..), (:~:)(..))
import GHC.Generics (Generic, Generic1)
-import GHC.Internal.Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
+import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
import Prelude
infixr 9 `Compose`
=====================================
libraries/base/src/Data/Version.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
-- Module : Data.Version
-- Copyright : (c) The University of Glasgow 2004
@@ -33,3 +37,25 @@ module Data.Version (
) where
import GHC.Internal.Data.Version
+
+import Control.Applicative (pure, (*>))
+import Data.Functor (fmap)
+import Data.Char (isDigit, isAlphaNum)
+import Text.ParserCombinators.ReadP (ReadP, char, munch1, sepBy1, many)
+import Text.Read (Read, read)
+
+{-NOTE:
+ The following instance is technically an orphan, but practically it is not,
+ since ordinary users should not use @ghc-internal@ directly and thus get
+ 'Version' only through this module.
+-}
+
+-- | @since base-2.01
+deriving instance Read Version
+
+-- | A parser for versions in the format produced by 'showVersion'.
+--
+parseVersion :: ReadP Version
+parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
+ tags <- many (char '-' *> munch1 isAlphaNum)
+ pure (Version branch tags)
=====================================
libraries/base/src/GHC/ByteOrder.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
--
-- Module : GHC.ByteOrder
@@ -19,4 +23,15 @@ module GHC.ByteOrder
targetByteOrder
) where
-import GHC.Internal.ByteOrder
\ No newline at end of file
+import GHC.Internal.ByteOrder
+
+import Text.Read
+
+{-NOTE:
+ The following instance is technically an orphan, but practically it is not,
+ since ordinary users should not use @ghc-internal@ directly and thus get
+ 'ByteOrder' only through this module.
+-}
+
+-- | @since base-4.11.0.0
+deriving instance Read ByteOrder
=====================================
libraries/base/src/Numeric.hs
=====================================
@@ -1,4 +1,6 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ImportQualifiedPost #-}
-- |
--
@@ -48,3 +50,279 @@ module Numeric
) where
import GHC.Internal.Numeric
+
+import GHC.Types (Char (C#))
+import GHC.Err (error, errorWithoutStackTrace)
+import GHC.Base (unsafeChr)
+import GHC.Num (Num, (+), (-), (*))
+import GHC.Real
+ (
+ Integral,
+ Real,
+ RealFrac,
+ fromIntegral,
+ fromRational,
+ quotRem,
+ showSigned
+ )
+import GHC.Float
+ (
+ Floating (..),
+ RealFloat,
+ Float,
+ Double,
+ isNegativeZero,
+ isInfinite,
+ isNaN,
+ fromRat,
+ floatToDigits,
+ FFFormat (FFExponent, FFFixed, FFGeneric),
+ formatRealFloat,
+ formatRealFloatAlt,
+ showFloat
+ )
+import GHC.Read (lexDigits)
+import Control.Monad (return)
+import Data.Eq (Eq, (==))
+import Data.Ord ((<))
+import Data.Function (($), (.))
+import Data.Bool (Bool (False, True), otherwise, (||), (&&))
+import Data.Maybe (Maybe)
+import Data.List ((++))
+import Data.Char (ord, intToDigit)
+import Data.Int (Int)
+import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S)
+import Text.Read (ReadS, readParen, lex)
+import Text.Read.Lex qualified as L
+ (
+ Lexeme (Number),
+ lex,
+ numberToRational,
+ readIntP,
+ readBinP,
+ readOctP,
+ readDecP,
+ readHexP
+ )
+import Text.Show (ShowS, show, showString)
+
+-- $setup
+-- >>> import Prelude
+
+-- -----------------------------------------------------------------------------
+-- Reading
+
+-- | Reads an /unsigned/ integral value in an arbitrary base.
+readInt :: Num a
+ => a -- ^ the base
+ -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
+ -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
+ -> ReadS a
+readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
+
+-- | Read an unsigned number in binary notation.
+--
+-- >>> readBin "10011"
+-- [(19,"")]
+readBin :: (Eq a, Num a) => ReadS a
+readBin = readP_to_S L.readBinP
+
+-- | Read an unsigned number in octal notation.
+--
+-- >>> readOct "0644"
+-- [(420,"")]
+readOct :: (Eq a, Num a) => ReadS a
+readOct = readP_to_S L.readOctP
+
+-- | Read an unsigned number in decimal notation.
+--
+-- >>> readDec "0644"
+-- [(644,"")]
+readDec :: (Eq a, Num a) => ReadS a
+readDec = readP_to_S L.readDecP
+
+-- | Read an unsigned number in hexadecimal notation.
+-- Both upper or lower case letters are allowed.
+--
+-- >>> readHex "deadbeef"
+-- [(3735928559,"")]
+readHex :: (Eq a, Num a) => ReadS a
+readHex = readP_to_S L.readHexP
+
+-- | Reads an /unsigned/ 'RealFrac' value,
+-- expressed in decimal scientific notation.
+--
+-- Note that this function takes time linear in the magnitude of its input
+-- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
+-- very large number while having a very small textual form).
+-- For this reason, users should take care to avoid using this function on
+-- untrusted input. Users needing to parse floating point values
+-- (e.g. 'Float') are encouraged to instead use 'read', which does
+-- not suffer from this issue.
+readFloat :: RealFrac a => ReadS a
+readFloat = readP_to_S readFloatP
+
+readFloatP :: RealFrac a => ReadP a
+readFloatP =
+ do tok <- L.lex
+ case tok of
+ L.Number n -> return $ fromRational $ L.numberToRational n
+ _ -> pfail
+
+-- It's turgid to have readSigned work using list comprehensions,
+-- but it's specified as a ReadS to ReadS transformer
+-- With a bit of luck no one will use it.
+
+-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
+readSigned :: (Real a) => ReadS a -> ReadS a
+readSigned readPos = readParen False read'
+ where read' r = read'' r ++
+ (do
+ ("-",s) <- lex r
+ (x,t) <- read'' s
+ return (-x,t))
+ read'' r = do
+ (str,s) <- lex r
+ (n,"") <- readPos str
+ return (n,s)
+
+-- -----------------------------------------------------------------------------
+-- Showing
+
+-- | Show /non-negative/ 'Integral' numbers in base 10.
+showInt :: Integral a => a -> ShowS
+showInt n0 cs0
+ | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers"
+ | otherwise = go n0 cs0
+ where
+ go n cs
+ | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
+ c@(C# _) -> c:cs
+ | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
+ c@(C# _) -> go q (c:cs)
+ where
+ (q,r) = n `quotRem` 10
+
+-- Controlling the format and precision of floats. The code that
+-- implements the formatting itself is in @PrelNum@ to avoid
+-- mutual module deps.
+
+{-# SPECIALIZE showEFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showEFloat ::
+ Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showFFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showFFloat ::
+ Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showGFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showGFloat ::
+ Maybe Int -> Double -> ShowS #-}
+
+-- | Show a signed 'RealFloat' value
+-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
+--
+-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showEFloat d x = showString (formatRealFloat FFExponent d x)
+showFFloat d x = showString (formatRealFloat FFFixed d x)
+showGFloat d x = showString (formatRealFloat FFGeneric d x)
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- @since base-4.7.0.0
+showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- @since base-4.7.0.0
+showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x)
+showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x)
+
+{- | Show a floating-point value in the hexadecimal format,
+similar to the @%a@ specifier in C's printf.
+
+ >>> showHFloat (212.21 :: Double) ""
+ "0x1.a86b851eb851fp7"
+ >>> showHFloat (-12.76 :: Float) ""
+ "-0x1.9851ecp3"
+ >>> showHFloat (-0 :: Double) ""
+ "-0x0p+0"
+
+@since base-4.11.0.0
+-}
+showHFloat :: RealFloat a => a -> ShowS
+showHFloat = showString . fmt
+ where
+ fmt x
+ | isNaN x = "NaN"
+ | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity"
+ | x < 0 || isNegativeZero x = '-' : cvt (-x)
+ | otherwise = cvt x
+
+ cvt x
+ | x == 0 = "0x0p+0"
+ | otherwise =
+ case floatToDigits 2 x of
+ r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
+ (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
+
+ -- Given binary digits, convert them to hex in blocks of 4
+ -- Special case: If all 0's, just drop it.
+ frac digits
+ | allZ digits = ""
+ | otherwise = "." ++ hex digits
+ where
+ hex ds =
+ case ds of
+ [] -> ""
+ [a] -> hexDigit a 0 0 0 ""
+ [a,b] -> hexDigit a b 0 0 ""
+ [a,b,c] -> hexDigit a b c 0 ""
+ a : b : c : d : r -> hexDigit a b c d (hex r)
+
+ hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
+
+ allZ xs = case xs of
+ x : more -> x == 0 && allZ more
+ [] -> True
+
+-- | Show /non-negative/ 'Integral' numbers in base 8.
+showOct :: Integral a => a -> ShowS
+showOct = showIntAtBase 8 intToDigit
+
+-- | Show /non-negative/ 'Integral' numbers in base 2.
+showBin :: Integral a => a -> ShowS
+showBin = showIntAtBase 2 intToDigit
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -179,7 +179,7 @@ import GHC.Internal.Data.Tuple
import GHC.Internal.Base hiding ( foldr, mapM, sequence )
import GHC.Internal.Classes
import GHC.Internal.Err
-import GHC.Internal.Text.Read
+import Text.Read
import GHC.Internal.Enum
import GHC.Internal.Num
import GHC.Internal.Prim (seq)
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
-- |
--
@@ -895,3 +898,24 @@ rw_flags = output_flags .|. o_RDWR
-- output
-- > input^D
-- output
+
+{-NOTE:
+ The following instances are technically orphans, but practically they are
+ not, since ordinary users should not use @ghc-internal@ directly and thus
+ get the instantiated types only through this module.
+-}
+
+-- | @since base-4.2.0.0
+deriving instance Read IOMode
+
+-- | @since base-4.2.0.0
+deriving instance Read BufferMode
+
+-- | @since base-4.2.0.0
+deriving instance Read SeekMode
+
+-- | @since base-4.3.0.0
+deriving instance Read Newline
+
+-- | @since base-4.3.0.0
+deriving instance Read NewlineMode
=====================================
libraries/base/src/Text/Printf.hs
=====================================
@@ -97,8 +97,8 @@ import Data.Char
import GHC.Internal.Int
import GHC.Internal.Data.List (stripPrefix)
import GHC.Internal.Word
-import GHC.Internal.Numeric
import GHC.Internal.Numeric.Natural
+import Numeric
import System.IO
-- $setup
=====================================
libraries/base/src/Text/Read.hs
=====================================
@@ -39,5 +39,84 @@ module Text.Read
readMaybe
) where
-import GHC.Internal.Text.Read
+import GHC.Err (errorWithoutStackTrace)
+import GHC.Read
+ (
+ ReadS,
+ Read (readsPrec, readList, readPrec, readListPrec),
+ lex,
+ readParen,
+ readListDefault,
+ lexP,
+ parens,
+ readListPrecDefault
+ )
+import Control.Monad (return)
+import Data.Function (id)
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Either (Either (Left, Right), either)
+import Data.String (String)
+import Text.Read.Lex (Lexeme (Char, String, Punc, Ident, Symbol, Number, EOF))
+import Text.ParserCombinators.ReadP (skipSpaces)
import Text.ParserCombinators.ReadPrec
+
+-- $setup
+-- >>> import Prelude
+
+------------------------------------------------------------------------
+-- utility functions
+
+-- | equivalent to 'readsPrec' with a precedence of 0.
+reads :: Read a => ReadS a
+reads = readsPrec minPrec
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+-- A 'Left' value indicates a parse error.
+--
+-- >>> readEither "123" :: Either String Int
+-- Right 123
+--
+-- >>> readEither "hello" :: Either String Int
+-- Left "Prelude.read: no parse"
+--
+-- @since base-4.6.0.0
+readEither :: Read a => String -> Either String a
+readEither s =
+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+ [x] -> Right x
+ [] -> Left "Prelude.read: no parse"
+ _ -> Left "Prelude.read: ambiguous parse"
+ where
+ read' =
+ do x <- readPrec
+ lift skipSpaces
+ return x
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+--
+-- >>> readMaybe "123" :: Maybe Int
+-- Just 123
+--
+-- >>> readMaybe "hello" :: Maybe Int
+-- Nothing
+--
+-- @since base-4.6.0.0
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case readEither s of
+ Left _ -> Nothing
+ Right a -> Just a
+
+-- | The 'read' function reads input from a string, which must be
+-- completely consumed by the input process. 'read' fails with an 'error' if the
+-- parse is unsuccessful, and it is therefore discouraged from being used in
+-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
+--
+-- >>> read "123" :: Int
+-- 123
+--
+-- >>> read "hello" :: Int
+-- *** Exception: Prelude.read: no parse
+read :: Read a => String -> a
+read s = either errorWithoutStackTrace id (readEither s)
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -329,7 +329,6 @@ Library
GHC.Internal.System.Posix.Types
GHC.Internal.Text.ParserCombinators.ReadP
GHC.Internal.Text.ParserCombinators.ReadPrec
- GHC.Internal.Text.Read
GHC.Internal.Text.Read.Lex
GHC.Internal.Text.Show
GHC.Internal.Type.Reflection
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
=====================================
@@ -61,6 +61,7 @@ module GHC.Internal.Data.Data (
mkIntType,
mkFloatType,
mkCharType,
+ mkPrimCon,
mkNoRepType,
-- ** Observers
dataTypeName,
@@ -94,7 +95,6 @@ module GHC.Internal.Data.Data (
constrIndex,
-- ** From strings to constructors and vice versa: all data types
showConstr,
- readConstr,
-- * Convenience functions: take type constructors apart
tyconUQname,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
import GHC.Internal.List
import GHC.Internal.Num
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.Text.Read( reads )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,6 @@ showConstr :: Constr -> String
showConstr = constring
--- | Lookup a constructor via a string
-readConstr :: DataType -> String -> Maybe Constr
-readConstr dt str =
- case dataTypeRep dt of
- AlgRep cons -> idx cons
- IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
- FloatRep -> mkReadCon ffloat
- CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
- NoRep -> Nothing
- where
-
- -- Read a value and build a constructor
- mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
- mkReadCon f = case (reads str) of
- [(t,"")] -> Just (f t)
- _ -> Nothing
-
- -- Traverse list of algebraic datatype constructors
- idx :: [Constr] -> Maybe Constr
- idx cons = case filter ((==) str . showConstr) cons of
- [] -> Nothing
- hd : _ -> Just hd
-
- ffloat :: Double -> Constr
- ffloat = mkPrimCon dt str . FloatConstr . toRational
-
------------------------------------------------------------------------------
--
-- Convenience functions: algebraic data types
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -10,7 +10,7 @@
--
-- Maintainer : libraries(a)haskell.org
-- Stability : stable
--- Portability : non-portable (local universal quantification in ReadP)
+-- Portability : non-portable
--
-- A general library for representation and manipulation of versions.
--
@@ -31,23 +31,17 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..) )
-import GHC.Internal.Unicode ( isDigit, isAlphaNum )
-import GHC.Internal.Read
import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP
-import GHC.Internal.Text.Read ( read )
{- |
A 'Version' represents the version of a software entity.
@@ -69,8 +63,8 @@ operations are the right thing for every 'Version'.
Similarly, concrete representations of versions may differ. One
possible concrete representation is provided (see 'showVersion' and
-'parseVersion'), but depending on the application a different concrete
-representation may be more appropriate.
+'Data.Version.parseVersion'), but depending on the application a
+different concrete representation may be more appropriate.
-}
data Version =
Version { versionBranch :: [Int],
@@ -92,8 +86,7 @@ data Version =
-- The interpretation of the list of tags is entirely dependent
-- on the entity that this version applies to.
}
- deriving ( Read -- ^ @since base-2.01
- , Show -- ^ @since base-2.01
+ deriving ( Show -- ^ @since base-2.01
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
-- TODO. Remove all references to versionTags in GHC 8.0 release.
@@ -120,13 +113,6 @@ showVersion (Version branch tags)
= concat (intersperse "." (map show branch)) ++
concatMap ('-':) tags
--- | A parser for versions in the format produced by 'showVersion'.
---
-parseVersion :: ReadP Version
-parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
- tags <- many (char '-' *> munch1 isAlphaNum)
- pure Version{versionBranch=branch, versionTags=tags}
-
-- | Construct tag-less 'Version'
--
-- @since base-4.8.0.0
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
=====================================
@@ -34,7 +34,6 @@ import GHC.Internal.Types ( Bool(..), Int )
import GHC.Internal.Word
import GHC.Internal.Arr
import GHC.Internal.Enum
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Ptr
import GHC.Internal.Num
@@ -182,7 +181,6 @@ data SeekMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
=====================================
@@ -50,7 +50,6 @@ import GHC.Internal.IO.BufferedIO
import GHC.Internal.IO.Encoding.Types
import GHC.Internal.IORef
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Types (Bool(..), Int)
import GHC.Internal.Word
import GHC.Internal.IO.Device
@@ -273,7 +272,6 @@ data BufferMode
-- is 'Just' @n@ and is otherwise implementation-dependent.
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
@@ -379,7 +377,6 @@ data Newline = LF -- ^ @\'\\n\'@
| CRLF -- ^ @\'\\r\\n\'@
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
@@ -396,7 +393,6 @@ data NewlineMode
}
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
=====================================
@@ -20,7 +20,6 @@ module GHC.Internal.IO.IOMode (IOMode(..)) where
import GHC.Internal.Classes (Eq, Ord)
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Arr
import GHC.Internal.Enum
@@ -30,7 +29,6 @@ data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/Numeric.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
-----------------------------------------------------------------------------
-- |
@@ -16,279 +15,16 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
- -- * Showing
-
- showSigned,
-
- showIntAtBase,
- showInt,
- showBin,
- showHex,
- showOct,
-
- showEFloat,
- showFFloat,
- showGFloat,
- showFFloatAlt,
- showGFloatAlt,
- showFloat,
- showHFloat,
-
- floatToDigits,
-
- -- * Reading
-
- -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
- -- and 'readDec' is the \`dual\' of 'showInt'.
- -- The inconsistent naming is a historical accident.
-
- readSigned,
-
- readInt,
- readBin,
- readDec,
- readOct,
- readHex,
-
- readFloat,
-
- lexDigits,
-
- -- * Miscellaneous
-
- fromRat,
- Floating(..)
-
- ) where
-
-import GHC.Internal.Base (ord, otherwise, return, unsafeChr, ($), (.), (++))
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
-import GHC.Internal.Err (error, errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Prim (seq)
-import GHC.Internal.Read
-import GHC.Internal.Real
-import GHC.Internal.Float
-import GHC.Internal.Num
-import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
-import qualified GHC.Internal.Text.Read.Lex as L
-import GHC.Internal.Types (Bool(..), Char(..), Int)
-
--- $setup
--- >>> import Prelude
-
--- -----------------------------------------------------------------------------
--- Reading
-
--- | Reads an /unsigned/ integral value in an arbitrary base.
-readInt :: Num a
- => a -- ^ the base
- -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
- -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
- -> ReadS a
-readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
-
--- | Read an unsigned number in binary notation.
---
--- >>> readBin "10011"
--- [(19,"")]
-readBin :: (Eq a, Num a) => ReadS a
-readBin = readP_to_S L.readBinP
-
--- | Read an unsigned number in octal notation.
---
--- >>> readOct "0644"
--- [(420,"")]
-readOct :: (Eq a, Num a) => ReadS a
-readOct = readP_to_S L.readOctP
-
--- | Read an unsigned number in decimal notation.
---
--- >>> readDec "0644"
--- [(644,"")]
-readDec :: (Eq a, Num a) => ReadS a
-readDec = readP_to_S L.readDecP
-
--- | Read an unsigned number in hexadecimal notation.
--- Both upper or lower case letters are allowed.
---
--- >>> readHex "deadbeef"
--- [(3735928559,"")]
-readHex :: (Eq a, Num a) => ReadS a
-readHex = readP_to_S L.readHexP
-
--- | Reads an /unsigned/ 'RealFrac' value,
--- expressed in decimal scientific notation.
---
--- Note that this function takes time linear in the magnitude of its input
--- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
--- very large number while having a very small textual form).
--- For this reason, users should take care to avoid using this function on
--- untrusted input. Users needing to parse floating point values
--- (e.g. 'Float') are encouraged to instead use 'read', which does
--- not suffer from this issue.
-readFloat :: RealFrac a => ReadS a
-readFloat = readP_to_S readFloatP
-
-readFloatP :: RealFrac a => ReadP a
-readFloatP =
- do tok <- L.lex
- case tok of
- L.Number n -> return $ fromRational $ L.numberToRational n
- _ -> pfail
-
--- It's turgid to have readSigned work using list comprehensions,
--- but it's specified as a ReadS to ReadS transformer
--- With a bit of luck no one will use it.
-
--- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
-readSigned :: (Real a) => ReadS a -> ReadS a
-readSigned readPos = readParen False read'
- where read' r = read'' r ++
- (do
- ("-",s) <- lex r
- (x,t) <- read'' s
- return (-x,t))
- read'' r = do
- (str,s) <- lex r
- (n,"") <- readPos str
- return (n,s)
-
--- -----------------------------------------------------------------------------
--- Showing
-
--- | Show /non-negative/ 'Integral' numbers in base 10.
-showInt :: Integral a => a -> ShowS
-showInt n0 cs0
- | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers"
- | otherwise = go n0 cs0
- where
- go n cs
- | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
- c@(C# _) -> c:cs
- | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
- c@(C# _) -> go q (c:cs)
- where
- (q,r) = n `quotRem` 10
-
--- Controlling the format and precision of floats. The code that
--- implements the formatting itself is in @PrelNum@ to avoid
--- mutual module deps.
-
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Double -> ShowS #-}
-
--- | Show a signed 'RealFloat' value
--- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
---
--- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showEFloat d x = showString (formatRealFloat FFExponent d x)
-showFFloat d x = showString (formatRealFloat FFFixed d x)
-showGFloat d x = showString (formatRealFloat FFGeneric d x)
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x)
-showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x)
-
-{- | Show a floating-point value in the hexadecimal format,
-similar to the @%a@ specifier in C's printf.
-
- >>> showHFloat (212.21 :: Double) ""
- "0x1.a86b851eb851fp7"
- >>> showHFloat (-12.76 :: Float) ""
- "-0x1.9851ecp3"
- >>> showHFloat (-0 :: Double) ""
- "-0x0p+0"
-
-@since base-4.11.0.0
--}
-showHFloat :: RealFloat a => a -> ShowS
-showHFloat = showString . fmt
- where
- fmt x
- | isNaN x = "NaN"
- | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity"
- | x < 0 || isNegativeZero x = '-' : cvt (-x)
- | otherwise = cvt x
-
- cvt x
- | x == 0 = "0x0p+0"
- | otherwise =
- case floatToDigits 2 x of
- r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
- (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
-
- -- Given binary digits, convert them to hex in blocks of 4
- -- Special case: If all 0's, just drop it.
- frac digits
- | allZ digits = ""
- | otherwise = "." ++ hex digits
- where
- hex ds =
- case ds of
- [] -> ""
- [a] -> hexDigit a 0 0 0 ""
- [a,b] -> hexDigit a b 0 0 ""
- [a,b,c] -> hexDigit a b c 0 ""
- a : b : c : d : r -> hexDigit a b c d (hex r)
-
- hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
-
- allZ xs = case xs of
- x : more -> x == 0 && allZ more
- [] -> True
+import GHC.Internal.Types (Char, Int)
+import GHC.Internal.Classes ((<), (<=))
+import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Base (($), otherwise)
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -312,11 +48,3 @@ showIntAtBase base toChr n0 r0
-- | Show /non-negative/ 'Integral' numbers in base 16.
showHex :: Integral a => a -> ShowS
showHex = showIntAtBase 16 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 8.
-showOct :: Integral a => a -> ShowS
-showOct = showIntAtBase 8 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 2.
-showBin :: Integral a => a -> ShowS
-showBin = showIntAtBase 2 intToDigit
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -80,7 +80,6 @@ import GHC.Internal.Types (Bool(..), Char, Int, Ordering(..))
import GHC.Internal.Word
import GHC.Internal.List (filter)
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.ByteOrder
-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -840,6 +839,3 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
-
--- | @since base-4.11.0.0
-deriving instance Read ByteOrder
=====================================
libraries/ghc-internal/src/GHC/Internal/Text/Read.hs deleted
=====================================
@@ -1,115 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.Text.Read
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : provisional
--- Portability : non-portable (uses Text.ParserCombinators.ReadP)
---
--- Converting strings to values.
---
--- The "Text.Read" library is the canonical library to import for
--- 'Read'-class facilities. For GHC only, it offers an extended and much
--- improved 'Read' class, which constitutes a proposed alternative to the
--- Haskell 2010 'Read'. In particular, writing parsers is easier, and
--- the parsers are much more efficient.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.Text.Read (
- -- * The 'Read' class
- Read(..),
- ReadS,
-
- -- * Haskell 2010 functions
- reads,
- read,
- readParen,
- lex,
-
- -- * New parsing functions
- module GHC.Internal.Text.ParserCombinators.ReadPrec,
- L.Lexeme(..),
- lexP,
- parens,
- readListDefault,
- readListPrecDefault,
- readEither,
- readMaybe
-
- ) where
-
-import GHC.Internal.Base (String, id, return)
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
-import GHC.Internal.Read
-import GHC.Internal.Data.Either
-import GHC.Internal.Text.ParserCombinators.ReadP as P
-import GHC.Internal.Text.ParserCombinators.ReadPrec
-import qualified GHC.Internal.Text.Read.Lex as L
-
--- $setup
--- >>> import Prelude
-
-------------------------------------------------------------------------
--- utility functions
-
--- | equivalent to 'readsPrec' with a precedence of 0.
-reads :: Read a => ReadS a
-reads = readsPrec minPrec
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
--- A 'Left' value indicates a parse error.
---
--- >>> readEither "123" :: Either String Int
--- Right 123
---
--- >>> readEither "hello" :: Either String Int
--- Left "Prelude.read: no parse"
---
--- @since base-4.6.0.0
-readEither :: Read a => String -> Either String a
-readEither s =
- case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
- [x] -> Right x
- [] -> Left "Prelude.read: no parse"
- _ -> Left "Prelude.read: ambiguous parse"
- where
- read' =
- do x <- readPrec
- lift P.skipSpaces
- return x
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
---
--- >>> readMaybe "123" :: Maybe Int
--- Just 123
---
--- >>> readMaybe "hello" :: Maybe Int
--- Nothing
---
--- @since base-4.6.0.0
-readMaybe :: Read a => String -> Maybe a
-readMaybe s = case readEither s of
- Left _ -> Nothing
- Right a -> Just a
-
--- | The 'read' function reads input from a string, which must be
--- completely consumed by the input process. 'read' fails with an 'error' if the
--- parse is unsuccessful, and it is therefore discouraged from being used in
--- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
---
--- >>> read "123" :: Int
--- 123
---
--- >>> read "hello" :: Int
--- *** Exception: Prelude.read: no parse
-read :: Read a => String -> a
-read s = either errorWithoutStackTrace id (readEither s)
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9453,7 +9453,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12526,6 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -9491,7 +9491,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12459,7 +12459,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12526,7 +12525,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12555,6 +12554,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12569,16 +12569,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9733,7 +9733,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12701,7 +12701,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12768,7 +12767,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12797,6 +12796,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance GHC.Internal.Read.Read GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12812,16 +12812,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9453,7 +9453,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12526,6 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/plugins/plugins09.stdout
=====================================
@@ -1,5 +1,6 @@
parsePlugin(a,b)
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -2,6 +2,8 @@ parsePlugin()
interfacePlugin: Prelude
interfacePlugin: Language.Haskell.TH
interfacePlugin: Language.Haskell.TH.Quote
+interfacePlugin: Data.Version
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/plugins11.stdout
=====================================
@@ -1,5 +1,6 @@
parsePlugin()
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/static-plugins.stdout
=====================================
@@ -1,6 +1,7 @@
==pure.0
parsePlugin()
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f33a56cda01ed76d05a219ed4f4970…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f33a56cda01ed76d05a219ed4f4970…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] Move code that uses `GHC.Internal.Text.Read` into `base`
by Wolfgang Jeltsch (＠jeltsch) 15 Apr '26
by Wolfgang Jeltsch (＠jeltsch) 15 Apr '26
15 Apr '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
c80e2bd9 by Wolfgang Jeltsch at 2026-04-15T16:18:27+03:00
Move code that uses `GHC.Internal.Text.Read` into `base`
This contribution serves to remove all dependencies on
`GHC.Internal.Text.Read` from within `ghc-internal`, so that the
implementation of `Text.Read` and ultimately more reading-related code
can be moved to `base` as well.
The following things are moved from `ghc-internal` to `base`:
* I/O-related `Read` instances
* Most of the `Numeric` implementation
* The instance `Read ByteOrder`
* The `parseVersion` operation
* The `readConstr` operation
Metric Increase:
LinkableUsage01
T12425
T13035
- - - - -
21 changed files:
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/static-plugins.stdout
Changes:
=====================================
libraries/base/src/Data/Data.hs
=====================================
@@ -99,3 +99,38 @@ module Data.Data (
import GHC.Internal.Data.Data
import Data.Typeable
+
+import GHC.Real (toRational)
+import GHC.Float (Double)
+import Data.Eq ((==))
+import Data.Function ((.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.List (filter)
+import Data.String (String)
+import Text.Read (Read, reads)
+
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+ case dataTypeRep dt of
+ AlgRep cons -> idx cons
+ IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+ FloatRep -> mkReadCon ffloat
+ CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
+ NoRep -> Nothing
+ where
+
+ -- Read a value and build a constructor
+ mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+ mkReadCon f = case (reads str) of
+ [(t,"")] -> Just (f t)
+ _ -> Nothing
+
+ -- Traverse list of algebraic datatype constructors
+ idx :: [Constr] -> Maybe Constr
+ idx cons = case filter ((==) str . showConstr) cons of
+ [] -> Nothing
+ hd : _ -> Just hd
+
+ ffloat :: Double -> Constr
+ ffloat = mkPrimCon dt str . FloatConstr . toRational
=====================================
libraries/base/src/Data/Version.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
-- Module : Data.Version
-- Copyright : (c) The University of Glasgow 2004
@@ -33,3 +37,25 @@ module Data.Version (
) where
import GHC.Internal.Data.Version
+
+import Control.Applicative (pure, (*>))
+import Data.Functor (fmap)
+import Data.Char (isDigit, isAlphaNum)
+import Text.ParserCombinators.ReadP (ReadP, char, munch1, sepBy1, many)
+import Text.Read (Read, read)
+
+{-NOTE:
+ The following instance is technically an orphan, but practically it is not,
+ since ordinary users should not use @ghc-internal@ directly and thus get
+ 'Version' only through this module.
+-}
+
+-- | @since base-2.01
+deriving instance Read Version
+
+-- | A parser for versions in the format produced by 'showVersion'.
+--
+parseVersion :: ReadP Version
+parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
+ tags <- many (char '-' *> munch1 isAlphaNum)
+ pure (Version branch tags)
=====================================
libraries/base/src/GHC/ByteOrder.hs
=====================================
@@ -1,5 +1,9 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
-- |
--
-- Module : GHC.ByteOrder
@@ -19,4 +23,15 @@ module GHC.ByteOrder
targetByteOrder
) where
-import GHC.Internal.ByteOrder
\ No newline at end of file
+import GHC.Internal.ByteOrder
+
+import Text.Read
+
+{-NOTE:
+ The following instance is technically an orphan, but practically it is not,
+ since ordinary users should not use @ghc-internal@ directly and thus get
+ 'ByteOrder' only through this module.
+-}
+
+-- | @since base-4.11.0.0
+deriving instance Read ByteOrder
=====================================
libraries/base/src/Numeric.hs
=====================================
@@ -1,4 +1,6 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ImportQualifiedPost #-}
-- |
--
@@ -48,3 +50,279 @@ module Numeric
) where
import GHC.Internal.Numeric
+
+import GHC.Types (Char (C#))
+import GHC.Err (error, errorWithoutStackTrace)
+import GHC.Base (unsafeChr)
+import GHC.Num (Num, (+), (-), (*))
+import GHC.Real
+ (
+ Integral,
+ Real,
+ RealFrac,
+ fromIntegral,
+ fromRational,
+ quotRem,
+ showSigned
+ )
+import GHC.Float
+ (
+ Floating (..),
+ RealFloat,
+ Float,
+ Double,
+ isNegativeZero,
+ isInfinite,
+ isNaN,
+ fromRat,
+ floatToDigits,
+ FFFormat (FFExponent, FFFixed, FFGeneric),
+ formatRealFloat,
+ formatRealFloatAlt,
+ showFloat
+ )
+import GHC.Read (lexDigits)
+import Control.Monad (return)
+import Data.Eq (Eq, (==))
+import Data.Ord ((<))
+import Data.Function (($), (.))
+import Data.Bool (Bool (False, True), otherwise, (||), (&&))
+import Data.Maybe (Maybe)
+import Data.List ((++))
+import Data.Char (ord, intToDigit)
+import Data.Int (Int)
+import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S)
+import Text.Read (ReadS, readParen, lex)
+import Text.Read.Lex qualified as L
+ (
+ Lexeme (Number),
+ lex,
+ numberToRational,
+ readIntP,
+ readBinP,
+ readOctP,
+ readDecP,
+ readHexP
+ )
+import Text.Show (ShowS, show, showString)
+
+-- $setup
+-- >>> import Prelude
+
+-- -----------------------------------------------------------------------------
+-- Reading
+
+-- | Reads an /unsigned/ integral value in an arbitrary base.
+readInt :: Num a
+ => a -- ^ the base
+ -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
+ -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
+ -> ReadS a
+readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
+
+-- | Read an unsigned number in binary notation.
+--
+-- >>> readBin "10011"
+-- [(19,"")]
+readBin :: (Eq a, Num a) => ReadS a
+readBin = readP_to_S L.readBinP
+
+-- | Read an unsigned number in octal notation.
+--
+-- >>> readOct "0644"
+-- [(420,"")]
+readOct :: (Eq a, Num a) => ReadS a
+readOct = readP_to_S L.readOctP
+
+-- | Read an unsigned number in decimal notation.
+--
+-- >>> readDec "0644"
+-- [(644,"")]
+readDec :: (Eq a, Num a) => ReadS a
+readDec = readP_to_S L.readDecP
+
+-- | Read an unsigned number in hexadecimal notation.
+-- Both upper or lower case letters are allowed.
+--
+-- >>> readHex "deadbeef"
+-- [(3735928559,"")]
+readHex :: (Eq a, Num a) => ReadS a
+readHex = readP_to_S L.readHexP
+
+-- | Reads an /unsigned/ 'RealFrac' value,
+-- expressed in decimal scientific notation.
+--
+-- Note that this function takes time linear in the magnitude of its input
+-- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
+-- very large number while having a very small textual form).
+-- For this reason, users should take care to avoid using this function on
+-- untrusted input. Users needing to parse floating point values
+-- (e.g. 'Float') are encouraged to instead use 'read', which does
+-- not suffer from this issue.
+readFloat :: RealFrac a => ReadS a
+readFloat = readP_to_S readFloatP
+
+readFloatP :: RealFrac a => ReadP a
+readFloatP =
+ do tok <- L.lex
+ case tok of
+ L.Number n -> return $ fromRational $ L.numberToRational n
+ _ -> pfail
+
+-- It's turgid to have readSigned work using list comprehensions,
+-- but it's specified as a ReadS to ReadS transformer
+-- With a bit of luck no one will use it.
+
+-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
+readSigned :: (Real a) => ReadS a -> ReadS a
+readSigned readPos = readParen False read'
+ where read' r = read'' r ++
+ (do
+ ("-",s) <- lex r
+ (x,t) <- read'' s
+ return (-x,t))
+ read'' r = do
+ (str,s) <- lex r
+ (n,"") <- readPos str
+ return (n,s)
+
+-- -----------------------------------------------------------------------------
+-- Showing
+
+-- | Show /non-negative/ 'Integral' numbers in base 10.
+showInt :: Integral a => a -> ShowS
+showInt n0 cs0
+ | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers"
+ | otherwise = go n0 cs0
+ where
+ go n cs
+ | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
+ c@(C# _) -> c:cs
+ | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
+ c@(C# _) -> go q (c:cs)
+ where
+ (q,r) = n `quotRem` 10
+
+-- Controlling the format and precision of floats. The code that
+-- implements the formatting itself is in @PrelNum@ to avoid
+-- mutual module deps.
+
+{-# SPECIALIZE showEFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showEFloat ::
+ Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showFFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showFFloat ::
+ Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showGFloat ::
+ Maybe Int -> Float -> ShowS #-}
+{-# SPECIALIZE showGFloat ::
+ Maybe Int -> Double -> ShowS #-}
+
+-- | Show a signed 'RealFloat' value
+-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
+--
+-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showEFloat d x = showString (formatRealFloat FFExponent d x)
+showFFloat d x = showString (formatRealFloat FFFixed d x)
+showGFloat d x = showString (formatRealFloat FFGeneric d x)
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- @since base-4.7.0.0
+showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- @since base-4.7.0.0
+showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x)
+showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x)
+
+{- | Show a floating-point value in the hexadecimal format,
+similar to the @%a@ specifier in C's printf.
+
+ >>> showHFloat (212.21 :: Double) ""
+ "0x1.a86b851eb851fp7"
+ >>> showHFloat (-12.76 :: Float) ""
+ "-0x1.9851ecp3"
+ >>> showHFloat (-0 :: Double) ""
+ "-0x0p+0"
+
+@since base-4.11.0.0
+-}
+showHFloat :: RealFloat a => a -> ShowS
+showHFloat = showString . fmt
+ where
+ fmt x
+ | isNaN x = "NaN"
+ | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity"
+ | x < 0 || isNegativeZero x = '-' : cvt (-x)
+ | otherwise = cvt x
+
+ cvt x
+ | x == 0 = "0x0p+0"
+ | otherwise =
+ case floatToDigits 2 x of
+ r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
+ (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
+
+ -- Given binary digits, convert them to hex in blocks of 4
+ -- Special case: If all 0's, just drop it.
+ frac digits
+ | allZ digits = ""
+ | otherwise = "." ++ hex digits
+ where
+ hex ds =
+ case ds of
+ [] -> ""
+ [a] -> hexDigit a 0 0 0 ""
+ [a,b] -> hexDigit a b 0 0 ""
+ [a,b,c] -> hexDigit a b c 0 ""
+ a : b : c : d : r -> hexDigit a b c d (hex r)
+
+ hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
+
+ allZ xs = case xs of
+ x : more -> x == 0 && allZ more
+ [] -> True
+
+-- | Show /non-negative/ 'Integral' numbers in base 8.
+showOct :: Integral a => a -> ShowS
+showOct = showIntAtBase 8 intToDigit
+
+-- | Show /non-negative/ 'Integral' numbers in base 2.
+showBin :: Integral a => a -> ShowS
+showBin = showIntAtBase 2 intToDigit
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
-- |
--
@@ -895,3 +898,24 @@ rw_flags = output_flags .|. o_RDWR
-- output
-- > input^D
-- output
+
+{-NOTE:
+ The following instances are technically orphans, but practically they are
+ not, since ordinary users should not use @ghc-internal@ directly and thus
+ get the instantiated types only through this module.
+-}
+
+-- | @since base-4.2.0.0
+deriving instance Read IOMode
+
+-- | @since base-4.2.0.0
+deriving instance Read BufferMode
+
+-- | @since base-4.2.0.0
+deriving instance Read SeekMode
+
+-- | @since base-4.3.0.0
+deriving instance Read Newline
+
+-- | @since base-4.3.0.0
+deriving instance Read NewlineMode
=====================================
libraries/base/src/Text/Printf.hs
=====================================
@@ -97,8 +97,8 @@ import Data.Char
import GHC.Internal.Int
import GHC.Internal.Data.List (stripPrefix)
import GHC.Internal.Word
-import GHC.Internal.Numeric
import GHC.Internal.Numeric.Natural
+import Numeric
import System.IO
-- $setup
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
=====================================
@@ -61,6 +61,7 @@ module GHC.Internal.Data.Data (
mkIntType,
mkFloatType,
mkCharType,
+ mkPrimCon,
mkNoRepType,
-- ** Observers
dataTypeName,
@@ -94,7 +95,6 @@ module GHC.Internal.Data.Data (
constrIndex,
-- ** From strings to constructors and vice versa: all data types
showConstr,
- readConstr,
-- * Convenience functions: take type constructors apart
tyconUQname,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
import GHC.Internal.List
import GHC.Internal.Num
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.Text.Read( reads )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,6 @@ showConstr :: Constr -> String
showConstr = constring
--- | Lookup a constructor via a string
-readConstr :: DataType -> String -> Maybe Constr
-readConstr dt str =
- case dataTypeRep dt of
- AlgRep cons -> idx cons
- IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
- FloatRep -> mkReadCon ffloat
- CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
- NoRep -> Nothing
- where
-
- -- Read a value and build a constructor
- mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
- mkReadCon f = case (reads str) of
- [(t,"")] -> Just (f t)
- _ -> Nothing
-
- -- Traverse list of algebraic datatype constructors
- idx :: [Constr] -> Maybe Constr
- idx cons = case filter ((==) str . showConstr) cons of
- [] -> Nothing
- hd : _ -> Just hd
-
- ffloat :: Double -> Constr
- ffloat = mkPrimCon dt str . FloatConstr . toRational
-
------------------------------------------------------------------------------
--
-- Convenience functions: algebraic data types
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -10,7 +10,7 @@
--
-- Maintainer : libraries(a)haskell.org
-- Stability : stable
--- Portability : non-portable (local universal quantification in ReadP)
+-- Portability : non-portable
--
-- A general library for representation and manipulation of versions.
--
@@ -31,23 +31,17 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..) )
-import GHC.Internal.Unicode ( isDigit, isAlphaNum )
-import GHC.Internal.Read
import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP
-import GHC.Internal.Text.Read ( read )
{- |
A 'Version' represents the version of a software entity.
@@ -69,8 +63,8 @@ operations are the right thing for every 'Version'.
Similarly, concrete representations of versions may differ. One
possible concrete representation is provided (see 'showVersion' and
-'parseVersion'), but depending on the application a different concrete
-representation may be more appropriate.
+'Data.Version.parseVersion'), but depending on the application a
+different concrete representation may be more appropriate.
-}
data Version =
Version { versionBranch :: [Int],
@@ -92,8 +86,7 @@ data Version =
-- The interpretation of the list of tags is entirely dependent
-- on the entity that this version applies to.
}
- deriving ( Read -- ^ @since base-2.01
- , Show -- ^ @since base-2.01
+ deriving ( Show -- ^ @since base-2.01
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
-- TODO. Remove all references to versionTags in GHC 8.0 release.
@@ -120,13 +113,6 @@ showVersion (Version branch tags)
= concat (intersperse "." (map show branch)) ++
concatMap ('-':) tags
--- | A parser for versions in the format produced by 'showVersion'.
---
-parseVersion :: ReadP Version
-parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
- tags <- many (char '-' *> munch1 isAlphaNum)
- pure Version{versionBranch=branch, versionTags=tags}
-
-- | Construct tag-less 'Version'
--
-- @since base-4.8.0.0
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
=====================================
@@ -34,7 +34,6 @@ import GHC.Internal.Types ( Bool(..), Int )
import GHC.Internal.Word
import GHC.Internal.Arr
import GHC.Internal.Enum
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Ptr
import GHC.Internal.Num
@@ -182,7 +181,6 @@ data SeekMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
=====================================
@@ -50,7 +50,6 @@ import GHC.Internal.IO.BufferedIO
import GHC.Internal.IO.Encoding.Types
import GHC.Internal.IORef
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Types (Bool(..), Int)
import GHC.Internal.Word
import GHC.Internal.IO.Device
@@ -273,7 +272,6 @@ data BufferMode
-- is 'Just' @n@ and is otherwise implementation-dependent.
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
@@ -379,7 +377,6 @@ data Newline = LF -- ^ @\'\\n\'@
| CRLF -- ^ @\'\\r\\n\'@
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
@@ -396,7 +393,6 @@ data NewlineMode
}
deriving ( Eq -- ^ @since base-4.2.0.0
, Ord -- ^ @since base-4.3.0.0
- , Read -- ^ @since base-4.3.0.0
, Show -- ^ @since base-4.3.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
=====================================
@@ -20,7 +20,6 @@ module GHC.Internal.IO.IOMode (IOMode(..)) where
import GHC.Internal.Classes (Eq, Ord)
import GHC.Internal.Show
-import GHC.Internal.Read
import GHC.Internal.Arr
import GHC.Internal.Enum
@@ -30,7 +29,6 @@ data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
, Ord -- ^ @since base-4.2.0.0
, Ix -- ^ @since base-4.2.0.0
, Enum -- ^ @since base-4.2.0.0
- , Read -- ^ @since base-4.2.0.0
, Show -- ^ @since base-4.2.0.0
)
=====================================
libraries/ghc-internal/src/GHC/Internal/Numeric.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
-----------------------------------------------------------------------------
-- |
@@ -16,279 +15,16 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.Numeric (
+module GHC.Internal.Numeric (showIntAtBase, showHex) where
- -- * Showing
-
- showSigned,
-
- showIntAtBase,
- showInt,
- showBin,
- showHex,
- showOct,
-
- showEFloat,
- showFFloat,
- showGFloat,
- showFFloatAlt,
- showGFloatAlt,
- showFloat,
- showHFloat,
-
- floatToDigits,
-
- -- * Reading
-
- -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
- -- and 'readDec' is the \`dual\' of 'showInt'.
- -- The inconsistent naming is a historical accident.
-
- readSigned,
-
- readInt,
- readBin,
- readDec,
- readOct,
- readHex,
-
- readFloat,
-
- lexDigits,
-
- -- * Miscellaneous
-
- fromRat,
- Floating(..)
-
- ) where
-
-import GHC.Internal.Base (ord, otherwise, return, unsafeChr, ($), (.), (++))
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&), (||))
-import GHC.Internal.Err (error, errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Prim (seq)
-import GHC.Internal.Read
-import GHC.Internal.Real
-import GHC.Internal.Float
-import GHC.Internal.Num
-import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
-import qualified GHC.Internal.Text.Read.Lex as L
-import GHC.Internal.Types (Bool(..), Char(..), Int)
-
--- $setup
--- >>> import Prelude
-
--- -----------------------------------------------------------------------------
--- Reading
-
--- | Reads an /unsigned/ integral value in an arbitrary base.
-readInt :: Num a
- => a -- ^ the base
- -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
- -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
- -> ReadS a
-readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
-
--- | Read an unsigned number in binary notation.
---
--- >>> readBin "10011"
--- [(19,"")]
-readBin :: (Eq a, Num a) => ReadS a
-readBin = readP_to_S L.readBinP
-
--- | Read an unsigned number in octal notation.
---
--- >>> readOct "0644"
--- [(420,"")]
-readOct :: (Eq a, Num a) => ReadS a
-readOct = readP_to_S L.readOctP
-
--- | Read an unsigned number in decimal notation.
---
--- >>> readDec "0644"
--- [(644,"")]
-readDec :: (Eq a, Num a) => ReadS a
-readDec = readP_to_S L.readDecP
-
--- | Read an unsigned number in hexadecimal notation.
--- Both upper or lower case letters are allowed.
---
--- >>> readHex "deadbeef"
--- [(3735928559,"")]
-readHex :: (Eq a, Num a) => ReadS a
-readHex = readP_to_S L.readHexP
-
--- | Reads an /unsigned/ 'RealFrac' value,
--- expressed in decimal scientific notation.
---
--- Note that this function takes time linear in the magnitude of its input
--- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
--- very large number while having a very small textual form).
--- For this reason, users should take care to avoid using this function on
--- untrusted input. Users needing to parse floating point values
--- (e.g. 'Float') are encouraged to instead use 'read', which does
--- not suffer from this issue.
-readFloat :: RealFrac a => ReadS a
-readFloat = readP_to_S readFloatP
-
-readFloatP :: RealFrac a => ReadP a
-readFloatP =
- do tok <- L.lex
- case tok of
- L.Number n -> return $ fromRational $ L.numberToRational n
- _ -> pfail
-
--- It's turgid to have readSigned work using list comprehensions,
--- but it's specified as a ReadS to ReadS transformer
--- With a bit of luck no one will use it.
-
--- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
-readSigned :: (Real a) => ReadS a -> ReadS a
-readSigned readPos = readParen False read'
- where read' r = read'' r ++
- (do
- ("-",s) <- lex r
- (x,t) <- read'' s
- return (-x,t))
- read'' r = do
- (str,s) <- lex r
- (n,"") <- readPos str
- return (n,s)
-
--- -----------------------------------------------------------------------------
--- Showing
-
--- | Show /non-negative/ 'Integral' numbers in base 10.
-showInt :: Integral a => a -> ShowS
-showInt n0 cs0
- | n0 < 0 = errorWithoutStackTrace "GHC.Internal.Numeric.showInt: can't show negative numbers"
- | otherwise = go n0 cs0
- where
- go n cs
- | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
- c@(C# _) -> c:cs
- | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
- c@(C# _) -> go q (c:cs)
- where
- (q,r) = n `quotRem` 10
-
--- Controlling the format and precision of floats. The code that
--- implements the formatting itself is in @PrelNum@ to avoid
--- mutual module deps.
-
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showEFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showFFloat ::
- Maybe Int -> Double -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Float -> ShowS #-}
-{-# SPECIALIZE showGFloat ::
- Maybe Int -> Double -> ShowS #-}
-
--- | Show a signed 'RealFloat' value
--- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
---
--- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then at most @d@ digits after the decimal point are shown.
-showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showEFloat d x = showString (formatRealFloat FFExponent d x)
-showFFloat d x = showString (formatRealFloat FFFixed d x)
-showGFloat d x = showString (formatRealFloat FFGeneric d x)
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
--- | Show a signed 'RealFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- This behaves as 'showFFloat', except that a decimal point
--- is always guaranteed, even if not needed.
---
--- @since base-4.7.0.0
-showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
-
-showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x)
-showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x)
-
-{- | Show a floating-point value in the hexadecimal format,
-similar to the @%a@ specifier in C's printf.
-
- >>> showHFloat (212.21 :: Double) ""
- "0x1.a86b851eb851fp7"
- >>> showHFloat (-12.76 :: Float) ""
- "-0x1.9851ecp3"
- >>> showHFloat (-0 :: Double) ""
- "-0x0p+0"
-
-@since base-4.11.0.0
--}
-showHFloat :: RealFloat a => a -> ShowS
-showHFloat = showString . fmt
- where
- fmt x
- | isNaN x = "NaN"
- | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity"
- | x < 0 || isNegativeZero x = '-' : cvt (-x)
- | otherwise = cvt x
-
- cvt x
- | x == 0 = "0x0p+0"
- | otherwise =
- case floatToDigits 2 x of
- r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
- (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
-
- -- Given binary digits, convert them to hex in blocks of 4
- -- Special case: If all 0's, just drop it.
- frac digits
- | allZ digits = ""
- | otherwise = "." ++ hex digits
- where
- hex ds =
- case ds of
- [] -> ""
- [a] -> hexDigit a 0 0 0 ""
- [a,b] -> hexDigit a b 0 0 ""
- [a,b,c] -> hexDigit a b c 0 ""
- a : b : c : d : r -> hexDigit a b c d (hex r)
-
- hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
-
- allZ xs = case xs of
- x : more -> x == 0 && allZ more
- [] -> True
+import GHC.Internal.Types (Char, Int)
+import GHC.Internal.Classes ((<), (<=))
+import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Base (($), otherwise)
+import GHC.Internal.List ((++))
+import GHC.Internal.Real (Integral, toInteger, fromIntegral, quotRem)
+import GHC.Internal.Show (ShowS, show, intToDigit)
-- ---------------------------------------------------------------------------
-- Integer printing functions
@@ -312,11 +48,3 @@ showIntAtBase base toChr n0 r0
-- | Show /non-negative/ 'Integral' numbers in base 16.
showHex :: Integral a => a -> ShowS
showHex = showIntAtBase 16 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 8.
-showOct :: Integral a => a -> ShowS
-showOct = showIntAtBase 8 intToDigit
-
--- | Show /non-negative/ 'Integral' numbers in base 2.
-showBin :: Integral a => a -> ShowS
-showBin = showIntAtBase 2 intToDigit
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -80,7 +80,6 @@ import GHC.Internal.Types (Bool(..), Char, Int, Ordering(..))
import GHC.Internal.Word
import GHC.Internal.List (filter)
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.ByteOrder
-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -840,6 +839,3 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
-
--- | @since base-4.11.0.0
-deriving instance Read ByteOrder
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9453,7 +9453,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12526,6 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -9491,7 +9491,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12459,7 +12459,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12526,7 +12525,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12555,6 +12554,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12569,16 +12569,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9733,7 +9733,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12701,7 +12701,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12768,7 +12767,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12797,6 +12796,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance GHC.Internal.Read.Read GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12812,16 +12812,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9453,7 +9453,7 @@ module GHC.Word where
uncheckedShiftRL64# :: GHC.Internal.Prim.Word64# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Word64#
module Numeric where
- -- Safety: Safe
+ -- Safety: Trustworthy
type Floating :: * -> Constraint
class GHC.Internal.Real.Fractional a => Floating a where
pi :: a
@@ -12430,7 +12430,6 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Inter
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
instance forall a b. (GHC.Internal.Ix.Ix a, GHC.Internal.Read.Read a, GHC.Internal.Read.Read b) => GHC.Internal.Read.Read (GHC.Internal.Arr.Array a b) -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Bool -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Char -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Double -- Defined in ‘GHC.Internal.Read’
instance GHC.Internal.Read.Read GHC.Internal.Types.Float -- Defined in ‘GHC.Internal.Read’
@@ -12497,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
@@ -12526,6 +12525,7 @@ instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CULong -- Defined i
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUSeconds -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CUShort -- Defined in ‘GHC.Internal.Foreign.C.Types’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CWchar -- Defined in ‘GHC.Internal.Foreign.C.Types’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (f :: k -> *) (g :: k -> *) (p :: k). (GHC.Internal.Read.Read (f p), GHC.Internal.Read.Read (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:+:) f g p) -- Defined in ‘GHC.Internal.Generics’
instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Read.Read (f (g p)) => GHC.Internal.Read.Read ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -12540,16 +12540,16 @@ instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceStrictness -- Define
instance GHC.Internal.Read.Read GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.U1 p) -- Defined in ‘GHC.Internal.Generics’
instance forall k (p :: k). GHC.Internal.Read.Read (GHC.Internal.Generics.V1 p) -- Defined in ‘GHC.Internal.Generics’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘GHC.Internal.IO.Device’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
-instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
instance [safe] GHC.Internal.Read.Read GHC.Stats.GCDetails -- Defined in ‘GHC.Stats’
instance [safe] GHC.Internal.Read.Read GHC.Stats.RTSStats -- Defined in ‘GHC.Stats’
instance GHC.Internal.Read.Read GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeChar -- Defined in ‘GHC.Internal.TypeLits’
instance GHC.Internal.Read.Read GHC.Internal.TypeLits.SomeSymbol -- Defined in ‘GHC.Internal.TypeLits’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.BufferMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.IOMode.IOMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘System.IO’
+instance GHC.Internal.Read.Read GHC.Internal.IO.Device.SeekMode -- Defined in ‘System.IO’
instance forall k a (b :: k). GHC.Internal.Real.Fractional a => GHC.Internal.Real.Fractional (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
instance forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Fractional (Data.Complex.Complex a) -- Defined in ‘Data.Complex’
instance forall k (a :: k). Data.Fixed.HasResolution a => GHC.Internal.Real.Fractional (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’
=====================================
testsuite/tests/plugins/plugins09.stdout
=====================================
@@ -1,5 +1,6 @@
parsePlugin(a,b)
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -2,6 +2,8 @@ parsePlugin()
interfacePlugin: Prelude
interfacePlugin: Language.Haskell.TH
interfacePlugin: Language.Haskell.TH.Quote
+interfacePlugin: Data.Version
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/plugins11.stdout
=====================================
@@ -1,5 +1,6 @@
parsePlugin()
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/plugins/static-plugins.stdout
=====================================
@@ -1,6 +1,7 @@
==pure.0
parsePlugin()
interfacePlugin: Prelude
+interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c80e2bd93db19b6e8db729039c4451f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c80e2bd93db19b6e8db729039c4451f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base2] Fix knot-vars problem
by Simon Peyton Jones (＠simonpj) 15 Apr '26
by Simon Peyton Jones (＠simonpj) 15 Apr '26
15 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
2239f43c by Simon Peyton Jones at 2026-04-15T12:03:41+01:00
Fix knot-vars problem
..I hope!
- - - - -
8 changed files:
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -178,16 +178,16 @@ configured via command-line flags (in `GHC.setTopSessionDynFlags`).
-- Note [hsc_type_env_var hack]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- hsc_type_env_var is used to initialize tcg_type_env_var, and
+-- hsc_type_env_var is used to initialize tcg_knot_vars, and
-- eventually it is the mutable variable that is queried from
-- if_rec_types to get a TypeEnv. So, clearly, it's something
-- related to knot-tying (see Note [Tying the knot]).
-- hsc_type_env_var is used in two places: initTcRn (where
--- it initializes tcg_type_env_var) and initIfaceCheck
+-- it initializes tcg_knot_vars) and initIfaceCheck
-- (where it initializes if_rec_types).
--
-- But why do we need a way to feed a mutable variable in? Why
--- can't we just initialize tcg_type_env_var when we start
+-- can't we just initialize tcg_knot_vars when we start
-- typechecking? The problem is we need to knot-tie the
-- EPS, and we may start adding things to the EPS before type
-- checking starts.
=====================================
compiler/GHC/Driver/Env/Types.hs
=====================================
@@ -83,8 +83,8 @@ data HscEnv
hsc_type_env_vars :: KnotVars (IORef TypeEnv)
-- ^ Used for one-shot compilation only, to initialise
- -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for
- -- 'GHC.Tc.Utils.TcGblEnv'. See also Note [hsc_type_env_var hack]
+ -- the 'IfGblEnv'. See 'tcg_knot_vars' in 'GHC.Tc.Utils.TcGblEnv'.
+ -- See also Note [hsc_type_env_var hack]
, hsc_interp :: Maybe Interp
-- ^ target code interpreter (if any) to use for TH and GHCi.
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -731,7 +731,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
mg <- downsweepThunk hsc_env mod_summary
-- Need to set the knot-tying mutable variable for interface
- -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
+ -- files. See GHC.Tc.Utils.TcGblEnv.tcg_knot_vars
-- See also Note [hsc_type_env_var hack]
type_env_var <- newIORef emptyNameEnv
let hsc_env' =
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -332,13 +332,17 @@ tcRnModuleTcRnM hsc_env mod_sum
; whenM (goptM Opt_DoCoreLinting) $
lintGblEnv (hsc_logger hsc_env) (hsc_dflags hsc_env) tcg_env
+ -- Sync the knot-tied type environment before checking
+ -- the M.hi-boot interface, if any
+ ; syncTypeEnvKnotVars tcg_env
+
; setGblEnv tcg_env
$ do { -- Compare hi-boot iface (if any) with the real thing
-- Must be done after processing the exports
tcg_env <- checkHiBootIface tcg_env boot_info
; -- The new type env is already available to stuff
- -- slurped from interface files, via
- -- GHC.Tc.Utils.Env.setGlobalTypeEnv. It's important that this
+ -- slurped from interface files, via syncTypeEnvKnotVars,
+ -- itself called by tcRnSrcDecls. It's important that this
-- includes the stuff in checkHiBootIface,
-- because the latter might add new bindings for
-- boot_dfuns, which may be mentioned in imported
@@ -570,6 +574,11 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
; ev_binds <- simplifyTop (lie `andWC` lie_main)
; return (tcg_env `addEvBinds` ev_binds) }
+ -- Update the knot-tied type environment to include everything
+ -- bound in this module. Do this now because when compiling GHC.Internal.Types,
+ -- mkTypeableBinds needs to "see" the definition of `Module`
+ ; syncTypeEnvKnotVars tcg_env
+
-- Emit Typeable bindings
; tcg_env <- setGblEnv tcg_env $
mkTypeableBinds
@@ -643,15 +652,15 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
-- to the previous tcg_env
; tcg_env' = tcg_env
- { tcg_binds = binds' ++ binds_mf
+ { tcg_type_env = final_type_env
+ , tcg_binds = binds' ++ binds_mf
, tcg_ev_binds = ev_binds' `unionBags` ev_binds_mf
, tcg_imp_specs = imp_specs' ++ imp_specs_mf
, tcg_rules = rules' ++ rules_mf
, tcg_fords = fords' ++ fords_mf
, tcg_patsyns = pat_syns' ++ patsyns_mf } } ;
- ; setGlobalTypeEnv tcg_env' final_type_env
- }
+ ; return tcg_env' }
zonkTcGblEnv :: TcGblEnv
-> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc,
@@ -834,10 +843,11 @@ tcRnHsBootDecls boot_or_sig decls
; let { type_env0 = tcg_type_env gbl_env
; type_env1 = extendTypeEnvWithIds type_env0 val_ids
; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
- ; dfun_ids = map iDFunId inst_infos
+ ; dfun_ids = map iDFunId inst_infos
+ ; gbl_env' = gbl_env { tcg_type_env = type_env2 }
}
- ; setGlobalTypeEnv gbl_env type_env2
+ ; return gbl_env'
}}}
; traceTc "boot" (ppr lie); return gbl_env }
@@ -875,20 +885,14 @@ checkHiBootIface tcg_env boot_info
--
-- to (a) the type envt, and (b) the top-level bindings
; let boot_impedance_bds = map fst imp_prs
- type_env' = extendTypeEnvWithIds local_type_env boot_impedance_bds
+ !type_env' = extendTypeEnvWithIds local_type_env boot_impedance_bds
impedance_binds = [ mkVarBind boot_id (nlHsVar id)
| (boot_id, id) <- imp_prs ]
tcg_env_w_binds
- = tcg_env { tcg_binds = binds ++ impedance_binds }
+ = tcg_env { tcg_type_env = type_env'
+ , tcg_binds = binds ++ impedance_binds }
- ; type_env' `seq`
- -- Why the seq? Without, we will put a TypeEnv thunk in
- -- tcg_type_env_var. That thunk will eventually get
- -- forced if we are typechecking interfaces, but that
- -- is no good if we are trying to typecheck the very
- -- DFun we were going to put in.
- -- TODO: Maybe setGlobalTypeEnv should be strict.
- setGlobalTypeEnv tcg_env_w_binds type_env' }
+ ; return tcg_env_w_binds }
{- Note [DFun impedance matching]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -978,7 +982,7 @@ This most works well, but there is one problem: DFuns! We do not want
to look at the mb_insts of the ModDetails in SelfBootInfo, because a
dfun in one of those ClsInsts is gotten (in GHC.IfaceToCore.tcIfaceInst) by a
(lazily evaluated) lookup in the if_rec_types. We could extend the
-type env, do a setGloblaTypeEnv etc; but that all seems very indirect.
+type env, do a syncTypeEnvKnotVars etc; but that all seems very indirect.
It is much more directly simply to extract the DFunIds from the
md_types of the SelfBootInfo.
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -487,7 +487,7 @@ data TcGblEnv
-- NB: for what "things in this module" means, see
-- Note [The interactive package] in "GHC.Runtime.Context"
- tcg_type_env_var :: KnotVars (IORef TypeEnv),
+ tcg_knot_vars :: KnotVars (IORef TypeEnv),
-- Used only to initialise the interface-file
-- typechecker in initIfaceTcRn, so that it can see stuff
-- bound in this module when dealing with hi-boot recursions
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -739,7 +739,7 @@ mergeSignatures
, rdr_elt <- lookupGRE rdr_env (LookupOccName occ AllRelevantGREs) ]
-- STEP 5: Typecheck the interfaces
- let type_env_var = tcg_type_env_var tcg_env
+ let knot_type_env = tcg_knot_vars tcg_env
-- typecheckIfacesForMerging does two things:
-- 1. It merges the all of the ifaces together, and typechecks the
@@ -748,7 +748,7 @@ mergeSignatures
-- resolving to the merged type_env from (1).
-- See typecheckIfacesForMerging for more details.
(type_env, detailss) <- initIfaceTcRn $
- typecheckIfacesForMerging inner_mod ifaces type_env_var
+ typecheckIfacesForMerging inner_mod ifaces knot_type_env
let infos = zip ifaces detailss
-- Test for cycles
@@ -764,7 +764,7 @@ mergeSignatures
-- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly,
-- rather than use tcExtendGlobalEnv (the normal method to add newly
-- defined types to TcGblEnv?) tcExtendGlobalEnv adds these
- -- TyThings to 'tcg_type_env_var', which is consulted when
+ -- TyThings to 'tcg_knot_vars', which is consulted when
-- we read in interfaces to tie the knot. But *these TyThings themselves
-- come from interface*, so that would result in deadlock. Don't
-- update it!
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -16,7 +16,7 @@ module GHC.Tc.Utils.Env(
-- Global environment
tcExtendGlobalEnv, tcExtendTyConEnv,
- tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
+ tcExtendGlobalEnvImplicit, syncTypeEnvKnotVars,
tcExtendGlobalValEnv, tcTyThBinders,
tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly,
tcLookupTyCon, tcLookupClass,
@@ -606,16 +606,21 @@ get_id do_the_lookup
************************************************************************
-}
-setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
--- Use this to update the global type env
--- It updates both * the normal tcg_type_env field
--- * the tcg_type_env_var field seen by interface files
-setGlobalTypeEnv tcg_env new_type_env
- = do { -- Sync the type-envt variable seen by interface files
- ; case lookupKnotVars (tcg_type_env_var tcg_env) (tcg_mod tcg_env) of
- Just tcg_env_var -> writeMutVar tcg_env_var new_type_env
- Nothing -> return ()
- ; return (tcg_env { tcg_type_env = new_type_env }) }
+syncTypeEnvKnotVars :: TcGblEnv -> TcM ()
+-- Use this to sync the tcg_knot_vars with the current type env
+-- so that interface-file and known-key/occ lookups will find the
+-- current bindings
+--
+-- Why the "!" before writing it into the variable? Without, we will put
+-- a TypeEnv thunk into the knot-tied variable. That thunk will eventually get
+-- forced if we are typechecking interfaces, but that is no good if we are
+-- trying to typecheck the very DFun we were going to put in.
+syncTypeEnvKnotVars tcg_env
+ = case lookupKnotVars (tcg_knot_vars tcg_env) (tcg_mod tcg_env) of
+ Just tcg_env_var -> do { let !type_env = tcg_type_env tcg_env
+ -- Why the "!"? See comment on the function
+ ; writeMutVar tcg_env_var type_env }
+ Nothing -> return ()
tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
@@ -623,8 +628,9 @@ tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
-- Do not extend tcg_tcs, tcg_patsyns etc
tcExtendGlobalEnvImplicit things thing_inside
= do { tcg_env <- getGblEnv
- ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things
- ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
+ ; let !type_env' = extendTypeEnvList (tcg_type_env tcg_env) things
+ tcg_env' = tcg_env { tcg_type_env = type_env' }
+ ; syncTypeEnvKnotVars tcg_env'
; setGblEnv tcg_env' thing_inside }
tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
@@ -677,8 +683,8 @@ tcExtendRecEnv gbl_stuff thing_inside
= do { tcg_env <- getGblEnv
; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
tcg_env' = tcg_env { tcg_type_env = ge' }
- -- No need for setGlobalTypeEnv (which side-effects the
- -- tcg_type_env_var); tcExtendRecEnv is used just
+ -- No need for syncTypeEnvKnotVars (which side-effects the
+ -- tcg_knot_vars); tcExtendRecEnv is used just
-- when kind-check a group of type/class decls. It would
-- in any case be wrong for an interface-file decl to end up
-- with a TcTyCon in it!
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -353,7 +353,7 @@ initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc =
, tcg_default = emptyDefaultEnv
, tcg_default_exports = emptyDefaultEnv
, tcg_type_env = emptyNameEnv
- , tcg_type_env_var = hsc_type_env_vars hsc_env
+ , tcg_knot_vars = hsc_type_env_vars hsc_env
, tcg_inst_env = emptyInstEnv
, tcg_fam_inst_env = emptyFamInstEnv
, tcg_ann_env = emptyAnnEnv
@@ -2404,7 +2404,7 @@ initIfaceTcRn thing_inside
; hsc_env <- getTopEnv
-- bangs to avoid leaking the envs (#19356)
; let !mhome_unit = hsc_home_unit_maybe hsc_env
- !knot_vars = tcg_type_env_var tcg_env
+ !knot_vars = tcg_knot_vars tcg_env
-- When we are instantiating a signature,
-- we DEFINITELY do not want to knot tie.
is_instantiate = fromMaybe False (isHomeUnitInstantiating <$> mhome_unit)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2239f43cbd96a03c9363010adbc8152…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2239f43cbd96a03c9363010adbc8152…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/ghc-pkg-ospath] Migrate `ghc-pkg` to use `OsPath` and `file-io`
by Hannes Siebenhandl (＠fendor) 15 Apr '26
by Hannes Siebenhandl (＠fendor) 15 Apr '26
15 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/ghc-pkg-ospath at Glasgow Haskell Compiler / GHC
Commits:
5456d3a0 by Fendor at 2026-04-15T12:34:05+02:00
Migrate `ghc-pkg` to use `OsPath` and `file-io`
`ghc-pkg` should use UNC paths as much as possible to avoid MAX_PATH
issues on windows.
`file-io` uses UNC Paths by default on windows, ensuring we use the
correct APIs and that we finally are no longer plagued by MAX_PATH
issues in CI and private machines.
On top of it, the higher correctness of `OsPath` is appreciated in this
small codebase. Also, we improve memory usage very slightly, due to the
more efficient memory representation of `OsPath` over `FilePath`
Adds `ghc-pkg` regression test for MAX_PATH on windows
Make sure `ghc-pkg` behaves as expected when long paths (> 255) are
involved on windows.
Let's generate a testcase where we can actually observe that `ghc-pkg`
behaves as epxected.
See the documentation for windows on Maximum Path Length Limitation:
* `https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation`
Adds changelog entry for long path support in ghc-pkg.
- - - - -
9 changed files:
- + changelog.d/ghc-pkg-long-path-support
- compiler/GHC/Unit/State.hs
- libraries/ghc-boot/GHC/Unit/Database.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- testsuite/tests/cabal/Makefile
- testsuite/tests/cabal/all.T
- + testsuite/tests/cabal/ghcpkg10.stdout
- utils/ghc-pkg/Main.hs
- utils/ghc-pkg/ghc-pkg.cabal.in
Changes:
=====================================
changelog.d/ghc-pkg-long-path-support
=====================================
@@ -0,0 +1,15 @@
+section: ghc-pkg
+synopsis: Improve ``ghc-pkg``'s support for long paths on windows.
+issues: #26960
+mrs: !15584
+
+description: {
+ ``ghc-pkg`` can't handle working with file paths longer than the MAX_PATH
+ restrictions on windows as it is not using UNC file paths by default.
+
+ By using UNC file paths whenever possible, we improve ``ghc-pkg`` on windows.
+ Note, this still requires the user to enable the use of long paths in order to opt-in
+ this behaviour on older windows machines.
+}
+
+
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -802,7 +802,7 @@ readUnitDatabase logger cfg conf_file = do
if cache_exists
then do
debugTraceMsg logger 2 $ text "Using binary package database:" <+> ppr filename
- readPackageDbForGhc (OsPath.unsafeDecodeUtf filename)
+ readPackageDbForGhc filename
else do
-- If there is no package.cache file, we check if the database is not
-- empty by inspecting if the directory contains any .conf file. If it
=====================================
libraries/ghc-boot/GHC/Unit/Database.hs
=====================================
@@ -68,6 +68,8 @@ module GHC.Unit.Database
-- * Misc
, mkMungePathUrl
, mungeUnitInfoPaths
+ , writeFileAtomic
+ , unsafeDecodeUtf
)
where
@@ -86,18 +88,23 @@ import Data.Binary.Get as Bin
import Data.List (intersperse)
import Control.Exception as Exception
import Control.Monad (when)
-import System.FilePath as FilePath
+import qualified System.FilePath as FilePath
#if !defined(mingw32_HOST_OS)
import Data.Bits ((.|.))
-import System.Posix.Files
+import System.Posix.Files.PosixString
import System.Posix.Types (FileMode)
+import System.OsString.Internal.Types (getOsString)
#endif
import System.IO
import System.IO.Error
import GHC.IO.Exception (IOErrorType(InappropriateType))
import qualified GHC.Data.ShortText as ST
import GHC.IO.Handle.Lock
-import System.Directory
+import GHC.Stack.Types (HasCallStack)
+import System.OsPath
+import qualified System.Directory.OsPath as OsPath
+import qualified System.Directory.Internal as OsPath.Internal
+import qualified System.File.OsPath as FileIO
-- | @ghc-boot@'s UnitInfo, serialized to the database.
type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
@@ -314,13 +321,13 @@ data DbInstUnitId
newtype PackageDbLock = PackageDbLock Handle
-- | Acquire an exclusive lock related to package DB under given location.
-lockPackageDb :: FilePath -> IO PackageDbLock
+lockPackageDb :: OsPath -> IO PackageDbLock
-- | Release the lock related to package DB.
unlockPackageDb :: PackageDbLock -> IO ()
-- | Acquire a lock of given type related to package DB under given location.
-lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock
+lockPackageDbWith :: LockMode -> OsPath -> IO PackageDbLock
lockPackageDbWith mode file = do
-- We are trying to open the lock file and then lock it. Thus the lock file
-- needs to either exist or we need to be able to create it. Ideally we
@@ -350,10 +357,10 @@ lockPackageDbWith mode file = do
(lockFileOpenIn ReadWriteMode)
(const $ lockFileOpenIn ReadMode)
where
- lock = file <.> "lock"
+ lock = file <.> OsPath.Internal.os "lock"
lockFileOpenIn io_mode = bracketOnError
- (openBinaryFile lock io_mode)
+ (FileIO.openBinaryFile lock io_mode)
hClose
-- If file locking support is not available, ignore the error and proceed
-- normally. Without it the only thing we lose on non-Windows platforms is
@@ -387,7 +394,7 @@ isDbOpenReadMode = \case
-- | Read the part of the package DB that GHC is interested in.
--
-readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]
+readPackageDbForGhc :: OsPath -> IO [DbUnitInfo]
readPackageDbForGhc file =
decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case
(pkgs, DbOpenReadOnly) -> return pkgs
@@ -409,7 +416,7 @@ readPackageDbForGhc file =
-- we additionally receive a PackageDbLock that represents a lock on the
-- database, so that we can safely update it later.
--
-readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->
+readPackageDbForGhcPkg :: Binary pkgs => OsPath -> DbOpenMode mode t ->
IO (pkgs, DbOpenMode mode PackageDbLock)
readPackageDbForGhcPkg file mode =
decodeFromFile file mode getDbForGhcPkg
@@ -425,7 +432,7 @@ readPackageDbForGhcPkg file mode =
-- | Write the whole of the package DB, both parts.
--
-writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()
+writePackageDb :: Binary pkgs => OsPath -> [DbUnitInfo] -> pkgs -> IO ()
writePackageDb file ghcPkgs ghcPkgPart = do
writeFileAtomic file (runPut putDbForGhcPkg)
#if !defined(mingw32_HOST_OS)
@@ -446,10 +453,10 @@ writePackageDb file ghcPkgs ghcPkgPart = do
ghcPart = encode ghcPkgs
#if !defined(mingw32_HOST_OS)
-addFileMode :: FilePath -> FileMode -> IO ()
+addFileMode :: OsPath -> FileMode -> IO ()
addFileMode file m = do
- o <- fileMode <$> getFileStatus file
- setFileMode file (m .|. o)
+ o <- fileMode <$> getFileStatus (getOsString file)
+ setFileMode (getOsString file) (m .|. o)
#endif
getHeader :: Get (Word32, Word32)
@@ -496,7 +503,7 @@ headerMagic = BS.Char8.pack "\0ghcpkg\0"
-- | Feed a 'Get' decoder with data chunks from a file.
--
-decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->
+decodeFromFile :: OsPath -> DbOpenMode mode t -> Get pkgs ->
IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile file mode decoder = case mode of
DbOpenReadOnly -> do
@@ -517,7 +524,7 @@ decodeFromFile file mode decoder = case mode of
bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do
(, DbOpenReadWrite lock) <$> decodeFileContents
where
- decodeFileContents = withBinaryFile file ReadMode $ \hnd ->
+ decodeFileContents = FileIO.withBinaryFile file ReadMode $ \hnd ->
feed hnd (runGetIncremental decoder)
feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
@@ -527,21 +534,21 @@ decodeFromFile file mode decoder = case mode of
feed _ (Done _ _ res) = return res
feed _ (Fail _ _ msg) = ioError err
where
- err = mkIOError InappropriateType loc Nothing (Just file)
+ err = mkIOError InappropriateType loc Nothing (Just $ unsafeDecodeUtf file)
`ioeSetErrorString` msg
loc = "GHC.Unit.Database.readPackageDb"
-- Copied from Cabal's Distribution.Simple.Utils.
-writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
+writeFileAtomic :: OsPath -> BS.Lazy.ByteString -> IO ()
writeFileAtomic targetPath content = do
let (targetDir, targetFile) = splitFileName targetPath
Exception.bracketOnError
- (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")
- (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
+ (FileIO.openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> OsPath.Internal.os "tmp")
+ (\(tmpPath, handle) -> hClose handle >> OsPath.removeFile tmpPath)
(\(tmpPath, handle) -> do
BS.Lazy.hPut handle content
hClose handle
- renameFile tmpPath targetPath)
+ OsPath.renameFile tmpPath targetPath)
instance Binary DbUnitInfo where
put (GenericUnitInfo
@@ -711,7 +718,7 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- rather than letting FilePath change it to use \ as the separator
stripVarPrefix var path = case ST.stripPrefix var path of
Just "" -> Just ""
- Just cs | isPathSeparator (ST.head cs) -> Just cs
+ Just cs | FilePath.isPathSeparator (ST.head cs) -> Just cs
_ -> Nothing
@@ -742,3 +749,8 @@ mungeUnitInfoPaths top_dir pkgroot pkg =
munge_paths = map munge_path
munge_urls = map munge_url
(munge_path,munge_url) = mkMungePathUrl top_dir pkgroot
+
+-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
+-- Prefer 'decodeUtf' and gracious error handling.
+unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
+unsafeDecodeUtf = OsPath.Internal.so
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -82,6 +82,8 @@ Library
containers >= 0.5 && < 0.9,
directory >= 1.2 && < 1.4,
filepath >= 1.3 && < 1.6,
+ file-io >= 0.1.5 && < 0.3,
+ os-string >= 2.0.1 && < 2.1,
deepseq >= 1.4 && < 1.6,
ghc-platform >= 0.1,
ghc-toolchain >= 0.1
=====================================
testsuite/tests/cabal/Makefile
=====================================
@@ -79,6 +79,25 @@ ghcpkg04 :
@: # testpkg-1.2.3.4 and newtestpkg-2.0 are both exposed now
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONF04) -c ghcpkg04.hs || true
+PKGCONF20=local20.package.conf
+LOCAL_GHC_PKG20 = '$(GHC_PKG)' --no-user-package-db
+
+DIR1=asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf
+DIR2=zxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcv
+DIR3=uiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiop
+DIR4=qwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwer
+WDIR=$(DIR1)/$(DIR2)/$(DIR3)/$(DIR4)
+.PHONY: ghcpkg10
+ghcpkg10 :
+ @mkdir -p $(WDIR)
+ @rm -rf $(WDIR)/$(PKGCONF20)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) init $(WDIR)/$(PKGCONF20)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) list
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) register --force test.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) describe testpkg | $(STRIP_PKGROOT)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) describe testpkg-1.2.3.4 | $(STRIP_PKGROOT)
+ $(LOCAL_GHC_PKG20) -f $(WDIR)/$(PKGCONF20) field testpkg-1.2.3.4 import-dirs
+
# Test stacking of package.confs (also #2441)
PKGCONF05a=local05a.package.conf
PKGCONF05b=local05b.package.conf
=====================================
testsuite/tests/cabal/all.T
=====================================
@@ -5,6 +5,9 @@ def ignore_warnings(str):
return re.sub(r'Warning:.*\n', '', str)
test('ghcpkg01', [extra_files(['test.pkg', 'test2.pkg', 'test3.pkg'])], makefile_test, [])
+# This test is still marked as borken even though it should work on windows, presumably due to runner
+# configuration issues.
+test('ghcpkg10', [extra_files(['test.pkg', 'test2.pkg', 'test3.pkg']), when(opsys('mingw32'), expect_broken(26960))], makefile_test, [])
# Use ignore_stderr to prevent (when HADDOCK_DOCS=NO):
# warning: haddock-interfaces .. doesn't exist or isn't a file
=====================================
testsuite/tests/cabal/ghcpkg10.stdout
=====================================
@@ -0,0 +1,50 @@
+asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf/zxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcvzxcv/uiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiopuiop/qwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwerqwer/local20.package.conf
+ (no packages)
+Reading package info from "test.pkg" ... done.
+name: testpkg
+version: 1.2.3.4
+visibility: public
+id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4-XXX
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users(a)haskell.org
+author: simonmar(a)microsoft.com
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+exposed: True
+exposed-modules: A
+hidden-modules: B C.D
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+hs-libraries: testpkg-1.2.3.4-XXX
+include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
+pkgroot:
+
+name: testpkg
+version: 1.2.3.4
+visibility: public
+id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4-XXX
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users(a)haskell.org
+author: simonmar(a)microsoft.com
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+exposed: True
+exposed-modules: A
+hidden-modules: B C.D
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
+hs-libraries: testpkg-1.2.3.4-XXX
+include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
+pkgroot:
+
+import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
=====================================
utils/ghc-pkg/Main.hs
=====================================
@@ -47,12 +47,19 @@ import Distribution.Types.UnqualComponentName
import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.MungedPackageId
-import Distribution.Simple.Utils (toUTF8BS, writeUTF8File, readUTF8File)
+import Distribution.Simple.Utils (ignoreBOM, toUTF8BS, toUTF8LBS, fromUTF8LBS)
import qualified Data.Version as Version
-import System.FilePath as FilePath
+import System.OsPath as OsPath
+import qualified System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
-import System.Directory ( getXdgDirectory, createDirectoryIfMissing, getAppUserDataDirectory,
- getModificationTime, XdgDirectory ( XdgData ) )
+import System.Directory.OsPath
+ ( getXdgDirectory, createDirectoryIfMissing, getAppUserDataDirectory,
+ getModificationTime, XdgDirectory ( XdgData ),
+ doesDirectoryExist, getDirectoryContents,
+ doesFileExist, removeFile,
+ getCurrentDirectory )
+import System.Directory.Internal (os)
+import qualified System.File.OsPath as FileIO
import Text.Printf
import Prelude hiding (Foldable(..))
@@ -65,15 +72,13 @@ import Data.Bifunctor
import Data.Char ( toLower )
import Control.Monad
-import System.Directory ( doesDirectoryExist, getDirectoryContents,
- doesFileExist, removeFile,
- getCurrentDirectory )
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
import System.IO.Error
-import GHC.IO ( catchException )
+import GHC.IO ( catchException, unsafePerformIO )
import GHC.IO.Exception (IOErrorType(InappropriateType))
+import GHC.Stack.Types (HasCallStack)
import Data.List ( group, sort, sortBy, nub, partition, find
, intercalate, intersperse, unfoldr
, isInfixOf, isSuffixOf, isPrefixOf, stripPrefix )
@@ -429,8 +434,9 @@ runit verbosity cli nonopts = do
print filename
glob filename >>= print
#endif
- ["init", filename] ->
- initPackageDB filename verbosity cli
+ ["init", filename] -> do
+ filenameOs <- encodeFS filename
+ initPackageDB filenameOs verbosity cli
["register", filename] ->
registerPackage filename verbosity cli
multi_instance
@@ -538,7 +544,7 @@ readPackageArg AsDefault str = Id <$> readGlobPkgId str
data PackageDB (mode :: GhcPkg.DbMode)
= PackageDB {
- location, locationAbsolute :: !FilePath,
+ location, locationAbsolute :: !OsPath,
-- We need both possibly-relative and definitely-absolute package
-- db locations. This is because the relative location is used as
-- an identifier for the db, so it is important we do not modify it.
@@ -570,14 +576,14 @@ allPackagesInStack = concatMap packages
-- specified package DB can depend on, since dependencies can only extend
-- down the stack, not up (e.g. global packages cannot depend on user
-- packages).
-stackUpTo :: FilePath -> PackageDBStack -> PackageDBStack
+stackUpTo :: OsPath -> PackageDBStack -> PackageDBStack
stackUpTo to_modify = dropWhile ((/= to_modify) . location)
-readFromSettingsFile :: FilePath
- -> (FilePath -> RawSettings -> Either String b)
+readFromSettingsFile :: OsPath
+ -> (OsPath -> RawSettings -> Either String b)
-> IO (Either String b)
readFromSettingsFile settingsFile f = do
- settingsStr <- readFile settingsFile
+ settingsStr <- readUtf8File settingsFile
pure $ do
mySettings <- case maybeReadFuzzy settingsStr of
Just s -> pure $ Map.fromList s
@@ -586,11 +592,11 @@ readFromSettingsFile settingsFile f = do
Nothing -> Left $ "Can't parse settings file " ++ show settingsFile
f settingsFile mySettings
-readFromTargetFile :: FilePath
+readFromTargetFile :: OsPath
-> (Target -> b)
-> IO (Either String b)
readFromTargetFile targetFile f = do
- targetStr <- readFile targetFile
+ targetStr <- readUtf8File targetFile
pure $ do
target <- case maybeReadFuzzy targetStr of
Just t -> Right t
@@ -626,33 +632,35 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
case [ f | FlagGlobalConfig f <- my_flags ] of
-- See Note [Base Dir] for more information on the base dir / top dir.
[] -> do mb_dir <- getBaseDir
- case mb_dir of
+ mb_dir_os <- traverse encodeFS mb_dir
+ case mb_dir_os of
Nothing -> die err_msg
Just dir -> do
-- Look for where it is given in the settings file, if marked there.
-- See Note [Settings file] about this file, and why we need GHC to share it with us.
- let settingsFile = dir </> "settings"
+ let settingsFile = dir </> os "settings"
exists_settings_file <- doesFileExist settingsFile
erel_db <-
if exists_settings_file
- then readFromSettingsFile settingsFile getGlobalPackageDb
- else pure (Left ("Settings file doesn't exist: " ++ settingsFile))
+ then do
+ readFromSettingsFile settingsFile (\ settings -> getGlobalPackageDb (unsafeDecodeUtf settings))
+ else pure (Left ("Settings file doesn't exist: " ++ showOsPath settingsFile))
case erel_db of
- Right rel_db -> return (dir, dir </> rel_db)
+ Right rel_db -> return (dir, dir </> unsafeEncodeUtf rel_db)
-- If the version of GHC doesn't have this field or the settings file
-- doesn't exist for some reason, look in the libdir.
Left err -> do
r <- lookForPackageDBIn dir
case r of
- Nothing -> die (unlines [err, ("Fallback: Can't find package database in " ++ dir)])
+ Nothing -> die (unlines [err, ("Fallback: Can't find package database in " ++ showOsPath dir)])
Just path -> return (dir, path)
fs -> do
-- The value of the $topdir variable used in some package descriptions
-- Note that the way we calculate this is slightly different to how it
-- is done in ghc itself. We rely on the convention that the global
-- package db lives in ghc's libdir.
- let pkg_db = last fs
+ let pkg_db = unsafeEncodeUtf $ last fs
top_dir <- absolutePath (takeDirectory pkg_db)
return (top_dir, pkg_db)
@@ -662,10 +670,10 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- getXdgDirectory can fail (e.g. if $HOME isn't set)
mb_user_conf <-
- case [ f | FlagUserConfig f <- my_flags ] of
+ case [ unsafeEncodeUtf f | FlagUserConfig f <- my_flags ] of
_ | no_user_db -> return Nothing
[] -> do
- let targetFile = top_dir </> "targets" </> "default.target"
+ let targetFile = top_dir </> os "targets" </> os "default.target"
exists_settings_file <- doesFileExist targetFile
targetArchOS <- case exists_settings_file of
False -> do
@@ -694,15 +702,15 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR
--
-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version
- m_appdir <- getFirstSuccess $ map (fmap (</> subdir))
- [ getAppUserDataDirectory "ghc" -- this is ~/.ghc/
- , getXdgDirectory XdgData "ghc" -- this is $XDG_DATA_HOME/
+ m_appdir <- getFirstSuccess $ map (fmap (</> unsafeEncodeUtf subdir))
+ [ getAppUserDataDirectory $ os "ghc" -- this is ~/.ghc/
+ , getXdgDirectory XdgData $ os "ghc" -- this is $XDG_DATA_HOME/
]
case m_appdir of
Nothing -> return Nothing
Just dir -> do
lookForPackageDBIn dir >>= \case
- Nothing -> return (Just (dir </> "package.conf.d", False))
+ Nothing -> return (Just (dir </> os "package.conf.d", False))
Just f -> return (Just (f, True))
fs -> return (Just (last fs, True))
@@ -716,11 +724,11 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
e_pkg_path <- tryIO (System.Environment.getEnv "GHC_PACKAGE_PATH")
let env_stack =
- case e_pkg_path of
+ case fmap unsafeEncodeUtf e_pkg_path of
Left _ -> sys_databases
Right path
- | not (null path) && isSearchPathSeparator (last path)
- -> splitSearchPath (init path) ++ sys_databases
+ | hasTrailingPathSeparator path
+ -> splitSearchPath (dropTrailingPathSeparator path) <> sys_databases
| otherwise
-> splitSearchPath path
@@ -733,7 +741,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
| Just (user_conf, _user_exists) <- mb_user_conf
= Just user_conf
is_db_flag FlagGlobal = Just virt_global_conf
- is_db_flag (FlagConfig f) = Just f
+ is_db_flag (FlagConfig f) = Just $ unsafeEncodeUtf f
is_db_flag _ = Nothing
let flag_db_names | null db_flags = env_stack
@@ -748,7 +756,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-- stack, unless any of them are present in the stack
-- already.
let final_stack = filter (`notElem` env_stack)
- [ f | FlagConfig f <- reverse my_flags ]
+ [ unsafeEncodeUtf f | FlagConfig f <- reverse my_flags ]
++ env_stack
top_db = if null db_flags
@@ -764,7 +772,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
when (verbosity > Normal) $ do
infoLn ("db stack: " ++ show (map location db_stack))
F.forM_ db_to_operate_on $ \db ->
- infoLn ("modifying: " ++ (location db))
+ infoLn ("modifying: " ++ showOsPath (location db))
infoLn ("flag db stack: " ++ show (map location flag_db_stack))
return (db_stack, db_to_operate_on, flag_db_stack)
@@ -843,17 +851,19 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
return (db_stack, GhcPkg.DbOpenReadWrite to_modify)
where
- couldntOpenDbForModification :: FilePath -> IOError -> IO a
+ couldntOpenDbForModification :: OsPath -> IOError -> IO a
couldntOpenDbForModification db_path e = die $ "Couldn't open database "
- ++ db_path ++ " for modification: " ++ show e
+ ++ showOsPath db_path ++ " for modification: " ++ show e
-- Parse package db in read-only mode.
- readDatabase :: FilePath -> IO (PackageDB 'GhcPkg.DbReadOnly)
+ readDatabase :: OsPath -> IO (PackageDB 'GhcPkg.DbReadOnly)
readDatabase db_path = do
db <- readParseDatabase verbosity mb_user_conf
GhcPkg.DbOpenReadOnly use_cache db_path
if expand_vars
- then return $ mungePackageDBPaths top_dir db
+ then do
+ top_dir_filepath <- decodeFS top_dir
+ return $ mungePackageDBPaths top_dir_filepath db
else return db
stateSequence :: Monad m => s -> [s -> m (a, s)] -> m ([a], s)
@@ -863,20 +873,20 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
(as, s'') <- stateSequence s' ms
return (a : as, s'')
-lookForPackageDBIn :: FilePath -> IO (Maybe FilePath)
+lookForPackageDBIn :: OsPath -> IO (Maybe OsPath)
lookForPackageDBIn dir = do
- let path_dir = dir </> "package.conf.d"
+ let path_dir = dir </> os "package.conf.d"
exists_dir <- doesDirectoryExist path_dir
if exists_dir then return (Just path_dir) else do
- let path_file = dir </> "package.conf"
+ let path_file = dir </> os "package.conf"
exists_file <- doesFileExist path_file
if exists_file then return (Just path_file) else return Nothing
readParseDatabase :: forall mode t. Verbosity
- -> Maybe (FilePath,Bool)
+ -> Maybe (OsPath,Bool)
-> GhcPkg.DbOpenMode mode t
-> Bool -- use cache
- -> FilePath
+ -> OsPath
-> IO (PackageDB mode)
readParseDatabase verbosity mb_user_conf mode use_cache path
-- the user database (only) is allowed to be non-existent
@@ -898,7 +908,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
Just db -> return db
Nothing ->
die $ "ghc no longer supports single-file style package "
- ++ "databases (" ++ path ++ ") use 'ghc-pkg init'"
+ ++ "databases (" ++ showOsPath path ++ ") use 'ghc-pkg init'"
++ "to create the database with the correct format."
| otherwise -> ioError err
@@ -914,7 +924,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
-- It's fine if the cache is not there as long as the
-- database is empty.
when (not $ null confs) $ do
- warn ("WARNING: cache does not exist: " ++ cache)
+ warn ("WARNING: cache does not exist: " ++ showOsPath cache)
warn ("ghc will fail to read this package db. " ++
recacheAdvice)
else do
@@ -923,7 +933,7 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
ignore_cache (const $ return ())
Right tcache -> do
when (verbosity >= Verbose) $ do
- warn ("Timestamp " ++ show tcache ++ " for " ++ cache)
+ warn ("Timestamp " ++ show tcache ++ " for " ++ showOsPath cache)
-- If any of the .conf files is newer than package.cache, we
-- assume that cache is out of date.
cache_outdated <- (`anyM` confs) $ \conf ->
@@ -931,12 +941,12 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
if not cache_outdated
then do
when (verbosity > Normal) $
- infoLn ("using cache: " ++ cache)
+ infoLn ("using cache: " ++ showOsPath cache)
GhcPkg.readPackageDbForGhcPkg cache mode
>>= uncurry mkPackageDB
else do
whenReportCacheErrors $ do
- warn ("WARNING: cache is out of date: " ++ cache)
+ warn ("WARNING: cache is out of date: " ++ showOsPath cache)
warn ("ghc will see an old view of this " ++
"package db. " ++ recacheAdvice)
ignore_cache $ \file -> do
@@ -947,11 +957,11 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
GT -> " (older than cache)"
EQ -> " (same as cache)"
warn ("Timestamp " ++ show tFile
- ++ " for " ++ file ++ rel)
+ ++ " for " ++ showOsPath file ++ rel)
where
- confs = map (path </>) $ filter (".conf" `isSuffixOf`) fs
+ confs = map (path </>) $ filter (os ".conf" `OsPath.isExtensionOf`) fs
- ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode)
+ ignore_cache :: (OsPath -> IO ()) -> IO (PackageDB mode)
ignore_cache checkTime = do
-- If we're opening for modification, we need to acquire a
-- lock even if we don't open the cache now, because we are
@@ -987,17 +997,18 @@ readParseDatabase verbosity mb_user_conf mode use_cache path
packages = pkgs
}
-parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
+parseSingletonPackageConf :: Verbosity -> OsPath -> IO InstalledPackageInfo
parseSingletonPackageConf verbosity file = do
- when (verbosity > Normal) $ infoLn ("reading package config: " ++ file)
- BS.readFile file >>= fmap fst . parsePackageInfo
+ when (verbosity > Normal) $ infoLn ("reading package config: " ++ showOsPath file)
+ FileIO.readFile file >>= fmap fst . parsePackageInfo . BS.toStrict
+
-cachefilename :: FilePath
-cachefilename = "package.cache"
+cachefilename :: OsPath
+cachefilename = os "package.cache"
mungePackageDBPaths :: FilePath -> PackageDB mode -> PackageDB mode
mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =
- db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
+ db { packages = map (mungePackagePaths top_dir (unsafeDecodeUtf pkgroot)) pkgs }
where
pkgroot = takeDirectory $ dropTrailingPathSeparator (locationAbsolute db)
-- It so happens that for both styles of package db ("package.conf"
@@ -1044,12 +1055,13 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
| Just p' <- stripVarPrefix "$httptopdir" p = toUrlPath top_dir p'
| otherwise = p
+ toUrlPath :: FilePath -> FilePath -> FilePath
toUrlPath r p = "file:///"
-- URLs always use posix style '/' separators:
++ FilePath.Posix.joinPath
(r : -- We need to drop a leading "/" or "\\"
-- if there is one:
- dropWhile (all isPathSeparator)
+ dropWhile (all FilePath.isPathSeparator)
(FilePath.splitDirectories p))
-- We could drop the separator here, and then use </> above. However,
@@ -1057,7 +1069,7 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- rather than letting FilePath change it to use \ as the separator
stripVarPrefix var path = case stripPrefix var path of
Just [] -> Just []
- Just cs@(c : _) | isPathSeparator c -> Just cs
+ Just cs@(c : _) | FilePath.isPathSeparator c -> Just cs
_ -> Nothing
-- -----------------------------------------------------------------------------
@@ -1074,18 +1086,18 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- ghc itself also cooperates in this workaround
-tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool)
- -> GhcPkg.DbOpenMode mode t -> Bool -> FilePath
+tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (OsPath, Bool)
+ -> GhcPkg.DbOpenMode mode t -> Bool -> OsPath
-> IO (Maybe (PackageDB mode))
tryReadParseOldFileStyleDatabase verbosity mb_user_conf
mode use_cache path = do
-- assumes we've already established that path exists and is not a dir
- content <- readFile path `catchIO` \_ -> return ""
+ content <- readUtf8File path `catchIO` \_ -> return ""
if take 2 content == "[]"
then do
path_abs <- absolutePath path
let path_dir = adjustOldDatabasePath path
- warn $ "Warning: ignoring old file-style db and trying " ++ path_dir
+ warn $ "Warning: ignoring old file-style db and trying " ++ showOsPath path_dir
direxists <- doesDirectoryExist path_dir
if direxists
then do
@@ -1112,7 +1124,7 @@ tryReadParseOldFileStyleDatabase verbosity mb_user_conf
adjustOldFileStylePackageDB :: PackageDB mode -> IO (PackageDB mode)
adjustOldFileStylePackageDB db = do
-- assumes we have not yet established if it's an old style or not
- mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing
+ mcontent <- liftM Just (readUtf8File (location db)) `catchIO` \_ -> return Nothing
case fmap (take 2) mcontent of
-- it is an old style and empty db, so look for a dir kind in location.d/
Just "[]" -> return db {
@@ -1121,20 +1133,20 @@ adjustOldFileStylePackageDB db = do
}
-- it is old style but not empty, we have to bail
Just _ -> die $ "ghc no longer supports single-file style package "
- ++ "databases (" ++ location db ++ ") use 'ghc-pkg init'"
+ ++ "databases (" ++ showOsPath (location db) ++ ") use 'ghc-pkg init'"
++ "to create the database with the correct format."
-- probably not old style, carry on as normal
Nothing -> return db
-adjustOldDatabasePath :: FilePath -> FilePath
-adjustOldDatabasePath = (<.> "d")
+adjustOldDatabasePath :: OsPath -> OsPath
+adjustOldDatabasePath = (<.> os "d")
-- -----------------------------------------------------------------------------
-- Creating a new package DB
-initPackageDB :: FilePath -> Verbosity -> [Flag] -> IO ()
+initPackageDB :: OsPath -> Verbosity -> [Flag] -> IO ()
initPackageDB filename verbosity _flags = do
- let eexist = die ("cannot create: " ++ filename ++ " already exists")
+ let eexist = die ("cannot create: " ++ showOsPath filename ++ " already exists")
b1 <- doesFileExist filename
when b1 eexist
b2 <- doesDirectoryExist filename
@@ -1183,7 +1195,8 @@ registerPackage input verbosity my_flags multi_instance
f -> do
when (verbosity >= Normal) $
info ("Reading package info from " ++ show f ++ " ... ")
- readUTF8File f
+ fs <- encodeFS f
+ readUtf8File fs
expanded <- if expand_env_vars then expandEnvVars s force
else return s
@@ -1199,7 +1212,11 @@ registerPackage input verbosity my_flags multi_instance
-- validate the expanded pkg, but register the unexpanded
pkgroot <- absolutePath (takeDirectory to_modify)
let top_dir = takeDirectory (location (last db_stack))
- pkg_expanded = mungePackagePaths top_dir pkgroot pkg
+
+ top_dir_filepath <- decodeFS top_dir
+ pkgroot_filepath <- decodeFS pkgroot
+ let
+ pkg_expanded = mungePackagePaths top_dir_filepath pkgroot_filepath pkg
let truncated_stack = stackUpTo to_modify db_stack
-- truncate the stack for validation, because we don't allow
@@ -1274,13 +1291,13 @@ changeDBDir verbosity cmds db db_stack = do
updateDBCache verbosity db db_stack
where
do_cmd (RemovePackage p) = do
- let file = location db </> display (installedUnitId p) <.> "conf"
- when (verbosity > Normal) $ infoLn ("removing " ++ file)
+ let file = location db </> unsafeEncodeUtf (display (installedUnitId p)) <.> os "conf"
+ when (verbosity > Normal) $ infoLn ("removing " ++ showOsPath file)
removeFileSafe file
do_cmd (AddPackage p) = do
- let file = location db </> display (installedUnitId p) <.> "conf"
- when (verbosity > Normal) $ infoLn ("writing " ++ file)
- writeUTF8File file (showInstalledPackageInfo p)
+ let file = location db </> unsafeEncodeUtf (display (installedUnitId p)) <.> os "conf"
+ when (verbosity > Normal) $ infoLn ("writing " ++ showOsPath file)
+ writeUtf8File file (showInstalledPackageInfo p)
do_cmd (ModifyPackage p) =
do_cmd (AddPackage p)
@@ -1338,13 +1355,13 @@ updateDBCache verbosity db db_stack = do
warn $ " " ++ pkg
when (verbosity > Normal) $
- infoLn ("writing cache " ++ filename)
+ infoLn ("writing cache " ++ showOsPath filename)
let d = fmap (fromPackageCacheFormat . fst) pkgsGhcCacheFormat
GhcPkg.writePackageDb filename d pkgsCabalFormat
`catchIO` \e ->
if isPermissionError e
- then die $ filename ++ ": you don't have permission to modify this file"
+ then die $ showOsPath filename ++ ": you don't have permission to modify this file"
else ioError e
case packageDbLock db of
@@ -1583,7 +1600,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
broken = map installedUnitId (brokenPackages pkg_map)
show_normal PackageDB{ location = db_name, packages = pkg_confs } =
- do hPutStrLn stdout db_name
+ do hPutStrLn stdout (showOsPath db_name)
if null pkg_confs
then hPutStrLn stdout " (no packages)"
else hPutStrLn stdout $ unlines (map (" " ++) (map pp_pkg pkg_confs))
@@ -1610,7 +1627,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
#else
let
show_colour PackageDB{ location = db_name, packages = pkg_confs } =
- do hPutStrLn stdout db_name
+ do hPutStrLn stdout (showOsPath db_name)
if null pkg_confs
then hPutStrLn stdout " (no packages)"
else hPutStrLn stdout $ unlines (map (" " ++) (map pp_pkg pkg_confs))
@@ -1698,7 +1715,7 @@ dumpUnits verbosity my_flags expand_pkgroot = do
doDump expand_pkgroot [ (pkg, locationAbsolute db)
| db <- flag_db_stack, pkg <- packages db ]
-doDump :: Bool -> [(InstalledPackageInfo, FilePath)] -> IO ()
+doDump :: Bool -> [(InstalledPackageInfo, OsPath)] -> IO ()
doDump expand_pkgroot pkgs = do
-- fix the encoding to UTF-8, since this is an interchange format
hSetEncoding stdout utf8
@@ -1731,7 +1748,7 @@ findPackagesByDB db_stack pkgarg
cannotFindPackage :: PackageArg -> Maybe (PackageDB mode) -> IO a
cannotFindPackage pkgarg mdb = die $ "cannot find package " ++ pkg_msg pkgarg
- ++ maybe "" (\db -> " in " ++ location db) mdb
+ ++ maybe "" (\db -> " in " ++ showOsPath (location db)) mdb
where
pkg_msg (Id pkgid) = displayGlobPkgId pkgid
pkg_msg (IUId ipid) = display ipid
@@ -1944,7 +1961,7 @@ checkPackageConfig pkg verbosity db_stack
checkExposedModules db_stack pkg
checkOtherModules pkg
let has_code = Set.null (openModuleSubstFreeHoles (Map.fromList (instantiatedWith pkg)))
- when has_code $ mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)
+ when has_code $ mapM_ (checkHSLib verbosity (fmap unsafeEncodeUtf $ libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)
-- ToDo: check these somehow?
-- extra_libraries :: [String],
-- c_includes :: [String],
@@ -2011,20 +2028,20 @@ checkPath url_ok is_dir warn_only thisfield d
|| "https://" `isPrefixOf` d) = return ()
| url_ok
- , Just d' <- stripPrefix "file://" d
- = checkPath False is_dir warn_only thisfield d'
+ , Just f <- stripPrefix "file://" d
+ = checkPath False is_dir warn_only thisfield f
-- Note: we don't check for $topdir/${pkgroot} here. We rely on these
-- variables having been expanded already, see mungePackagePaths.
- | isRelative d = verror ForceFiles $
+ | isRelative d' = verror ForceFiles $
thisfield ++ ": " ++ d ++ " is a relative path which "
++ "makes no sense (as there is nothing for it to be "
++ "relative to). You can make paths relative to the "
++ "package database itself by using ${pkgroot}."
-- relative paths don't make any sense; #4134
| otherwise = do
- there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d
+ there <- liftIO $ if is_dir then doesDirectoryExist d' else doesFileExist d'
when (not there) $
let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a "
++ if is_dir then "directory" else "file"
@@ -2032,6 +2049,8 @@ checkPath url_ok is_dir warn_only thisfield d
if warn_only
then vwarn msg
else verror ForceFiles msg
+ where
+ d' = unsafeEncodeUtf d
checkDep :: PackageDBStack -> UnitId -> Validate ()
checkDep db_stack pkgid
@@ -2050,24 +2069,25 @@ checkDuplicateDepends deps
where
dups = [ p | (p:_:_) <- group (sort deps) ]
-checkHSLib :: Verbosity -> [String] -> String -> Validate ()
+checkHSLib :: Verbosity -> [OsPath] -> String -> Validate ()
checkHSLib _verbosity dirs lib = do
- let filenames = ["lib" ++ lib ++ ".a",
- "lib" ++ lib ++ "_p.a",
- "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so",
- "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so",
- "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib",
- "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib",
- lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll",
- lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll",
- lib ++ ".bytecodelib"
- ]
+ let filenames = fmap OsPath.unsafeEncodeUtf
+ [ "lib" ++ lib ++ ".a"
+ , "lib" ++ lib ++ "_p.a"
+ , "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so"
+ , "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so"
+ , "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib"
+ , "lib" ++ lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib"
+ , lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll"
+ , lib ++ "_p" ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll"
+ , lib ++ ".bytecodelib"
+ ]
b <- liftIO $ doesFileExistOnPath filenames dirs
when (not b) $
verror ForceFiles ("cannot find any of " ++ show filenames ++
" on library path")
-doesFileExistOnPath :: [FilePath] -> [FilePath] -> IO Bool
+doesFileExistOnPath :: [OsPath] -> [OsPath] -> IO Bool
doesFileExistOnPath filenames paths = anyM doesFileExist fullFilenames
where fullFilenames = [ path </> filename
| filename <- filenames
@@ -2096,9 +2116,9 @@ checkModuleFile :: InstalledPackageInfo -> ModuleName -> Validate ()
checkModuleFile pkg modl =
-- there's no interface file for GHC.Prim
unless (modl == ModuleName.fromString "GHC.Prim") $ do
- let files = [ ModuleName.toFilePath modl <.> extension
- | extension <- ["hi", "p_hi", "dyn_hi", "p_dyn_hi"] ]
- b <- liftIO $ doesFileExistOnPath files (importDirs pkg)
+ let files = [ unsafeEncodeUtf (ModuleName.toFilePath modl) <.> extension
+ | extension <- fmap os ["hi", "p_hi", "dyn_hi", "p_dyn_hi"] ]
+ b <- liftIO $ doesFileExistOnPath files (fmap unsafeEncodeUtf $ importDirs pkg)
when (not b) $
verror ForceFiles ("cannot find any of " ++ show files)
@@ -2273,19 +2293,45 @@ installSignalHandlers = do
return ()
#endif
+-- ------------------------------------------------
+-- OsPath Utils
+
+-- | Show an 'OsPath', throwing an exception if we fail to decode it.
+showOsPath :: HasCallStack => OsPath -> FilePath
+showOsPath = unsafePerformIO . decodeFS
+
+-- | Turn a path relative to the current directory into a (normalised)
+-- absolute path.
+absolutePath :: OsPath -> IO OsPath
+absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
+
+-- ------------------------------------------------
+
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = catchException
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO = Exception.try
--- removeFileSave doesn't throw an exceptions, if the file is already deleted
-removeFileSafe :: FilePath -> IO ()
+-----------------------------------------
+-- Adapted from ghc/compiler/utils/Panic
+
+-- | 'removeFileSave' doesn't throw an exceptions, if the file is already deleted
+removeFileSafe :: OsPath -> IO ()
removeFileSafe fn =
removeFile fn `catchIO` \ e ->
when (not $ isDoesNotExistError e) $ ioError e
--- | Turn a path relative to the current directory into a (normalised)
--- absolute path.
-absolutePath :: FilePath -> IO FilePath
-absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
+-- | Read a file using UTF-8 encoding
+--
+-- Taken from https://github.com/haskell/cabal/blob/cea1d8ff1a80df3c3b3148d1556bd3edf656d…
+-- and adapted to 'OsPath'.
+writeUtf8File :: OsPath -> String -> IO ()
+writeUtf8File file contents = writeFileAtomic file (toUTF8LBS contents)
+
+-- | Read a file and interpret its content to be UTF-8 encoded.
+--
+-- Taken from https://github.com/haskell/cabal/blob/cea1d8ff1a80df3c3b3148d1556bd3edf656d…
+-- and adapted to 'OsPath'.
+readUtf8File :: OsPath -> IO String
+readUtf8File file = (ignoreBOM . fromUTF8LBS) <$> FileIO.readFile file
=====================================
utils/ghc-pkg/ghc-pkg.cabal.in
=====================================
@@ -25,6 +25,7 @@ Executable ghc-pkg
process >= 1 && < 1.7,
containers,
filepath,
+ file-io,
Cabal,
Cabal-syntax,
binary,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5456d3a06a03735bcb8db78fe941200…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5456d3a06a03735bcb8db78fe941200…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] 13 commits: Suppress desugaring warnings in the pattern match checker
by Hannes Siebenhandl (＠fendor) 15 Apr '26
by Hannes Siebenhandl (＠fendor) 15 Apr '26
15 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
d419e972 by Luite Stegeman at 2026-04-13T15:16:04-04:00
Suppress desugaring warnings in the pattern match checker
Avoid duplicating warnings from the actual desugaring pass.
fixes #25996
- - - - -
c5b80dd0 by Phil de Joux at 2026-04-13T15:16:51-04:00
Typo ~/ghc/arch-os-version/environments
- - - - -
71462fff by Luite Stegeman at 2026-04-13T15:17:38-04:00
add changelog entry for #26233
- - - - -
d1ddfd4b by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
Add test for #25636
The existing test behaviour of "T23146_liftedeq" changed because the
simplifier now does a bit more inlining. We can restore the previous bad
behavior by using an OPAQUE pragma.
This test doubles as a test for #25636 when run in ghci, so we add it as
such.
- - - - -
b9df40ee by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
refactor: protoBCOName is always a Name
Simplifies the code by removing the unnecessary type argument to
ProtoBCO which was always 'Name'
- - - - -
5c2a179e by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
Allocate static constructors for bytecode
This commit adds support for static constructors when compiling and
linking ByteCode objects.
Top-level StgRhsCon get lowered to ProtoStaticCons rather than to
ProtoBCOs. A ProtoStaticCon gets allocated directly as a data con
application on the heap (using the new primop newConApp#).
Previously, we would allocate a ProtoBCO which, when evaluated, would
PACK and return the constructor.
A few more details are given in Note [Static constructors in Bytecode].
Secondly, this commit also fixes issue #25636 which was caused by
linking *unlifted* constructors in BCO instructions as
- (1) a thunk indexing the array of BCOs in a module
- (2) which evaluated to a BCO which still had to be evaluated to
return the unlifted constructor proper.
The (2) issue has been resolved by allocating the static constructors
directly. The (1) issue can be resolved by ensuring that we allocate all
unlifted top-level constructors eagerly, and leave the knot-tying for
the lifted BCOs and top-level constructors only.
The top-level unlifted constructors are never mutually recursive, so we
can allocate them all in one go as long as we do it in topological
order. Lifted fields of unlifted constructors can still be filled by the
knot-tied lifted variables since in those fields it is fine to keep
those thunks. See Note [Tying the knot in createBCOs] for more details.
Fixes #25636
-------------------------
Metric Decrease:
LinkableUsage01
-------------------------
- - - - -
cde47053 by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
Revert "StgToByteCode: Assert that PUSH_G'd values are lifted"
This reverts commit ec26c54d818e0cd328276196930313f66b780905.
Ever since f7a22c0f4e9ae0dc767115d4c53fddbd8372b777, we now do support
and will link top-level unlifted constructors into evaluated and
properly tagged values which we can reference with PUSH_G.
This assertion is no longer true and triggered a failure in T25636
- - - - -
c7a7e5b8 by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
refactor: Tag more remote Ptrs as RemotePtr
Pure refactor which improves the API of
- GHC.ByteCode.Linker
- GHC.Runtime.Interpreter
- GHC.Runtime.Interpreter.Types.SymbolCache
by using `RemotePtr` for more functions which used to return `Ptr`s that
could potentially be in a foreign process. E.g. `lookupIE`,
`lookupStaticPtr`, etc...
- - - - -
fc59494c by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
Add float# and subword tests for #25636
These tests cover that static constructors in bytecode work correctly
for Float# and subword values (Word8#, Word16#)
- - - - -
477f521b by Rodrigo Mesquita at 2026-04-14T18:41:12-04:00
test: Validate topoSort logic in createBCOs
This test validates that the topological sorting and ordering of the
unlifted constructors and lifted constructors in `createBCOs` is
correct.
See `Note [Tying the knot in createBCOs]` for why tying the knot for the
created BCOs is slightly difficult and why the topological sorting is
necessary.
This test fails when `let topoSortedObjs = topSortObjs objs` is
substituted by `let topoSortedObjs = zip [0..] objs`, thus witnessing
the toposort logic is correct and necessary.
The test calls the ghci `createBCOs` directly because it is currently
impossible to construct in Source Haskell a situation where a top-level
static unlifted constructor depends on another (we don't have top-level
unlifted constructors except for nullary constructors like `Leaf ::
(UTree :: UnliftedType)`).
This is another test for fix for #25636
- - - - -
2d9c30be by Simon Jakobi at 2026-04-14T18:42:00-04:00
Improve tests for `elem`
...in order to simplify the work on #27096.
* Improve T17752 by including the Core output in golden files, checking
both -O1 and -O2.
* Add tests for fusion and no-fusion cases.
Fixes #27101.
- - - - -
909d52a4 by fendor at 2026-04-15T11:45:50+02:00
Expose startupHpc as an rts symbol
- - - - -
1ff995c5 by fendor at 2026-04-15T11:48:16+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
If we didn't register the hpc module in this way, evaluating a bytecode object
instrumented with `-fhpc` without registering it in the `hpc` run-time will
simply not generate any `.tix` files for this bytecode object.
However, this shouldn't happen if everything is set up correctly.
Closes #27036
- - - - -
118 changed files:
- + changelog.d/T25636
- + changelog.d/bytecode-interpreter-hpc-support
- + changelog.d/fix-duplicate-pmc-warnings
- + changelog.d/fix-ghci-duplicate-warnings-26233
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Liveness.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types/SymbolCache.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- docs/users_guide/packages.rst
- + libraries/base/tests/perf/ElemFusionUnknownList.hs
- + libraries/base/tests/perf/ElemFusionUnknownList_O1.stderr
- + libraries/base/tests/perf/ElemFusionUnknownList_O2.stderr
- + libraries/base/tests/perf/ElemNoFusion.hs
- + libraries/base/tests/perf/ElemNoFusion_O1.stderr
- + libraries/base/tests/perf/ElemNoFusion_O2.stderr
- − libraries/base/tests/perf/Makefile
- libraries/base/tests/perf/T17752.hs
- − libraries/base/tests/perf/T17752.stdout
- + libraries/base/tests/perf/T17752_O1.stderr
- + libraries/base/tests/perf/T17752_O2.stderr
- libraries/base/tests/perf/all.T
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/Rts.h
- rts/include/rts/Bytecodes.h
- rts/include/rts/storage/ClosureMacros.h
- rts/include/stg/MiscClosures.h
- testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.hs
- + testsuite/tests/codeGen/should_run/T23146/T25636.script
- + testsuite/tests/codeGen/should_run/T23146/T25636.stdout
- testsuite/tests/codeGen/should_run/T23146/all.T
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.script
- + testsuite/tests/codeGen/should_run/T25636a/T25636a.stdout
- + testsuite/tests/codeGen/should_run/T25636a/all.T
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.script
- + testsuite/tests/codeGen/should_run/T25636b/T25636b.stdout
- + testsuite/tests/codeGen/should_run/T25636b/all.T
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.script
- + testsuite/tests/codeGen/should_run/T25636c/T25636c.stdout
- + testsuite/tests/codeGen/should_run/T25636c/all.T
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.script
- + testsuite/tests/codeGen/should_run/T25636d/T25636d.stdout
- + testsuite/tests/codeGen/should_run/T25636d/all.T
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.script
- + testsuite/tests/codeGen/should_run/T25636e/T25636e.stdout
- + testsuite/tests/codeGen/should_run/T25636e/all.T
- + testsuite/tests/deSugar/should_compile/T25996.hs
- + testsuite/tests/deSugar/should_compile/T25996.stderr
- testsuite/tests/deSugar/should_compile/all.T
- testsuite/tests/ghci.debugger/scripts/print034.stdout
- + testsuite/tests/ghci/should_run/T25636f.hs
- + testsuite/tests/ghci/should_run/T25636f.stdout
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/hpc/Makefile
- testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout
- + testsuite/tests/hpc/T17073b.stdout
- testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout
- + testsuite/tests/hpc/T20568b.stdout
- testsuite/tests/hpc/all.T
- testsuite/tests/hpc/fork/Makefile
- testsuite/tests/hpc/function/Makefile
- testsuite/tests/hpc/function/test.T
- + testsuite/tests/hpc/function/tough1.stderr
- + testsuite/tests/hpc/function/tough1.stdout
- testsuite/tests/hpc/function2/test.T
- + testsuite/tests/hpc/function2/tough3.script
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
- testsuite/tests/hpc/hpcrun.pl
- testsuite/tests/hpc/simple/Makefile
- + testsuite/tests/hpc/simple/hpc002.hs
- + testsuite/tests/hpc/simple/hpc002.stdout
- + testsuite/tests/hpc/simple/hpc003.hs
- + testsuite/tests/hpc/simple/hpc003.script
- + testsuite/tests/hpc/simple/hpc003.stdout
- testsuite/tests/hpc/simple/test.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9e7c293fd582df0b24b40c024b864…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9e7c293fd582df0b24b40c024b864…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Simplify mkTick
by Marge Bot (＠marge-bot) 15 Apr '26
by Marge Bot (＠marge-bot) 15 Apr '26
15 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
2b122956 by sheaf at 2026-04-15T05:23:00-04:00
Simplify mkTick
This commit simplifies 'GHC.Core.Utils.mkTick', removing the
accumulating parameter 'rest' which was suspiciously treating a bunch of
different ticks as a group, and moving the group as a whole around the
AST, ignoring that the ticks in the group might have different placement
properties.
The most important change is that we revert the logic (added in 85b0aae2)
that allowed ticks to be placed around coercions, which caused serious
issues (e.g. #27121). It was just a mistake, as it doesn't make sense
to put a tick around a coercion.
Also adds Note [Pushing SCCs inwards] which clarifies the logic for
pushing SCCs into lambdas, constructor applications, and dropping SCCs
around non-function variables (in particular the treatment of splittable
ticks).
A few other changes are also implemented:
- simplify 'can_split' predicate (no functional change)
- combine profiling ticks into one when possible
Fixes #26878, #26941 and #27121
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
c2b49fed by Wolfgang Jeltsch at 2026-04-15T05:23:01-04:00
Move most of the `System.IO` implementation into `base`
This involves a rewrite of the `combine` helper function to avoid the
use of `last`, which would now be flagged as an error.
Metric Increase:
T12227
T12707
T5642
- - - - -
3b20030f by Simon Jakobi at 2026-04-15T05:23:04-04:00
Add regression test for #9074
Closes #9074.
- - - - -
72809b07 by Sylvain Henry at 2026-04-15T05:23:12-04:00
Add changelog for #15973
- - - - -
46037ee9 by sheaf at 2026-04-15T05:23:17-04:00
Deal with 'noSpec' in 'coreExprToPmLit'
This commit makes two separate changes relating to
'GHC.HsToCore.Pmc.Solver.Types.coreExprAsPmLit':
1. Commit 7124e4ad mistakenly marked deferred errors as non-canonical,
which led to the introduction of 'nospec' wrappers in the
generated Core. This reverts that accident by declaring deferred
errors as being canonical, avoiding spurious 'nospec' wrapping.
2. Look through magic identity-like Ids such as 'nospec', 'inline' and
'lazy' in 'coreExprAsPmLit', just like Core Prep does.
There might genuinely be incoherent evidence, but that shouldn't
obstruct the pattern match checker. See test T27124a.
Fixes #25926 #27124
- - - - -
57 changed files:
- + changelog.d/T15973
- + changelog.d/T27121.md
- + changelog.d/T27124.md
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Types/Tickish.hs
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-heap/tests/tso_and_stack_closures.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- + testsuite/tests/ghci/T9074/Makefile
- + testsuite/tests/ghci/T9074/T9074.hs
- + testsuite/tests/ghci/T9074/T9074.stdout
- + testsuite/tests/ghci/T9074/T9074a.c
- + testsuite/tests/ghci/T9074/T9074b.c
- + testsuite/tests/ghci/T9074/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/overloadedstrings/should_fail/T25926.hs
- + testsuite/tests/overloadedstrings/should_fail/T25926.stderr
- + testsuite/tests/overloadedstrings/should_fail/T27124.hs
- + testsuite/tests/overloadedstrings/should_fail/T27124.stderr
- + testsuite/tests/overloadedstrings/should_fail/all.T
- + testsuite/tests/overloadedstrings/should_run/T27124a.hs
- testsuite/tests/overloadedstrings/should_run/all.T
- + testsuite/tests/profiling/should_compile/T27121.hs
- + testsuite/tests/profiling/should_compile/T27121_aux.hs
- testsuite/tests/profiling/should_compile/all.T
- + testsuite/tests/simplCore/should_compile/T26941.hs
- + testsuite/tests/simplCore/should_compile/T26941_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7b06ecadde9030ecc02bd780beb17…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7b06ecadde9030ecc02bd780beb17…
You're receiving this email because of your account on gitlab.haskell.org.
1
0