- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/26737] Make the implicit-parameter class have representational role
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/26737 at Glasgow Haskell Compiler / GHC Commits: 1a4d0a62 by Simon Peyton Jones at 2026-01-15T17:11:36+00:00 Make the implicit-parameter class have representational role This MR addresses #26737, by making the built-in class IP have a representational role for its second parameter. See Note [IP: implicit parameter class] in ghc-internal:GHC.Internal.Classes.IP In fact, IP is (unfortunately, currently) exposed by base:GHC.Base, so we ran a quick CLC proposal to agree the change: https://github.com/haskell/core-libraries-committee/issues/385 Some (small) compilations get faster because they only need to load (small) interface file GHC.Internal.Classes.IP.hi, rather than (large) GHC.Internal.Classes.hi, Metric Decrease: T10421 T12150 T12425 T24582 T5837 - - - - - 10 changed files: - compiler/GHC/Builtin/Names.hs - docs/users_guide/9.16.1-notes.rst - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Classes.hs - + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/th/TH_implicitParams.stdout - + testsuite/tests/typecheck/should_compile/T26737.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -526,7 +526,7 @@ genericTyConNames = [ gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module + gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic") gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types") @@ -534,6 +534,7 @@ gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic") gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict") gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString") gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes") +gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP") gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers") gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple") @@ -1521,7 +1522,7 @@ fromLabelClassOpName -- Implicit Parameters ipClassName :: Name ipClassName - = clsQual gHC_CLASSES (fsLit "IP") ipClassKey + = clsQual gHC_CLASSES_IP (fsLit "IP") ipClassKey -- Overloaded record fields hasFieldClassName :: Name ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -30,6 +30,18 @@ Language - The extension :extension:`ExplicitNamespaces` now allows namespace-specified wildcards ``type ..`` and ``data ..`` in import and export lists. +- Implicit parameters and ``ImpredicativeTypes``. GHC now knows + that if ``?foo::S`` is coecible to ``?foo::T`` only if ``S`` is coercible to ``T``. + Example (from :ghc-ticket:`#26737`):: + + {-# LANGUAGE ImplicitParams, ImpredicativeTypes #-} + newtype N = MkN Int + test :: ((?foo::N) => Bool) -> ((?foo::Int) => Bool) + test = coerce + + This is achieved by arranging that ``?foo :: T`` has a representational + role for ``T``. + Compiler ~~~~~~~~ ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -343,6 +343,7 @@ Library GHC.Internal.CString GHC.Internal.Classes + GHC.Internal.Classes.IP GHC.Internal.Debug GHC.Internal.Magic GHC.Internal.Magic.Dict ===================================== libraries/ghc-internal/src/GHC/Internal/Classes.hs ===================================== @@ -1,10 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, KindSignatures, DataKinds, ConstraintKinds, - MultiParamTypeClasses, FunctionalDependencies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic + MultiParamTypeClasses, FunctionalDependencies, + UnboxedTuples #-} + {-# LANGUAGE UndecidableSuperClasses #-} -- Because of the type-variable superclasses for tuples @@ -142,6 +141,7 @@ import GHC.Internal.Prim import GHC.Internal.Tuple import GHC.Internal.CString (unpackCString#) import GHC.Internal.Types +import GHC.Internal.Classes.IP infix 4 ==, /=, <, <=, >=, > infixr 3 && @@ -149,12 +149,6 @@ infixr 2 || default () -- Double isn't available yet --- | The syntax @?x :: a@ is desugared into @IP "x" a@ --- IP is declared very early, so that libraries can take --- advantage of the implicit-call-stack feature -class IP (x :: Symbol) a | x -> a where - ip :: a - {- $matching_overloaded_methods_in_rules Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit ===================================== libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs ===================================== @@ -0,0 +1,87 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, + KindSignatures, DataKinds, ConstraintKinds, + MultiParamTypeClasses, FunctionalDependencies #-} + +{-# LANGUAGE AllowAmbiguousTypes, RoleAnnotations, IncoherentInstances #-} + -- LANGUAGE pragmas: see Note [IP: implicit parameter class] + +{-# OPTIONS_HADDOCK not-home #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Internal.Classes.IP +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : ghc-devs(a)haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Basic classes. +-- Do not import this module directly. It is an GHC internal only +-- module. Some of its contents are instead available from @Prelude@ +-- and @GHC.Int@. +-- +----------------------------------------------------------------------------- + +module GHC.Internal.Classes.IP( IP(..)) where + +import GHC.Internal.Types + + +default () -- Double isn't available yet + +-- | The syntax @?x :: a@ is desugared into @IP "x" a@ +-- IP is declared very early, so that libraries can take +-- advantage of the implicit-call-stack feature +type role IP nominal representational -- See (IPRoles) +class IP (x :: Symbol) a | x -> a where + ip :: a + +{- Note [IP: implicit parameter class] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An implicit parameter constraint (?foo::ty) is just short for + + IP "foo" ty + +where ghc-internal:GHC.Internal.Classes.IP is a special class that +GHC knows about, defined in this module. + +* It is a unary type class, with one method `ip`, so it has no cost. + For example, (?foo::Int) is represented just by an Int. + +* Criticially, it has a functional dependency: + class IP (x :: Symbol) a | x -> a where ... + So if we have + [G] IP "foo" Int + [W] IP "foo" alpha + the fundep wil lgive us alpha ~ Int, as desired. + +* The solver has a number of special cases for implicit parameters, + mainly because a binding (let ?foo::Int = rhs in body) + is like a local instance declaration for IP. Search for uses + of `isIPClass`. + +Wrinkles + +(IPAmbiguity) The single method of IP has an ambiguous type + ip :: forall a. IP s a => a + Hence the LANGUAGE pragama AllowAmbiguousTypes. + The method `ip` is never called by the user, so ambiguity doesn't matter. + +(IPRoles) IP has a role annotation. Why? See #26737. We want + [W] IP "foo" t1 ~R# IP "foo" t2 + to decompose to give [W] IP t1 ~R# t2, using /representational/ + equality for (t1 ~R# t2) not nominal. + + This usually gives a complaint about incoherence, because in general + (t1 ~R# t2) does NOT imply (C t1) ~R# (C t2) for any normal class. + But it does for IP, because instance selection is controlled by the Symbol, + not the type of the payload. Hence LANGUAGE pragma IncoherentInstances. + (It is unfortunate that we need a module-wide IncoherentInstances here; + see #17167.) + + Side note: arguably this treatment could be applied to any class + with a functional dependency; but for now we restrict it to IP. +-} + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -3293,6 +3293,7 @@ module GHC.Base where {-# MINIMAL fmap #-} type IO :: * -> * newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) + type role IP nominal representational type IP :: Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -1171,6 +1171,7 @@ module GHC.Classes where (==) :: a -> a -> GHC.Internal.Types.Bool (/=) :: a -> a -> GHC.Internal.Types.Bool {-# MINIMAL (==) | (/=) #-} + type role IP nominal representational type IP :: GHC.Internal.Types.Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/th/TH_implicitParams.stdout ===================================== @@ -1,5 +1,5 @@ -Main.funcToReify :: GHC.Internal.Classes.IP "z" - GHC.Internal.Types.Int => +Main.funcToReify :: GHC.Internal.Classes.IP.IP "z" + GHC.Internal.Types.Int => GHC.Internal.Types.Int 5 1 ===================================== testsuite/tests/typecheck/should_compile/T26737.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ImpredicativeTypes, ImplicitParams #-} + +module T26737 where + +import Data.Coerce + +newtype Foo = MkFoo Int + +b :: ((?foo :: Foo) => Int) -> ((?foo :: Int) => Int) +b = coerce @(((?foo :: Foo) => Int)) @(((?foo :: Int) => Int)) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -957,3 +957,4 @@ test('T17705', normal, compile, ['']) test('T14745', normal, compile, ['']) test('T26451', normal, compile, ['']) test('T26582', normal, compile, ['']) +test('T26737', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a4d0a62ef45018d39bfca40ea81085… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a4d0a62ef45018d39bfca40ea81085… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mp/9.10.1-memory-backports] Migrate `Finder` component to `OsPath`, fixed #24616
by Matthew Pickering (＠mpickering) 15 Jan '26

15 Jan '26

Matthew Pickering pushed to branch wip/mp/9.10.1-memory-backports at Glasgow Haskell Compiler / GHC Commits: c0cce5dc by Fendor at 2026-01-06T12:35:56+00:00 Migrate `Finder` component to `OsPath`, fixed #24616 For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsulated, this requires only a minimal amount of changes in other modules. We introduce pattern synonym for 'ModLocation' which maintains backwards compatibility and avoids breaking consumers of 'ModLocation'. - - - - - 20 changed files: - compiler/GHC.hs - compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/MakeFile/JSON.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables #-} {-# LANGUAGE TupleSections, NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE LambdaCase #-} @@ -79,6 +78,7 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + pattern ModLocation, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -12,10 +12,14 @@ module GHC.Data.OsPath , (</>) , (<.>) , splitSearchPath + , splitExtension , isRelative + , makeRelative + , normalise , dropTrailingPathSeparator , takeDirectory - , isSuffixOf + , OS.isSuffixOf + , OS.drop , doesDirectoryExist , doesFileExist , getDirectoryContents @@ -31,8 +35,11 @@ import GHC.Utils.Outputable qualified as Outputable import GHC.Utils.Panic (panic) import System.OsPath -import System.OsString (isSuffixOf) +import qualified System.OsString as OS (isSuffixOf, drop) import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing) +import GHC.Utils.Panic (panic) + +import System.OsPath import System.Directory.Internal (os) -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,8 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - -- Not used at the moment: -- -- Either(Left, Right), @@ -18,6 +18,7 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) + import Control.Applicative import Data.Semigroup import Data.Data @@ -29,6 +30,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf, os) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.OsPath as OsPath @@ -779,7 +780,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs </> moduleNameSlashes mod_name) (os "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -863,12 +864,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs </> + (unsafeEncodeUtf $ unpackFS unit_fs </> moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> os "hsig" + HsBootFile -> os "hs-boot" + HsSrcFile -> os "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath (unsafeDecodeUtf) import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -8,27 +8,27 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2123,12 +2124,13 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = OsPathModLocation + { ml_hs_file_ospath = Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ospath = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ospath = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ospath = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ospath = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ospath = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2362,12 +2364,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = OsPathModLocation + { ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = panic "hsDeclsWithLocation:ml_hi_file_ospath", + ml_obj_file_ospath = panic "hsDeclsWithLocation:ml_obj_file_ospath", + ml_dyn_obj_file_ospath = panic "hsDeclsWithLocation:ml_dyn_obj_file_ospath", + ml_dyn_hi_file_ospath = panic "hsDeclsWithLocation:ml_dyn_hi_file_ospath", + ml_hie_file_ospath = panic "hsDeclsWithLocation:ml_hie_file_ospath" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2647,12 +2650,13 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = OsPathModLocation + { ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = panic "hscCompileCoreExpr':ml_hi_file_ospath", + ml_obj_file_ospath = panic "hscCompileCoreExpr':ml_obj_file_ospath", + ml_dyn_obj_file_ospath = panic "hscCompileCoreExpr': ml_obj_file_ospath", + ml_dyn_hi_file_ospath = panic "hscCompileCoreExpr': ml_dyn_hi_file_ospath", + ml_hie_file_ospath = panic "hscCompileCoreExpr':ml_hie_file_ospath" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -1915,7 +1916,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1924,8 +1925,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ospath ms_location, ml_dyn_hi_file_ospath ms_location) + , (ml_obj_file_ospath ms_location, ml_dyn_obj_file_ospath ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1934,10 +1935,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ospath = hi_file + , ml_obj_file_ospath = o_file + , ml_dyn_hi_file_ospath = dyn_hi_file + , ml_dyn_obj_file_ospath = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2123,7 +2124,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -32,6 +32,8 @@ import GHC.Driver.Pipeline.Monad (PipelineOutput (NoOutputFile)) import GHC.Driver.Session (pgm_F) import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf, OsPath, OsString) +import qualified GHC.Data.OsPath as OS import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -243,15 +245,15 @@ processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode updateJson m_dep_json (updateDepJSON include_pkg_deps pp dep_node deps) writeDependencies include_pkg_deps root hdl extra_suffixes dep_node deps where - extra_suffixes = depSuffixes dflags + extra_suffixes = map OS.os (depSuffixes dflags) include_pkg_deps = depIncludePkgDeps dflags - src_file = msHsFilePath node + src_file = msHsFileOsPath node dep_node = DepNode { dn_mod = ms_mod node, dn_src = src_file, - dn_obj = msObjFilePath node, - dn_hi = msHiFilePath node, + dn_obj = msObjFileOsPath node, + dn_hi = msHiFileOsPath node, dn_boot = isBootSummary node, dn_options = Set.fromList (ms_opts node) } @@ -285,7 +287,7 @@ processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode cpp_deps = do session <- Session <$> newIORef hsc_env parsedMod <- reflectGhc (GHC.parseModule node) session - pure (DepCpp <$> GHC.pm_extra_src_files parsedMod) + pure (DepCpp . OS.os <$> GHC.pm_extra_src_files parsedMod) -- Emit a dependency for each import import_deps is_boot idecls = @@ -309,7 +311,7 @@ findDependency hsc_env srcloc pkg imp dep_boot = do Found loc dep_mod -> pure DepHi { dep_mod, - dep_path = ml_hi_file loc, + dep_path = ml_hi_file_ospath loc, dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod), dep_local, dep_boot @@ -329,7 +331,7 @@ writeDependencies :: Bool -> FilePath -> Handle -> - [FilePath] -> + [OsString] -> DepNode -> [Dep] -> IO () @@ -373,7 +375,7 @@ writeDependencies include_pkgs root hdl suffixes node deps = DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node ----------------------------- -writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO () +writeDependency :: FilePath -> Handle -> [OsPath] -> OsPath -> IO () -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency -- t1 t2 : dep writeDependency root hdl targets dep @@ -381,25 +383,25 @@ writeDependency root hdl targets dep -- c:/foo/... -- on cygwin as make gets confused by the : -- Making relative deps avoids some instances of this. - dep' = makeRelative root dep - forOutput = escapeSpaces . reslash Forwards . normalise + dep' = OS.makeRelative (OS.os root) dep + forOutput = escapeSpaces . reslash Forwards . unsafeDecodeUtf . OS.normalise output = unwords (map forOutput targets) ++ " : " ++ forOutput dep' hPutStrLn hdl output ----------------------------- insertSuffixes - :: FilePath -- Original filename; e.g. "foo.o" - -> [String] -- Suffix prefixes e.g. ["x_", "y_"] - -> [FilePath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] + :: OsPath -- Original filename; e.g. "foo.o" + -> [OsString] -- Suffix prefixes e.g. ["x_", "y_"] + -> [OsPath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] -- Note that the extra bit gets inserted *before* the old suffix -- We assume the old suffix contains no dots, so we know where to -- split it insertSuffixes file_name extras - = [ basename <.> (extra ++ suffix) | extra <- extras ] + = [ basename OS.<.> (extra `mappend` suffix) | extra <- extras ] where - (basename, suffix) = case splitExtension file_name of + (basename, suffix) = case OS.splitExtension file_name of -- Drop the "." from the extension - (b, s) -> (b, drop 1 s) + (b, s) -> (b, OS.drop 1 s) ----------------------------------------------------------------- ===================================== compiler/GHC/Driver/MakeFile/JSON.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Unit import GHC.Utils.Json import GHC.Utils.Misc import GHC.Utils.Outputable -import System.FilePath (normalise) +import GHC.Data.OsPath -------------------------------------------------------------------------------- -- Output helpers @@ -92,9 +92,9 @@ writeJsonOutput = data DepNode = DepNode { dn_mod :: Module, - dn_src :: FilePath, - dn_obj :: FilePath, - dn_hi :: FilePath, + dn_src :: OsPath, + dn_obj :: OsPath, + dn_hi :: OsPath, dn_boot :: IsBootInterface, dn_options :: Set.Set String } @@ -102,14 +102,14 @@ data DepNode = data Dep = DepHi { dep_mod :: Module, - dep_path :: FilePath, + dep_path :: OsPath, dep_unit :: Maybe UnitInfo, dep_local :: Bool, dep_boot :: IsBootInterface } | DepCpp { - dep_path :: FilePath + dep_path :: OsPath } -------------------------------------------------------------------------------- @@ -125,10 +125,10 @@ instance Semigroup PackageDeps where data Deps = Deps { - sources :: Set.Set FilePath, + sources :: Set.Set OsPath, modules :: (Set.Set ModuleName, Set.Set ModuleName), packages :: PackageDeps, - cpp :: Set.Set FilePath, + cpp :: Set.Set OsPath, options :: Set.Set String, preprocessor :: Maybe FilePath } @@ -141,7 +141,7 @@ instance ToJson DepJSON where json (DepJSON m) = JSObject [ (moduleNameString target, JSObject [ - ("sources", array sources normalise), + ("sources", array sources (unsafeDecodeUtf . normalise)), ("modules", array (fst modules) moduleNameString), ("modules-boot", array (snd modules) moduleNameString), ("packages", @@ -150,7 +150,7 @@ instance ToJson DepJSON where ((name, unit_id, package_id), mods) <- Map.toList packages ] ), - ("cpp", array cpp id), + ("cpp", array cpp unsafeDecodeUtf), ("options", array options id), ("preprocessor", maybe JSNull JSString preprocessor) ]) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -772,7 +773,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -784,11 +785,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ospath = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -802,10 +803,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ospath = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -43,6 +43,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -52,7 +55,6 @@ import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -64,8 +66,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -74,9 +75,10 @@ import GHC.Driver.Env import GHC.Driver.Config.Finder import GHC.Unit.Module.Graph (mgHomeModuleMap, ModuleNameHomeMap) import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsString -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -329,7 +331,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -400,7 +402,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -425,7 +427,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -461,17 +463,17 @@ findInstalledHomeModule fc fopts home_unit mod_name = do hi_dir_path = case finder_hiDir fopts of Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp </> hiDir] + Nothing -> [hiDir] + Just fp -> [fp </> hiDir] Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (os "hs", mkHomeModLocationSearched fopts mod_name $ os "hs") + , (os "lhs", mkHomeModLocationSearched fopts mod_name $ os "lhs") + , (os "hsig", mkHomeModLocationSearched fopts mod_name $ os "hsig") + , (os "lhsig", mkHomeModLocationSearched fopts mod_name $ os "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -496,10 +498,11 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps - | otherwise = (work_dir </> fp) : augmentImports work_dir fps +augmentImports work_dir (fp:fps) + | OsPath.isAbsolute fp = fp : augmentImports work_dir fps + | otherwise = (work_dir </> fp) : augmentImports work_dir fps -- | Search for a module in external packages only. findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult @@ -531,14 +534,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = os "hi" + | otherwise = os (tag ++ "_hi") - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = os $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -546,7 +549,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -555,24 +558,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( - FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + FileExt, -- suffix + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == os "." = basename | otherwise = path </> basename file = base <.> ext ] @@ -586,7 +589,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path </> basename) suff @@ -624,18 +627,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> FileExt -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -643,51 +646,51 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (OsPathModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext), + ml_hi_file_ospath = hi_fn, + ml_dyn_hi_file_ospath = dyn_hi_fn, + ml_obj_file_ospath = obj_fn, + ml_dyn_obj_file_ospath = dyn_obj_fn, + ml_hie_file_ospath = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path </> basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path </> basename) mempty + in loc { ml_hs_file_ospath = Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> FileExt -> FileExt -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path </> basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, - -- Remove the .hi-boot suffix from - -- hi_file, if it had one. We always - -- want the name of the real .hi file - -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, - -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + in OsPathModLocation{ ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = full_basename <.> hisuf, + -- Remove the .hi-boot suffix from + -- hi_file, if it had one. We always + -- want the name of the real .hi file + -- in the ml_hi_file field. + ml_dyn_obj_file_ospath = dyn_obj_fn, + -- MP: TODO + ml_dyn_hi_file_ospath = full_basename <.> dynhisuf, + ml_obj_file_ospath = obj_fn, + ml_hie_file_ospath = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkObjPath fopts basename mod_basename = obj_basename <.> osuf where odir = finder_objectDir fopts @@ -700,9 +703,9 @@ mkObjPath fopts basename mod_basename = obj_basename <.> osuf -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts @@ -716,9 +719,9 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts @@ -731,9 +734,9 @@ mkHiPath fopts basename mod_basename = hi_basename <.> hisuf -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts @@ -746,9 +749,9 @@ mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts @@ -769,23 +772,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ expectJust "mkStubPaths" + (ml_hs_file_ospath location) stub_basename0 | Just dir <- stubdir = dir </> mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` os "_stub" in - stub_basename <.> "h" + stub_basename <.> os "h" -- ----------------------------------------------------------------------------- -- findObjectLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import GHC.Data.OsPath import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -31,7 +32,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +71,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +89,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Maybe OsPath + , finder_hieSuf :: OsString + , finder_hiDir :: Maybe OsPath + , finder_hiSuf :: OsString + , finder_dynHiSuf :: OsString + , finder_objectDir :: Maybe OsPath + , finder_objectSuf :: OsString + , finder_dynObjectSuf :: OsString + , finder_stubDir :: Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -1,6 +1,17 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | Module location module GHC.Unit.Module.Location - ( ModLocation(..) + ( ModLocation + ( .. + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file + ) + , pattern ModLocation , addBootSuffix , addBootSuffix_maybe , addBootSuffixLocn_maybe @@ -11,15 +22,19 @@ module GHC.Unit.Module.Location where import GHC.Prelude + +import GHC.Data.OsPath import GHC.Unit.Types import GHC.Utils.Outputable +import qualified System.OsString as OsString + -- | Module Location -- -- Where a module lives on the file system: the actual locations -- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them. -- --- For a module in another unit, the ml_hs_file and ml_obj_file components of +-- For a module in another unit, the ml_hs_file_ospath and ml_obj_file_ospath components of -- ModLocation are undefined. -- -- The locations specified by a ModLocation may or may not @@ -38,31 +53,31 @@ import GHC.Utils.Outputable -- boot suffixes in mkOneShotModLocation. data ModLocation - = ModLocation { - ml_hs_file :: Maybe FilePath, + = OsPathModLocation { + ml_hs_file_ospath :: Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ospath :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ospath :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ospath :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ospath :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ospath :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,18 +86,18 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` os "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files -removeBootSuffix :: FilePath -> FilePath -removeBootSuffix "-boot" = [] -removeBootSuffix (x:xs) = x : removeBootSuffix xs -removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" - +removeBootSuffix :: OsPath -> OsPath +removeBootSuffix pathWithBootSuffix = + case OsString.stripSuffix (os "-boot") pathWithBootSuffix of + Just path -> path + Nothing -> error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +110,50 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) + , ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn) + , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn) + , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn) + , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn) + , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn) + , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn) + , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn) + , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn) + , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) } - +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation +pattern ModLocation + { ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file + } <- OsPathModLocation + { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file) + , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file) + , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file) + , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file) + , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file) + , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file) + } where + ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file + = OsPathModLocation + { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file + , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file + , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file + , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file + , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file + , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file + } ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -17,6 +17,11 @@ module GHC.Unit.Module.ModSummary , msHsFilePath , msObjFilePath , msDynObjFilePath + , msHsFileOsPath + , msHiFileOsPath + , msDynHiFileOsPath + , msObjFileOsPath + , msDynObjFileOsPath , msDeps , isBootSummary , findTarget @@ -38,6 +43,7 @@ import GHC.Types.Target import GHC.Types.PkgQual import GHC.Data.Maybe +import GHC.Data.OsPath (OsPath) import GHC.Data.StringBuffer ( StringBuffer ) import GHC.Utils.Fingerprint @@ -148,6 +154,13 @@ msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms) msObjFilePath ms = ml_obj_file (ms_location ms) msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms) +msHsFileOsPath, msDynHiFileOsPath, msHiFileOsPath, msObjFileOsPath, msDynObjFileOsPath :: ModSummary -> OsPath +msHsFileOsPath ms = expectJust "msHsFilePath" (ml_hs_file_ospath (ms_location ms)) +msHiFileOsPath ms = ml_hi_file_ospath (ms_location ms) +msDynHiFileOsPath ms = ml_dyn_hi_file_ospath (ms_location ms) +msObjFileOsPath ms = ml_obj_file_ospath (ms_location ms) +msDynObjFileOsPath ms = ml_dyn_obj_file_ospath (ms_location ms) + -- | Did this 'ModSummary' originate from a hs-boot file? isBootSummary :: ModSummary -> IsBootInterface isBootSummary ms = if ms_hsc_src ms == HsBootFile then IsBoot else NotBoot ===================================== compiler/ghc.cabal.in ===================================== @@ -117,6 +117,7 @@ Library filepath >= 1 && < 1.6, os-string >= 2.0.1 && < 2.1, template-haskell == 2.22.*, + os-string >= 2.0.1 && < 2.1, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -36,7 +36,7 @@ Executable ghc bytestring >= 0.9 && < 0.13, directory >= 1 && < 1.4, process >= 1 && < 1.7, - filepath >= 1 && < 1.6, + filepath >= 1.5 && < 1.6, containers >= 0.5 && < 0.8, transformers >= 0.5 && < 0.7, ghc-boot == @ProjectVersionMunged@, ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -70,6 +70,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Strict ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -71,6 +71,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Strict View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0cce5dcdba013e5a040d5780316570… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0cce5dcdba013e5a040d5780316570… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-try-opt-coercion] 2 commits: Comments only
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: eb6c0cc3 by Simon Peyton Jones at 2026-01-15T14:17:12+00:00 Comments only - - - - - 8a1aa810 by Simon Peyton Jones at 2026-01-15T16:54:19+00:00 Try dropping all optimisation The Simplifier just calls substCo, instead of optCoRefl - - - - - 6 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Literal.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -190,7 +190,7 @@ These data types are the heart of the compiler -- -- See Note [Core binding invariants] -- See Note [Representation polymorphism invariants] --- See Note [Core type and coercion invariant] +-- See Note [Core type and coercion invariants] -- -- * Case expression. Operationally this corresponds to evaluating -- the scrutinee (expression examined) to weak head normal form @@ -449,7 +449,7 @@ OR * Have a RHS that is ok-for-speculation NB: this only applies to /non-recursive/ bindings. For recursive -(or top-level) bindings see Note [Top-level binding invariants]. +(or top-level) bindings see Note [Top/rec binding invariants]. This means that the let can be floated around without difficulty. For example, this is OK: @@ -2122,13 +2122,13 @@ mkLetRec [] body = body mkLetRec bs body = Let (Rec bs) body -- | Create a binding group where a type variable is bound to a type. --- Per Note [Core type and coercion invariant], +-- Per Note [Core type and coercion invariants], -- this can only be used to bind something in a non-recursive @let@ expression mkTyBind :: TyVar -> Type -> CoreBind mkTyBind tv ty = NonRec tv (Type ty) -- | Create a binding group where a type variable is bound to a type. --- Per Note [Core type and coercion invariant], +-- Per Note [Core type and coercion invariants], -- this can only be used to bind something in a non-recursive @let@ expression mkCoBind :: CoVar -> Coercion -> CoreBind mkCoBind cv co = NonRec cv (Coercion co) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -183,7 +183,7 @@ Note [Linting type lets] In the desugarer, it's very very convenient to be able to say (in effect) let a = Type Bool in let x::a = True in <body> -That is, use a type let. See Note [Core type and coercion invariant] in "GHC.Core". +That is, use a type let. See Note [Core type and coercion invariants] in "GHC.Core". One place it is used is in mkWwBodies; see Note [Join points and beta-redexes] in GHC.Core.Opt.WorkWrap.Utils. (Maybe there are other "clients" of this feature; I'm not sure). @@ -582,7 +582,7 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) - -- See Note [Core type and coercion invariant] in GHC.Core + -- See Note [Core type and coercion invariants] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBind import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) -import GHC.Core.Coercion.Opt +-- import GHC.Core.Coercion.Opt import GHC.Core.Reduction import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon @@ -1390,7 +1390,8 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let out_co = optCoRefl (getTCvSubst env) co + = do { let out_co = -- optCoRefl (getTCvSubst env) co + substCo env co ; seqCo out_co `seq` return out_co } ----------------------------------- @@ -3211,7 +3212,7 @@ doCaseToLet :: OutExpr -- Scrutinee -- Can we transform thus? let { b = scrut } in body doCaseToLet scrut case_bndr | isTyCoVar case_bndr -- Respect GHC.Core - = isTyCoArg scrut -- Note [Core type and coercion invariant] + = isTyCoArg scrut -- Note [Core type and coercion invariants] | isUnliftedType (exprType scrut) -- We can call isUnliftedType here: scrutinees always have a fixed RuntimeRep (see FRRCase). ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -610,7 +610,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt | assertPpr (isNonCoVarId in_bndr) (ppr in_bndr) -- The previous two guards got rid of tyvars and coercions - -- See Note [Core type and coercion invariant] in GHC.Core + -- See Note [Core type and coercion invariants] in GHC.Core pre_inline_unconditionally = (env { soe_inl = extendVarEnv inl_env in_bndr clo }, Nothing) @@ -694,7 +694,7 @@ simple_out_bind_pair env@(SOE { soe_subst = subst, soe_opts = opts }) occ_info active stable_unf top_level | assertPpr (isNonCoVarId in_bndr) (ppr in_bndr) -- Type and coercion bindings are caught earlier - -- See Note [Core type and coercion invariant] + -- See Note [Core type and coercion invariants] post_inline_unconditionally = ( env' { soe_subst = extendIdSubst subst in_bndr out_rhs } , Nothing) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -577,7 +577,7 @@ can be eliminated by expanding the synonym. Note [Binding coercions] ~~~~~~~~~~~~~~~~~~~~~~~~ Consider binding a CoVar, c = e. Then, we must satisfy -Note [Core type and coercion invariant] in GHC.Core, +Note [Core type and coercion invariants] in GHC.Core, which allows only (Coercion co) on the RHS. ************************************************************************ @@ -1813,10 +1813,11 @@ exprIsUnaryClassFun _ = False -- See also Note [Classifying primop effects] in "GHC.Builtin.PrimOps" -- and Note [Transformations affected by primop effects]. -- --- 'exprOkForSpeculation' is used in the definition of Note [Nested binding --- invariants]in GHC.Core. It is therefore frequently called on arguments of --- unlifted type, especially via 'needsCaseBinding'. But it is sometimes --- called on expressions of lifted type as well. For example, see +-- 'exprOkForSpeculation' is used in the definition of +-- Note [Nested non-rec binding invariants] in GHC.Core. It is therefore +-- frequently called on arguments of unlifted type, especially via +-- 'needsCaseBinding'. But it is sometimes called on expressions of +-- lifted type as well. For example, see -- Note [Speculative evaluation] in "GHC.CoreToStg.Prep". exprOkForSpeculation, exprOkToDiscard :: CoreExpr -> Bool @@ -2049,7 +2050,7 @@ But we restrict it sharply: DEFAULT -> ... (let v::Int# = case x of { ... } in ...) .... - which does /not/ satisfy Note [Nested non-rec bindings invariants], + which does /not/ satisfy Note [Nested non-rec binding invariants], because x is not evaluated. See Note [Binder-swap during float-out] in GHC.Core.Opt.SetLevels. To avoid this awkwardness it seems simpler to stick to unlifted scrutinees where the issue does not ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -1004,7 +1004,7 @@ data type. Here are the moving parts: levity/runtime-rep polymorphism naturally uphold this invariant. INVARIANT 2: we never make a rubbish literal of type (a ~# b). Reason: - see Note [Core type and coercion invariant] in GHC.Core. We can't substitute + see Note [Core type and coercion invariants] in GHC.Core. We can't substitute a LitRubbish inside a coercion, so it's best not to make one. They are zero width anyway, so passing absent ones around costs nothing. If we wanted an absent filler of type (a ~# b) we should use (Coercion (UnivCo ...)), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e78fe41fd14bcd7b541774bfb5d08… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e78fe41fd14bcd7b541774bfb5d08… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/cygpath] configure: Record cygpath path for use by hls
by Andreas Klebinger (＠AndreasK) 15 Jan '26

15 Jan '26

Andreas Klebinger pushed to branch wip/andreask/cygpath at Glasgow Haskell Compiler / GHC Commits: 16ca0e80 by Andreas Klebinger at 2026-01-15T15:28:11+01:00 configure: Record cygpath path for use by hls Fixes #26683 The M4 macro was initially created by Copilot but then heavily modified by me. - - - - - 5 changed files: - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Oracles/Path.hs - + m4/fp_prog_cygpath.m4 Changes: ===================================== configure.ac ===================================== @@ -833,6 +833,9 @@ dnl ** check for installed alex binary + version AC_ARG_VAR(ALEX,[Use as the path to alex [default=autodetect]]) FPTOOLS_ALEX +dnl ** check for cygpath on windows +FP_PROG_CYGPATH + dnl -------------------------------------------------- dnl ### program checking section ends here ### dnl -------------------------------------------------- ===================================== hadrian/cfg/system.config.in ===================================== @@ -23,6 +23,7 @@ makeinfo = @MAKEINFO@ bourne-shell = @SH@ git = @GIT@ cabal = @CABAL@ +cygpath = @CYGPATH@ # Python 3 is required to run test driver. # See: https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk#L220 ===================================== hadrian/src/Builder.hs ===================================== @@ -163,6 +163,7 @@ data Builder = Alex | Cabal ConfigurationInfo Stage | Cc CcMode Stage | Configure FilePath + | Cygpath | DeriveConstants | GenApply (Maybe Int) -- ^ vector size, or Nothing for non-vectors | GenPrimopCode ===================================== hadrian/src/Hadrian/Oracles/Path.hs ===================================== @@ -13,6 +13,8 @@ import System.Directory import System.Info.Extra import Hadrian.Utilities +import Hadrian.Oracles.TextFile +import Base -- | Lookup a specified 'FilePath' in the system @PATH@. lookupInPath :: FilePath -> Action FilePath @@ -45,7 +47,8 @@ type instance RuleResult WindowsPath = String pathOracle :: Rules () pathOracle = do void $ addOracleCache $ \(WindowsPath path) -> do - Stdout out <- quietly $ cmd ["cygpath", "-m", path] + cygpath <- fromMaybe (error "cygpath not set by configure") <$> lookupValue configFile "cygpath" + Stdout out <- quietly $ cmd [cygpath, "-m", path] let windowsPath = unifyPath $ dropWhileEnd isSpace out putVerbose $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath return windowsPath ===================================== m4/fp_prog_cygpath.m4 ===================================== @@ -0,0 +1,20 @@ +# FP_PROG_CYGPATH +# ---------------- +# Record cygpath path for later use by hls on windows. +AC_DEFUN([FP_PROG_CYGPATH], +[ + if test "$HostOS" == "mingw32"; then + AC_PATH_PROG([CYGPATH_POSIX], [cygpath]) + + if test -z "$CYGPATH_POSIX"; then + AC_MSG_ERROR([cygpath not found; Windows path conversion unavailable]) + CYGPATH="" + else + # Convert the POSIX path of the cygpath executable into a Windows path + CYGPATH=`"$CYGPATH_POSIX" -m "$CYGPATH_POSIX"` + AC_MSG_RESULT([using cygpath at $CYGPATH]) + fi + + AC_SUBST([CYGPATH]) + fi +]) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16ca0e80a54f57d2d85c8bef3c473e3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16ca0e80a54f57d2d85c8bef3c473e3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/cygpath
by Andreas Klebinger (＠AndreasK) 15 Jan '26

15 Jan '26

Andreas Klebinger pushed new branch wip/andreask/cygpath at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/cygpath You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26746] 6 commits: testsuite: remove obsolete --ci option from the testsuite driver
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/T26746 at Glasgow Haskell Compiler / GHC Commits: f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00 testsuite: remove obsolete --ci option from the testsuite driver This patch removes the obsolete `--ci` option from the testsuite driver: neither the CI scripts nor hadrian ever invokes the testsuite driver with `--ci`, and the perf notes are always fetched to the `refs/notes/perf` local reference anyway. - - - - - 7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00 Fix fetch_cabal * download cabal if the existing one is of an older version * fix FreeBSD download url * fix unpacking on FreeBSD - - - - - 6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00 Bump toolchain in CI - - - - - 0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00 Use libffi-clib Previously, we would build libffi via hadrian and bundle it manually with the GHC bindist. This now moves all that logic out of hadrian and allows us to have a clean Haskell package to build and link against and ship it without extra logic. This patch still retains the ability to link against a system libffi. The main reason of bundling libffi was that on some platforms (e.g. FreeBSD and Mac), system libffi is not visible to the C toolchain by default, so users would require settings in e.g. cabal to be able to compile anything. This adds the submodule libffi-clib to the repository. - - - - - 5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00 NCG/LA64: add support for la664 micro architecture Add '-mla664' flag to LA664, which has some new features: atomic instructions, dbar hints, etc. 'LA464' is the default so that unrecognized instructions are not generated. - - - - - 2091ee71 by Simon Peyton Jones at 2026-01-15T14:07:36+00:00 Improve newtype unwrapping Ticket #26746 describes several relatively-minor shortcomings of newtype unwrapping. This MR addresses them, while also (arguably) simplifying the code a bit. See new Note [Solving newtype equalities: overview] and Note [Decomposing newtype equalities] and Note [Eager newtype decomposition] and Note [Even more eager newtype decomposition] For some reason, on Windows only, runtime allocations decrease for test T5205 (from 52k to 48k). I have not idea why. No change at all on Linux. I'm just going to accept the change. (I saw this same effect in another MR so I think it's a fault in the baseline.) Metric Decrease: T5205 - - - - - 48 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Unit/State.hs - docs/users_guide/using.rst - hadrian/hadrian.cabal - hadrian/src/Builder.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - − hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - − libffi-tarballs - + libraries/libffi-clib - packages - rts/include/rts/ghc_ffi.h - rts/rts.buildinfo.in - rts/rts.cabal - testsuite/driver/perf_notes.py - testsuite/tests/deriving/should_fail/T8984.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr - + testsuite/tests/typecheck/should_compile/T26746.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T22924b.stderr - testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs - testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr - testsuite/tests/typecheck/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a01ec3040139b7ad4666e96f8d593… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a01ec3040139b7ad4666e96f8d593… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26737] Make the implicit-parameter class have representational role
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/26737 at Glasgow Haskell Compiler / GHC Commits: eae63c44 by Simon Peyton Jones at 2026-01-15T14:00:56+00:00 Make the implicit-parameter class have representational role This MR addresses #26737, by making the built-in class IP have a representational role for its second parameter. See Note [IP: implicit parameter class] in ghc-internal:GHC.Internal.Classes.IP In fact, IP is (unfortunately, currently) exposed by base:GHC.Base, so we ran a quick CLC proposal to agree the change: https://github.com/haskell/core-libraries-committee/issues/385 For some reason, on Windows only, runtime allocations decrease for test T5205 (from 52k to 48k). I have not idea why. No change at all on Linux. I'm just going to accept the change. Metric Decrease: T5205 - - - - - 10 changed files: - compiler/GHC/Builtin/Names.hs - docs/users_guide/9.16.1-notes.rst - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Classes.hs - + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/th/TH_implicitParams.stdout - + testsuite/tests/typecheck/should_compile/T26737.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -526,7 +526,7 @@ genericTyConNames = [ gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module + gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic") gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types") @@ -534,6 +534,7 @@ gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic") gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict") gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString") gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes") +gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP") gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers") gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple") @@ -1521,7 +1522,7 @@ fromLabelClassOpName -- Implicit Parameters ipClassName :: Name ipClassName - = clsQual gHC_CLASSES (fsLit "IP") ipClassKey + = clsQual gHC_CLASSES_IP (fsLit "IP") ipClassKey -- Overloaded record fields hasFieldClassName :: Name ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -30,6 +30,18 @@ Language - The extension :extension:`ExplicitNamespaces` now allows namespace-specified wildcards ``type ..`` and ``data ..`` in import and export lists. +- Implicit parameters and ``ImpredicativeTypes``. GHC now knows + that if ``?foo::S`` is coecible to ``?foo::T`` only if ``S`` is coercible to ``T``. + Example (from :ghc-ticket:`#26737`):: + + {-# LANGUAGE ImplicitParams, ImpredicativeTypes #-} + newtype N = MkN Int + test :: ((?foo::N) => Bool) -> ((?foo::Int) => Bool) + test = coerce + + This is achieved by arranging that ``?foo :: T`` has a representational + role for ``T``. + Compiler ~~~~~~~~ ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -343,6 +343,7 @@ Library GHC.Internal.CString GHC.Internal.Classes + GHC.Internal.Classes.IP GHC.Internal.Debug GHC.Internal.Magic GHC.Internal.Magic.Dict ===================================== libraries/ghc-internal/src/GHC/Internal/Classes.hs ===================================== @@ -1,10 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, KindSignatures, DataKinds, ConstraintKinds, - MultiParamTypeClasses, FunctionalDependencies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic + MultiParamTypeClasses, FunctionalDependencies, + UnboxedTuples #-} + {-# LANGUAGE UndecidableSuperClasses #-} -- Because of the type-variable superclasses for tuples @@ -142,6 +141,7 @@ import GHC.Internal.Prim import GHC.Internal.Tuple import GHC.Internal.CString (unpackCString#) import GHC.Internal.Types +import GHC.Internal.Classes.IP infix 4 ==, /=, <, <=, >=, > infixr 3 && @@ -149,12 +149,6 @@ infixr 2 || default () -- Double isn't available yet --- | The syntax @?x :: a@ is desugared into @IP "x" a@ --- IP is declared very early, so that libraries can take --- advantage of the implicit-call-stack feature -class IP (x :: Symbol) a | x -> a where - ip :: a - {- $matching_overloaded_methods_in_rules Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit ===================================== libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs ===================================== @@ -0,0 +1,87 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, + KindSignatures, DataKinds, ConstraintKinds, + MultiParamTypeClasses, FunctionalDependencies #-} + +{-# LANGUAGE AllowAmbiguousTypes, RoleAnnotations, IncoherentInstances #-} + -- LANGUAGE pragmas: see Note [IP: implicit parameter class] + +{-# OPTIONS_HADDOCK not-home #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Internal.Classes.IP +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : ghc-devs(a)haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Basic classes. +-- Do not import this module directly. It is an GHC internal only +-- module. Some of its contents are instead available from @Prelude@ +-- and @GHC.Int@. +-- +----------------------------------------------------------------------------- + +module GHC.Internal.Classes.IP( IP(..)) where + +import GHC.Internal.Types + + +default () -- Double isn't available yet + +-- | The syntax @?x :: a@ is desugared into @IP "x" a@ +-- IP is declared very early, so that libraries can take +-- advantage of the implicit-call-stack feature +type role IP nominal representational -- See (IPRoles) +class IP (x :: Symbol) a | x -> a where + ip :: a + +{- Note [IP: implicit parameter class] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An implicit parameter constraint (?foo::ty) is just short for + + IP "foo" ty + +where ghc-internal:GHC.Internal.Classes.IP is a special class that +GHC knows about, defined in this module. + +* It is a unary type class, with one method `ip`, so it has no cost. + For example, (?foo::Int) is represented just by an Int. + +* Criticially, it has a functional dependency: + class IP (x :: Symbol) a | x -> a where ... + So if we have + [G] IP "foo" Int + [W] IP "foo" alpha + the fundep wil lgive us alpha ~ Int, as desired. + +* The solver has a number of special cases for implicit parameters, + mainly because a binding (let ?foo::Int = rhs in body) + is like a local instance declaration for IP. Search for uses + of `isIPClass`. + +Wrinkles + +(IPAmbiguity) The single method of IP has an ambiguous type + ip :: forall a. IP s a => a + Hence the LANGUAGE pragama AllowAmbiguousTypes. + The method `ip` is never called by the user, so ambiguity doesn't matter. + +(IPRoles) IP has a role annotation. Why? See #26737. We want + [W] IP "foo" t1 ~R# IP "foo" t2 + to decompose to give [W] IP t1 ~R# t2, using /representational/ + equality for (t1 ~R# t2) not nominal. + + This usually gives a complaint about incoherence, because in general + (t1 ~R# t2) does NOT imply (C t1) ~R# (C t2) for any normal class. + But it does for IP, because instance selection is controlled by the Symbol, + not the type of the payload. Hence LANGUAGE pragma IncoherentInstances. + (It is unfortunate that we need a module-wide IncoherentInstances here; + see #17167.) + + Side note: arguably this treatment could be applied to any class + with a functional dependency; but for now we restrict it to IP. +-} + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -3293,6 +3293,7 @@ module GHC.Base where {-# MINIMAL fmap #-} type IO :: * -> * newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) + type role IP nominal representational type IP :: Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -1171,6 +1171,7 @@ module GHC.Classes where (==) :: a -> a -> GHC.Internal.Types.Bool (/=) :: a -> a -> GHC.Internal.Types.Bool {-# MINIMAL (==) | (/=) #-} + type role IP nominal representational type IP :: GHC.Internal.Types.Symbol -> * -> Constraint class IP x a | x -> a where ip :: a ===================================== testsuite/tests/th/TH_implicitParams.stdout ===================================== @@ -1,5 +1,5 @@ -Main.funcToReify :: GHC.Internal.Classes.IP "z" - GHC.Internal.Types.Int => +Main.funcToReify :: GHC.Internal.Classes.IP.IP "z" + GHC.Internal.Types.Int => GHC.Internal.Types.Int 5 1 ===================================== testsuite/tests/typecheck/should_compile/T26737.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ImpredicativeTypes, ImplicitParams #-} + +module T26737 where + +import Data.Coerce + +newtype Foo = MkFoo Int + +b :: ((?foo :: Foo) => Int) -> ((?foo :: Int) => Int) +b = coerce @(((?foo :: Foo) => Int)) @(((?foo :: Int) => Int)) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -957,3 +957,4 @@ test('T17705', normal, compile, ['']) test('T14745', normal, compile, ['']) test('T26451', normal, compile, ['']) test('T26582', normal, compile, ['']) +test('T26737', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae63c442710b0d0e0521fab72acdb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae63c442710b0d0e0521fab72acdb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26737] 10 commits: PPC NCG: Fix shift right MO code
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/26737 at Glasgow Haskell Compiler / GHC Commits: c1fe0097 by Peter Trommler at 2026-01-14T03:54:49-05:00 PPC NCG: Fix shift right MO code The shift amount in shift right [arithmetic] MOs is machine word width. Therefore remove unnecessary zero- or sign-extending of shift amount. It looks harmless to extend the shift amount argument because the shift right instruction uses only the seven lowest bits (i. e. mod 128). But now we have a conversion operation from a smaller type to word width around a memory load at word width. The types are not matching up but there is no check done in CodeGen. The necessary conversion from word width down to the smaller width would be translated into a no-op on PowerPC anyway. So all seems harmless if it was not for a small optimisation in getRegister'. In getRegister' a load instruction with the smaller width of the conversion operation was generated. This loaded the most significant bits of the word in memory on a big-endian platform. These bits were zero and hence shift right was used with shift amount zero and not one as required in test Sized. Fixes #26519 - - - - - 2dafc65a by Cheng Shao at 2026-01-14T03:55:31-05:00 Tree-wide cleanup of cygwin logic GHC has not supported cygwin for quite a few years already, and will not resume support in the forseeable future. The only supported windows toolchain is clang64/clangarm64 of the msys2 project. This patch cleans up the unused cygwin logic in the tree. Co-authored-by: Codex <codex(a)openai.com> - - - - - 66b96e2a by Teo Camarasu at 2026-01-14T03:56:13-05:00 Set default eventlog-flush-interval to 5s Resolves #26707 - - - - - d0254579 by Andrew Lelechenko at 2026-01-14T03:56:53-05:00 Document when -maxN RTS option was added - - - - - f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00 testsuite: remove obsolete --ci option from the testsuite driver This patch removes the obsolete `--ci` option from the testsuite driver: neither the CI scripts nor hadrian ever invokes the testsuite driver with `--ci`, and the perf notes are always fetched to the `refs/notes/perf` local reference anyway. - - - - - 7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00 Fix fetch_cabal * download cabal if the existing one is of an older version * fix FreeBSD download url * fix unpacking on FreeBSD - - - - - 6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00 Bump toolchain in CI - - - - - 0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00 Use libffi-clib Previously, we would build libffi via hadrian and bundle it manually with the GHC bindist. This now moves all that logic out of hadrian and allows us to have a clean Haskell package to build and link against and ship it without extra logic. This patch still retains the ability to link against a system libffi. The main reason of bundling libffi was that on some platforms (e.g. FreeBSD and Mac), system libffi is not visible to the C toolchain by default, so users would require settings in e.g. cabal to be able to compile anything. This adds the submodule libffi-clib to the repository. - - - - - 5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00 NCG/LA64: add support for la664 micro architecture Add '-mla664' flag to LA664, which has some new features: atomic instructions, dbar hints, etc. 'LA464' is the default so that unrecognized instructions are not generated. - - - - - c85d41bd by Simon Peyton Jones at 2026-01-15T13:43:57+00:00 Make the implicit-parameter class have representational role This MR addresses #26737, by making the built-in class IP have a representational role for its second parameter. See Note [IP: implicit parameter class] in ghc-internal:GHC.Internal.Classes.IP In fact, IP is (unfortunately, currently) exposed by base:GHC.Base, so we ran a quick CLC proposal to agree the change: https://github.com/haskell/core-libraries-committee/issues/385 - - - - - 67 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Unit/State.hs - configure.ac - docs/users_guide/9.16.1-notes.rst - docs/users_guide/packages.rst - docs/users_guide/using-concurrent.rst - docs/users_guide/using.rst - docs/users_guide/win32-dlls.rst - driver/ghci/ghci.c - driver/utils/cwrapper.c - driver/utils/isMinTTY.c - hadrian/bindist/cwrappers/cwrapper.c - hadrian/hadrian.cabal - hadrian/src/Builder.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - − hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - − libffi-tarballs - libraries/base/tests/IO/T12010/cbits/initWinSock.c - libraries/ghc-internal/cbits/consUtils.c - libraries/ghc-internal/configure.ac - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Classes.hs - + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs - libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - + libraries/libffi-clib - m4/ghc_select_file_extensions.m4 - packages - rts/RtsFlags.c - rts/include/rts/ghc_ffi.h - rts/rts.buildinfo.in - rts/rts.cabal - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/rts/linker/rdynamic.hs - testsuite/tests/th/TH_implicitParams.stdout - + testsuite/tests/typecheck/should_compile/T26737.hs - testsuite/tests/typecheck/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecc0f11c7f0dd24d1399004cfad592… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecc0f11c7f0dd24d1399004cfad592… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-try-opt-coercion] 3 commits: Update Notes about core binding invariants
by Simon Peyton Jones (＠simonpj) 15 Jan '26

15 Jan '26

Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: 88d60e1d by Simon Peyton Jones at 2026-01-15T12:56:19+00:00 Update Notes about core binding invariants - - - - - 8624f459 by Simon Peyton Jones at 2026-01-15T12:56:36+00:00 T26332 really should fail with -dlinear-core-lint - - - - - 6e78fe41 by Simon Peyton Jones at 2026-01-15T12:57:16+00:00 Try switching off the big optCoercion except in O2 - - - - - 18 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - testsuite/tests/linear/should_compile/T26332.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/PrimOps.hs ===================================== @@ -438,7 +438,7 @@ follows, in decreasing order of permissiveness: In particular, we cannot safely rewrite such an invalid call to a runtime error; we must emit code that produces a valid Word32#. (If we're lucky, Core Lint may complain that the result of such a rewrite violates - Note [Core binding invariants: nested non-rec] (#16742), but the rewrite + Note [Nested non-rec binding invariants] (#16742), but the rewrite is always wrong!) See also Note [Guarding against silly shifts] in GHC.Core.Opt.ConstantFold. @@ -581,7 +581,7 @@ Several predicates on primops test this flag: * The "no-float-out" thing is achieved by ensuring that we never let-bind a saturated primop application unless it has NoEffect. The RHS of a let-binding (which can float in and out freely) satisfies - exprOkForSpeculation; this is Note [Core binding invariants: nested non-rec]. + exprOkForSpeculation; this is Note [Nested non-rec binding invariants]. And exprOkForSpeculation is false of a saturated primop application unless it has NoEffect. ===================================== compiler/GHC/Core.hs ===================================== @@ -397,27 +397,27 @@ Note [Core binding invariants] A core binding, `CoreBind`, obeys these invariants: * For /top level/ or /recursive/ bindings, - see Note [Top-level binding invariants] + see Note [Top/rec binding invariants] * For /nested/ (not top-level) /non-recursive/ bindings, - see Note [Nested binding invariants] + see Note [Nested non-rec binding invariants] -Note [Top-level binding invariants] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Top/rec binding invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A /top-level/ or /recursive/ binding must - * be of lifted type -OR + * be of lifted type, OR + * have a RHS that is a primitive string literal - (see Note [Core top-level string literals], or -OR - * have a rhs that is (Coercion co) -OR - * be a worker or wrapper for an unlifted non-newtype data constructor; see (TL1). + (see Note [Core top-level string literals], OR + + * have a rhs that is (Coercion co), OR + + * be a worker or wrapper for an unlifted non-newtype + data constructor; see (TL1). -For the non-top-level, non-recursive case see Note [Nested binding invariants]. -(NB: this Note applies to recursive as well as top-level bindings, but I wanted -a short title!) +For the non-top-level, non-recursive case +see Note [Nested non-rec binding invariants]. See "Type#type_classification" in GHC.Core.Type for the meaning of "lifted" vs. "unlifted". @@ -439,8 +439,8 @@ constructor worker or wrapper S1 = S1 We allow this top-level unlifted binding to exist. -Note [Nested binding invariants] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Nested non-rec binding invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A /non-top-level/, /non-recursive/ binding must * Be a join point; see Note [Invariants on join points] OR @@ -471,7 +471,7 @@ The Core binding invariants are initially enforced by mkCoreLet in GHC.Core.Make Historical Note [The let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before 2022 GHC used the "let/app invariant", which applied -Note [Nested binding invariants] to the argument of an application, +Note [Nested non-rec binding invariants] to the argument of an application, as well as to the RHS of a let. This made some kind of sense, because 'let' can always be encoded as application: let x=rhs in b = (\x.b) rhs @@ -641,8 +641,8 @@ checked by Core Lint. multiplicity of the corresponding field /scaled by the multiplicity of the case binder/. Checked in lintCoreAlt. -Note [Core type and coercion invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Core type and coercion invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow `let` to bind type and coercion variables. * A type or coercion binding is always /non-recursive/ @@ -887,7 +887,7 @@ Join points must follow these invariants: However, join points have simpler invariants in other ways 5. A join point can have an unboxed type without the RHS being - ok-for-speculation; see + ok-for-speculation; see e.g. let j :: Int# = factorial x in ... 6. The RHS of join point is not required to have a fixed runtime representation, @@ -2095,8 +2095,8 @@ mkDoubleLit d = Lit (mkLitDouble d) mkDoubleLitDouble d = Lit (mkLitDouble (toRational d)) -- | Bind all supplied binding groups over an expression in a nested let expression. --- Assumes that the rhs satisfies Note [Nested binding invariants]. Prefer to use --- 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant +-- Assumes that the rhs satisfies Note [Nested non-rec binding invariants]. +-- Prefer to use 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant mkLets :: [Bind b] -> Expr b -> Expr b -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to -- use 'GHC.Core.Make.mkCoreLams' if possible ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -270,10 +270,12 @@ optCoRefl subst in_co = let out_co = opt_co_refl subst in_co (Pair in_l in_r) = coercionKind in_co (Pair out_l out_r) = coercionKind out_co - in if (in_l `eqType` out_l) && (in_r `eqType` out_r) + in_l' = substTy subst in_l + in_r' = substTy subst in_r + in if (in_l' `eqType` out_l) && (in_r' `eqType` out_r) then out_co - else pprTrace "optReflCo" (vcat [ text "in_l:" <+> ppr in_l - , text "in_r:" <+> ppr in_r + else pprTrace "optReflCo" (vcat [ text "in_l':" <+> ppr in_l' + , text "in_r':" <+> ppr in_r' , text "out_l:" <+> ppr out_l , text "out_r:" <+> ppr out_r , text "in_co:" <+> ppr in_co ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -113,7 +113,7 @@ sortQuantVars vs = sorted_tcvs ++ ids -- appropriate (see "GHC.Core#let_can_float_invariant") mkCoreLet :: HasDebugCallStack => CoreBind -> CoreExpr -> CoreExpr mkCoreLet (NonRec bndr rhs) body - = -- See Note [Core binding invariants: nested non-rec] + = -- See Note [Nested non-rec binding invariants] bindNonRec bndr rhs body mkCoreLet bind body = Let bind body ===================================== compiler/GHC/Core/Opt/CSE.hs ===================================== @@ -287,8 +287,8 @@ Here is another reason that we do not use SUBSTITUTE for all trivial expressions. Consider case x |> co of (y::Array# Int) { ... } -We do not want to extend the substitution with (y -> x |> co); since y -is of unlifted type, this would destroy Note [Nested binding invariants] +We do not want to extend the substitution with (y -> x |> co); since y is of +unlifted type, this would destroy Note [Nested non-rec binding invariants] if (x |> co) was not ok-for-speculation. But surely (x |> co) is ok-for-speculation, because it's a trivial ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1607,7 +1607,7 @@ as follows: in ... This was originally done in the fix to #16449 but this breaks -Note [Nested binding invariants] in GHC.Core, as noted in #16742. For the +Note [Nested non-rec binding invariants] in GHC.Core, as noted in #16742. For the reasons discussed under "NoEffect" in Note [Classifying primop effects] (in GHC.Builtin.PrimOps) there is no safe way to rewrite the argument of I# such that it bottoms. @@ -2177,7 +2177,7 @@ BigNat). These rules implement the same kind of constant folding as we have for Int#/Word#/etc. primops. See builtinBignumRules. These rules are built-in because they can't be expressed as regular rules for -now. The reason is that due to Note [Nested binding invariants] in GHC.Core, +now. The reason is that due to Note [Nested non-rec binding invariants] in GHC.Core, GHC is too conservative with some bignum operations and they don't match rules. For example: @@ -2185,8 +2185,8 @@ For example: doesn't constant-fold into `integerAdd 2 x` with a regular rule. That's because GHC never floats in `integerAdd 1 x` to form `integerAdd 1 (integerAdd 1 x)` -because of Note [Nested binding invariants] (it doesn't know if `integerAdd` -terminates). +because of Note [Nested non-rec binding invariants] (it doesn't know if +`integerAdd` terminates). In the built-in rule for `integerAdd` we can access the unfolding of `r` and we can perform the appropriate substitution. ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -665,7 +665,7 @@ noFloatIntoRhs is_rec bndr rhs = isRec is_rec -- Joins are one-shot iff non-recursive | definitelyUnliftedType (idType bndr) - = True -- Preserve Note [Nested binding invariants], + = True -- Preserve Note [Nested non-rec binding invariants], -- see Note [noFloatInto considerations] | otherwise @@ -691,7 +691,7 @@ When do we want to float bindings into - noFloatIntoArg: the argument of a function application Definitely don't float into RHS if it has unlifted type; -that would destroy Note [Nested binding invariants]. +that would destroy Note [Nested non-rec binding invariants]. * Wrinkle 1: do not float in if (a) any non-one-shot value lambdas ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -1003,11 +1003,11 @@ Why? Because it's important /not/ to transform let x = a /# 3 to let x = case bx of I# a -> a /# 3 -because the let binding no longer obeys Note [Nested binding invariants]. +because the let binding no longer obeys Note [Nested non-rec binding invariants]. But (a /# 3) is ok-for-spec due to a special hack that says division operators can't fail when the denominator is definitely non-zero. And yet that same expression says False to exprIsCheap. Simplest way to guarantee -Note [Nested binding invariants] is to use the same function! +Note [Nested non-rec binding invariants] is to use the same function! If an expression is okay for speculation, we could also float it out *without* boxing and unboxing, since evaluating it early is okay. ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -749,8 +749,10 @@ Examples NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge - NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy Note [Nested binding invariants] - NonRec x# (f y) FltCareful -- Might diverge; does not satisfy Note [Nested binding invariants] + NonRec x# (a /# b) FltCareful -- Might fail; does not satisfy + -- Note [Nested non-rec binding invariants] + NonRec x# (f y) FltCareful -- Might diverge; does not satisfy + -- Note [Nested non-rec binding invariants] -} data LetFloats = LetFloats (OrdList OutBind) FloatFlag @@ -763,7 +765,8 @@ data FloatFlag = FltLifted -- All bindings are lifted and lazy *or* -- consist of a single primitive string literal -- Hence ok to float to top level, or recursive - -- NB: consequence: all bindings satisfy Note [Nested binding invariants] + -- NB: consequence: all bindings satisfy + -- Note [Nested non-rec binding invariants] | FltOkSpec -- All bindings are FltLifted *or* -- strict (perhaps because unlifted, @@ -772,12 +775,14 @@ data FloatFlag -- Hence ok to float out of the RHS -- of a lazy non-recursive let binding -- (but not to top level, or into a rec group) - -- NB: consequence: all bindings satisfy Note [Nested binding invariants] + -- NB: consequence: all bindings satisfy + -- Note [Nested non-rec binding invariants] | FltCareful -- At least one binding is strict (or unlifted) -- and not guaranteed cheap -- Do not float these bindings out of a lazy let! - -- NB: some bindings may not satisfy Note [Nested binding invariants] + -- NB: some bindings may not satisfy + -- Note [Nested non-rec binding invariants] instance Outputable LetFloats where ppr (LetFloats binds ff) = ppr ff $$ ppr (fromOL binds) @@ -962,8 +967,10 @@ wrapFloats (SimplFloats { sfLetFloats = LetFloats bs flag -- Note: Always safe to put the joins on the inside -- since the values can't refer to them where - mk_let | FltCareful <- flag = mkCoreLet -- Need to enforce Note [Nested binding invariants] - | otherwise = Let -- Note [Nested binding invariants] holds + mk_let | FltCareful <- flag + = mkCoreLet -- Need to enforce Note [Nested non-rec binding invariants] + | otherwise + = Let -- Note [Nested non-rec binding invariants] holds wrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr) -- Wrap the sfJoinFloats of the env around the expression, ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -315,7 +315,7 @@ simplLazyBind :: TopLevelFlag -> RecFlag -> (InExpr, SimplEnv) -- The RHS and its static environment -> SimplM (SimplFloats, SimplEnv) -- Precondition: Ids only, no TyVars; not a JoinId --- Precondition: rhs obeys Note [Nested binding invariants] +-- Precondition: rhs obeys Note [Nested non-rec binding invariants] simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se) = assert (isId bndr ) assertPpr (not (isJoinId bndr)) (ppr bndr) $ @@ -397,7 +397,7 @@ simplAuxBind :: String -- The binder comes from a case expression (case binder or alternative) -- and so does not have rules, unfolding, inline pragmas etc. -- --- Precondition: rhs satisfies Note [Nested binding invariants] +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] simplAuxBind _str env bndr new_rhs | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ @@ -950,7 +950,7 @@ completeBind :: BindContext -- * or by adding to the floats in the envt -- -- Binder /can/ be a JoinId --- Precondition: rhs obeys Note [Nested binding invariants] +-- Precondition: rhs obeys Note [Nested non-rec binding invariants] completeBind bind_cxt (old_bndr, unf_se) (new_bndr, new_rhs, env) | isCoVar old_bndr = case new_rhs of @@ -1290,7 +1290,7 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont ; simplExprF (extendTvSubst env bndr ty') body cont } | Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env - -- Because of Note [Nested binding invariants], it's ok to + -- Because of Note [Nested non-rec binding invariants], it's ok to -- inline freely, or to drop the binding if it is dead. = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr <+> ppr rhs) $ tick (PreInlineUnconditionally bndr) @@ -1594,13 +1594,13 @@ rebuild_go env expr cont completeBindX :: SimplEnv -> FromWhat -> InId -> OutExpr -- Non-recursively bind this Id to this (simplified) expression - -- (Note [Nested binding invariants] may not be satisfied) + -- (Note [Nested non-rec binding invariants] may not be satisfied) -> InExpr -- In this body -> SimplCont -- Consumed by this continuation -> SimplM (SimplFloats, OutExpr) completeBindX env from_what bndr rhs body cont | FromBeta arg_levity <- from_what - , needsCaseBindingL arg_levity rhs -- Enforcing Note [Nested binding invariants] + , needsCaseBindingL arg_levity rhs -- Enforcing Note [Nested non-rec binding invariants] = do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules ; (floats, expr') <- simplNonRecBody env1 from_what body cont -- Do not float floats past the Case binder below @@ -1887,7 +1887,7 @@ simplNonRecE :: HasDebugCallStack -- It deals with strict bindings, via the StrictBind continuation, -- which may abort the whole process. -- --- from_what=FromLet => the RHS satisfies Note [Nested binding invariants] +-- from_what=FromLet => the RHS satisfies Note [Nested non-rec binding invariants] -- Otherwise it may or may not satisfy it. simplNonRecE env from_what bndr (rhs, rhs_se) body cont @@ -1909,8 +1909,8 @@ simplNonRecE env from_what bndr (rhs, rhs_se) body cont where is_strict_bind = case from_what of FromBeta Unlifted -> True - -- If we are coming from a beta-reduction (FromBeta) we must - -- establish Note [Nested binding invariants], so go via StrictBind + -- If we are coming from a beta-reduction (FromBeta) we must establish + -- Note [Nested non-rec binding invariants], so go via StrictBind -- If not, the invariant holds already, and it's optional. -- (FromBeta Lifted) or FromLet: look at the demand info @@ -2857,7 +2857,7 @@ this transformation: We treat the unlifted and lifted cases separately: * Unlifted case: 'e' satisfies exprOkForSpeculation - (ok-for-spec is needed to satisfy Note [Nested binding invariants]. + (ok-for-spec is needed to satisfy Note [Nested non-rec binding invariants]. This turns case a +# b of r -> ...r... into let r = a +# b in ...r... and thence .....(a +# b).... @@ -3112,7 +3112,7 @@ rebuildCase env scrut case_bndr alts cont assert (null bs) $ do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs -- scrut is a constructor application, - -- hence satisfies Note [Nested binding invariants] + -- hence satisfies Note [Nested non-rec binding invariants] ; (floats2, expr') <- simplExprF env' rhs cont ; case wfloats of [] -> return (floats1 `addFloats` floats2, expr') @@ -3624,13 +3624,14 @@ We pin on a (OtherCon []) unfolding to the case-binder of a Case, even though it'll be over-ridden in every case alternative with a more informative unfolding. Why? Because suppose a later, less clever, pass simply replaces all occurrences of the case binder with the binder itself; -then Lint may complain about failing Note [Nested binding invariants]. Example +then Lint may complain about failing Note [Nested non-rec binding invariants]. +Example: case e of b { DEFAULT -> let v = reallyUnsafePtrEquality# b y in .... ; K -> blah } -Note [Nested binding invariants] requires that y is evaluated in the call to -reallyUnsafePtrEquality#, which it is. But we still want that to be true if we -propagate binders to occurrences. +Note [Nested non-rec binding invariants] requires that y is evaluated in the +call to reallyUnsafePtrEquality#, which it is. But we still want that to be +true if we propagate binders to occurrences. This showed up in #13027. @@ -3732,7 +3733,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - -- NB: arg satisfies Note [Nested binding invariants] + -- NB: arg satisfies Note [Nested non-rec binding invariants] ; (floats1, env2) <- simplAuxBind "knownCon" env' b' arg ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1491,8 +1491,8 @@ preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> StaticEnv -- These two go together -> Maybe SimplEnv -- Returned env has extended substitution --- Precondition: rhs satisfies Note [Nested binding invariants] --- See Note [Nested binding invariants] in GHC.Core +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] +-- See Note [Nested non-rec binding invariants] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env @@ -1638,7 +1638,7 @@ postInlineUnconditionally -> InId -> OutId -- The binder (*not* a CoVar), including its unfolding -> OutExpr -> Bool --- Precondition: rhs satisfies Note [Nested binding invariants] in GHC.Core +-- Precondition: rhs satisfies Note [Nested non-rec binding invariants] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings postInlineUnconditionally env bind_cxt old_bndr bndr rhs ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1937,14 +1937,14 @@ where Left to itself, the specialiser would float the bindings for `x` and `n` to top level, so we can specialise `wombat`. But we can't have a top-level ByteArray# -(see Note [Core letrec invariant] in GHC.Core). Boo. +(see Note [Top/rec binding invariants] in GHC.Core). Boo. This is pretty exotic, so we take a simple way out: in specBind (the NonRec case) do not float the binding itself unless it satisfies exprIsTopLevelBindable. This is conservative: maybe the RHS of `x` has a free var that would stop it floating to top level anyway; but that is hard to spot (since we don't know what the non-top-level in-scope binders are) and rare (since the binding must satisfy -Note [Nested binding invariants] in GHC.Core). +Note [Nested non-rec binding invariants] in GHC.Core). Note [Specialising Calls] ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -381,7 +381,8 @@ simple_app env e0@(Lam {}) as0@(_:_) -- See Note [Dark corner with representation polymorphism] needsCaseBinding (idType b') (snd a) -- This arg must not be inlined (side-effects) and cannot be let-bound, - -- due to Note [Nested binding invariants]. So simply case-bind it here. + -- due to Note [Nested non-rec binding invariants]. + -- So simply case-bind it here. , let a' = simple_opt_clo (soeInScope env) a = mkDefaultCase a' b' $ do_beta env' body as ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2042,15 +2042,15 @@ But we restrict it sharply: ; False -> e2 } in ...) ... - Does the RHS of v satisfy Note [Nested binding invariants]? + Does the RHS of v satisfy Note [Nested non-rec binding invariants]? Previously we said yes, on the grounds that y is evaluated. But the binder-swap done by GHC.Core.Opt.SetLevels would transform the inner alternative to DEFAULT -> ... (let v::Int# = case x of { ... } in ...) .... - which does /not/ satisfy Note [Nested bindings invariants], because x is - not evaluated. See Note [Binder-swap during float-out] + which does /not/ satisfy Note [Nested non-rec bindings invariants], + because x is not evaluated. See Note [Binder-swap during float-out] in GHC.Core.Opt.SetLevels. To avoid this awkwardness it seems simpler to stick to unlifted scrutinees where the issue does not arise. @@ -2134,7 +2134,7 @@ extremely useful for float-out, changes these expressions to And now the expression does not obey the let-can-float invariant! Yikes! Moreover we really might float (dataToTagLarge# x) outside the case, -and then it really, really doesn't obey Note [Nested binding invariants]. +and then it really, really doesn't obey Note [Nested non-rec binding invariants]. The solution is simple: exprOkForSpeculation does not try to take advantage of the evaluated-ness of (lifted) variables. And it returns @@ -2144,7 +2144,7 @@ by marking the relevant primops as "ThrowsException" or GHC.Builtin.PrimOps. Note that exprIsHNF /can/ and does take advantage of evaluated-ness; -it doesn't have the trickiness of Note [Nested binding invariants] +it doesn't have the trickiness of Note [Nested non-rec binding invariants] to worry about. ************************************************************************ ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -302,7 +302,7 @@ expose the values: see Note [wantFloatLocal].) If `v` is bound at the top-level, we might even float `sat` to top-level; see Note [Floating out of top level bindings]. -For nested let bindings, we have to keep in mind Note [Core letrec invariant] +For nested let bindings, we have to keep in mind Note [Core binding invariants], and may exploit strict contexts; see Note [wantFloatLocal]. There are 3 main categories of floats, encoded in the `FloatingBind` type: @@ -1509,7 +1509,7 @@ Wrinkles: (FS1) We detect string literals in `cpeBind Rec{}` and float them out anyway; otherwise we'd try to bind a string literal in a letrec, violating - Note [Core letrec invariant]. Since we know that literals don't have + Note [Top/rec binding invariants]. Since we know that literals don't have free variables, we float further. Arguably, we could just as well relax the letrec invariant for string literals, or anthing that is a value (lifted or not). @@ -2363,7 +2363,7 @@ Wrinkles: x = f y r y = [x] in e - and now we have violated Note [Core letrec invariant]. + and now we have violated Note [Top/rec binding invariants]. So we preempt this case in `wantFloatLocal`, responding `FloatNone` unless all floats are `TopLvlFloatable`. -} ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1233,7 +1233,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_DoCleverArgEtaExpansion) -- See Note [Eta expansion of arguments in CorePrep] , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] , ([0,1,2], Opt_ProfManualCcs ) - , ([0,1,2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt + , ([2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt , ([2], Opt_DictsStrict) , ([0], Opt_IgnoreInterfacePragmas) ===================================== testsuite/tests/linear/should_compile/T26332.hs ===================================== @@ -5,6 +5,12 @@ module T26332 where import Unsafe.Coerce +-- This function should be accepted by the typechecker, and should be +-- linear-correct in the output of the desugarer, but will fail +-- -dlinear-core-lint (which does a linear-lint check after every simplifier +-- pass. Because the optimiser discards a cast on `f` that only affects +-- linearity + toLinear :: forall a b p q. (a %p-> b) %1-> (a %q-> b) ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -42,7 +42,7 @@ test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) test('T23025', normal, compile, ['-dlinear-core-lint']) -test('T26332', normal, compile, ['-O -dlinear-core-lint']) +test('T26332', normal, compile_fail, ['-O']) test('LinearRecUpd', normal, compile, ['']) test('T23814', normal, compile, ['']) test('LinearLet', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/088f51ccfcd62799e1fa195f3e3740… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/088f51ccfcd62799e1fa195f3e3740… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fix-rts-stubs
by Cheng Shao (＠TerrorJack) 15 Jan '26

15 Jan '26

Cheng Shao pushed new branch wip/fix-rts-stubs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-rts-stubs You're receiving this email because of your account on gitlab.haskell.org.

1 0