- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/fix-reload-targets] Teach `:reload` about multiple home units
by Hannes Siebenhandl (＠fendor) 24 Jun '25

24 Jun '25

Hannes Siebenhandl pushed to branch wip/fendor/fix-reload-targets at Glasgow Haskell Compiler / GHC Commits: 166d218b by fendor at 2025-06-24T13:25:07+02:00 Teach `:reload` about multiple home units `:reload` needs to lookup the `ModuleName` and must not assume the given `ModuleName` is in the current `HomeUnit`. We add a new utility function which allows us to find a `HomeUnitModule` instead of a `Module`. Further, we introduce the `GhciCommandError` type which can be used to abort the execution of a GHCi command. This error is caught and printed in a human readable fashion. - - - - - 15 changed files: - compiler/GHC/Driver/Make.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - ghc/GHCi/UI/Print.hs - testsuite/tests/ghc-e/should_fail/T18441fail5.stderr - testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr - testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr - + testsuite/tests/ghci/prog021/A.hs - + testsuite/tests/ghci/prog021/B.hs - + testsuite/tests/ghci/prog021/Makefile - + testsuite/tests/ghci/prog021/prog021.T - + testsuite/tests/ghci/prog021/prog021.script - + testsuite/tests/ghci/prog021/prog021.stderr - + testsuite/tests/ghci/prog021/prog021.stdout - testsuite/tests/ghci/scripts/ghci021.stderr Changes: ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -116,6 +116,7 @@ import qualified Control.Monad.Catch as MC import Data.IORef import Data.Maybe import Data.List (sortOn, groupBy, sortBy) +import qualified Data.List as List import System.FilePath import Control.Monad.IO.Class @@ -520,13 +521,14 @@ countMods (UnresolvedCycle ns) = length ns createBuildPlan :: ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan] createBuildPlan mod_graph maybe_top_mod = let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles - cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod + cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod + acyclic_mod_graph = topSortModuleGraph False mod_graph maybe_top_mod -- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles. build_plan :: [BuildPlan] build_plan -- Fast path, if there are no boot modules just do a normal toposort - | isEmptyModuleEnv boot_modules = collapseAcyclic $ topSortModuleGraph False mod_graph maybe_top_mod + | isEmptyModuleEnv boot_modules = collapseAcyclic acyclic_mod_graph | otherwise = toBuildPlan cycle_mod_graph [] toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan] @@ -598,14 +600,17 @@ createBuildPlan mod_graph maybe_top_mod = collapseAcyclic [] = [] topSortWithBoot nodes = topSortModules False (select_boot_modules nodes ++ nodes) Nothing - - in - - assertPpr (sum (map countMods build_plan) == lengthMG mod_graph) - (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (lengthMG mod_graph))]) + -- We need to use 'acyclic_mod_graph', since if 'maybe_top_mod' is 'Just', then the resulting module + -- graph is pruned, reducing the number of 'build_plan' elements. + -- We don't use the size of 'cycle_mod_graph', as it removes @.hi-boot@ modules. These are added + -- later in the processing. + assertPpr (sum (map countMods build_plan) == lengthMGWithSCC acyclic_mod_graph) + (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (lengthMGWithSCC acyclic_mod_graph))]) build_plan - + where + lengthMGWithSCC :: [SCC a] -> Int + lengthMGWithSCC = List.foldl' (\acc scc -> length scc + acc) 0 -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally ===================================== ghc/GHCi/UI.hs ===================================== @@ -1302,7 +1302,8 @@ runOneCommand eh gCmd = do st <- getGHCiState ghciHandle (\e -> lift $ eh e >>= return . Just) $ handleSourceError printErrorAndFail $ - cmd_wrapper st $ doCommand c + handleGhciCommandError printErrorAndContinue $ + cmd_wrapper st $ doCommand c -- source error's are handled by runStmt -- is the handler necessary here? where @@ -1310,6 +1311,10 @@ runOneCommand eh gCmd = do printGhciException err return $ Just False -- Exit ghc -e, but not GHCi + printErrorAndContinue err = do + printGhciCommandException err + return $ Just False -- Exit ghc -e, but not GHCi + noSpace q = q >>= maybe (return Nothing) (\c -> case removeSpaces c of "" -> noSpace q @@ -2286,13 +2291,16 @@ unAddModule files = do -- | @:reload@ command reloadModule :: GhciMonad m => String -> m () reloadModule m = do - session <- GHC.getSession - let home_unit = homeUnitId (hsc_home_unit session) - ok <- doLoadAndCollectInfo Reload (loadTargets home_unit) + loadTarget <- findLoadTarget + ok <- doLoadAndCollectInfo Reload loadTarget when (failed ok) failIfExprEvalMode where - loadTargets hu | null m = LoadAllTargets - | otherwise = LoadUpTo (mkModule hu (GHC.mkModuleName m)) + findLoadTarget + | null m = + pure LoadAllTargets + | otherwise = do + mod' <- lookupHomeUnitModuleName (GHC.mkModuleName m) + pure $ LoadUpTo mod' reloadModuleDefer :: GhciMonad m => String -> m () reloadModuleDefer = wrapDeferTypeErrors . reloadModule @@ -4747,8 +4755,11 @@ showException se = Just other_ghc_ex -> putException (show other_ghc_ex) Nothing -> case fromException se of - Just UserInterrupt -> putException "Interrupted." - _ -> putException ("*** Exception: " ++ show se) + Just (GhciCommandError s) -> putException (show (GhciCommandError s)) + Nothing -> + case fromException se of + Just UserInterrupt -> putException "Interrupted." + _ -> putException ("*** Exception: " ++ show se) where putException = hPutStrLn stderr @@ -4798,15 +4809,22 @@ lookupModuleName mName = lookupQualifiedModuleName NoPkgQual mName lookupQualifiedModuleName :: GHC.GhcMonad m => PkgQual -> ModuleName -> m Module lookupQualifiedModuleName qual modl = do GHC.lookupAllQualifiedModuleNames qual modl >>= \case - [] -> throwGhcException (CmdLineError ("module '" ++ str ++ "' could not be found.")) + [] -> throwGhciCommandError (GhciModuleError $ GhciModuleNameNotFound modl) [m] -> pure m - ms -> throwGhcException (CmdLineError ("module name '" ++ str ++ "' is ambiguous:\n" ++ errorMsg ms)) + ms -> throwGhciCommandError (GhciModuleError $ GhciAmbiguousModuleName modl ms) + +lookupHomeUnitModuleName :: GHC.GhcMonad m => ModuleName -> m HomeUnitModule +lookupHomeUnitModuleName modl = do + m <- GHC.lookupLoadedHomeModuleByModuleName modl >>= \case + Nothing -> throwGhciCommandError (GhciModuleError $ GhciNoLocalModuleName modl) + Just [m] -> pure m + Just ms -> throwGhciCommandError (GhciModuleError $ GhciAmbiguousModuleName modl ms) + + if unitIsDefinite (moduleUnit m) + then pure (fmap toUnitId m) + else throwGhcException (CmdLineError ("module '" ++ str ++ "' is not from a definite unit")) where str = moduleNameString modl - errorMsg ms = intercalate "\n" - [ "- " ++ unitIdString (toUnitId (moduleUnit m)) ++ ":" ++ moduleNameString (moduleName m) - | m <- ms - ] showModule :: Module -> String showModule = moduleNameString . moduleName ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -5,7 +5,10 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE LambdaCase #-} module GHCi.UI.Exception - ( GhciMessage(..) + ( GhciCommandError(..) + , throwGhciCommandError + , handleGhciCommandError + , GhciMessage(..) , GhciMessageOpts(..) , fromGhcOpts , toGhcHint @@ -29,19 +32,57 @@ import GHC.Tc.Errors.Ppr import GHC.Tc.Errors.Types import GHC.Types.Error.Codes +import GHC.Types.SrcLoc (interactiveSrcSpan) import GHC.TypeLits import GHC.Unit.State import GHC.Utils.Outputable +import GHC.Utils.Error import GHC.Generics import GHC.Types.Error import GHC.Types import qualified GHC +import Control.Exception +import Control.Monad.Catch as MC (MonadCatch, catch) +import Control.Monad.IO.Class import Data.List.NonEmpty (NonEmpty(..)) +-- | A 'GhciCommandError' are messages that caused the abortion of a GHCi command. +newtype GhciCommandError = GhciCommandError (Messages GhciMessage) + +instance Exception GhciCommandError + +instance Show GhciCommandError where + -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics + -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions. + -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'. + show (GhciCommandError msgs) = + renderWithContext defaultSDocContext + . vcat + . pprMsgEnvelopeBagWithLocDefault + . getMessages + $ msgs + +-- | Perform the given action and call the exception handler if the action +-- throws a 'SourceError'. See 'SourceError' for more information. +handleGhciCommandError :: (MonadCatch m) => + (GhciCommandError -> m a) -- ^ exception handler + -> m a -- ^ action to perform + -> m a +handleGhciCommandError handler act = + MC.catch act (\(e :: GhciCommandError) -> handler e) + +throwGhciCommandError :: MonadIO m => GhciCommandMessage -> m a +throwGhciCommandError errorMessage = + liftIO + . throwIO + . GhciCommandError + . singleMessage + $ mkPlainErrorMsgEnvelope interactiveSrcSpan (GhciCommandMessage errorMessage) + -- | The Options passed to 'diagnosticMessage' -- in the 'Diagnostic' instance of 'GhciMessage'. data GhciMessageOpts = GhciMessageOpts @@ -257,6 +298,9 @@ data GhciModuleError | GhciNoResolvedModules | GhciNoModuleForName GHC.Name | GhciNoMatchingModuleExport + | GhciNoLocalModuleName !GHC.ModuleName + | GhciModuleNameNotFound !GHC.ModuleName + | GhciAmbiguousModuleName !GHC.ModuleName ![GHC.Module] deriving Generic instance Diagnostic GhciModuleError where @@ -278,6 +322,16 @@ instance Diagnostic GhciModuleError where -> "No module for" <+> ppr name GhciNoMatchingModuleExport -> "No matching export in any local modules." + GhciNoLocalModuleName modl + -> "Module" <+> quotes (ppr modl) <+> "cannot be found locally" + GhciModuleNameNotFound modl + -> "module" <+> quotes (ppr modl) <+> "could not be found." + GhciAmbiguousModuleName modl candidates + -> "Module name" <+> quotes (ppr modl) <+> "is ambiguous" $+$ + vcat + [ text "-" <+> ppr (GHC.moduleName m) <> colon <> ppr (GHC.moduleUnit m) + | m <- candidates + ] diagnosticReason = \case GhciModuleNotFound{} -> @@ -294,6 +348,12 @@ instance Diagnostic GhciModuleError where ErrorWithoutFlag GhciNoMatchingModuleExport{} -> ErrorWithoutFlag + GhciNoLocalModuleName{} -> + ErrorWithoutFlag + GhciModuleNameNotFound{} -> + ErrorWithoutFlag + GhciAmbiguousModuleName{} -> + ErrorWithoutFlag diagnosticHints = \case GhciModuleNotFound{} -> @@ -310,7 +370,12 @@ instance Diagnostic GhciModuleError where [] GhciNoMatchingModuleExport{} -> [] - + GhciNoLocalModuleName{} -> + [] + GhciModuleNameNotFound{} -> + [] + GhciAmbiguousModuleName{} -> + [] diagnosticCode = constructorCode @GHCi -- | A Diagnostic emitted by GHCi while executing a command @@ -487,6 +552,9 @@ type family GhciDiagnosticCode c = n | n -> c where GhciDiagnosticCode "GhciNoModuleForName" = 21847 GhciDiagnosticCode "GhciNoMatchingModuleExport" = 59723 GhciDiagnosticCode "GhciArgumentParseError" = 35671 + GhciDiagnosticCode "GhciNoLocalModuleName" = 81235 + GhciDiagnosticCode "GhciModuleNameNotFound" = 40475 + GhciDiagnosticCode "GhciAmbiguousModuleName" = 59019 type GhciConRecursInto :: Symbol -> Maybe Type type family GhciConRecursInto con where ===================================== ghc/GHCi/UI/Print.hs ===================================== @@ -5,6 +5,7 @@ module GHCi.UI.Print , printForUserPartWay , printError , printGhciException + , printGhciCommandException ) where import qualified GHC @@ -64,7 +65,7 @@ printForUserPartWay doc = do -- | pretty-print a 'GhciCommandMessage' printError :: GhcMonad m => GhciCommandMessage -> m () printError err = - let errEnvelope = mkPlainErrorMsgEnvelope (UnhelpfulSpan UnhelpfulInteractive) err + let errEnvelope = mkPlainErrorMsgEnvelope interactiveSrcSpan err in printError' (const NoDiagnosticOpts) (singleMessage errEnvelope) -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting @@ -72,6 +73,9 @@ printError err = printGhciException :: GhcMonad m => SourceError -> m () printGhciException err = printError' initGhciPrintConfig (GhciGhcMessage <$> (srcErrorMessages err)) +printGhciCommandException :: GhcMonad m => GhciCommandError -> m () +printGhciCommandException (GhciCommandError errs) = printError' initGhciPrintConfig errs + printError' :: (GhcMonad m, Diagnostic a) => (DynFlags -> DiagnosticOpts a) -> Messages a -> m () printError' get_config err = do dflags <- getDynFlags ===================================== testsuite/tests/ghc-e/should_fail/T18441fail5.stderr ===================================== @@ -1,4 +1,4 @@ -<no location info>: error: [GHC-82272] - module ‘Abcde’ cannot be found locally +<interactive>: error: [GHCi-81235] + Module ‘Abcde’ cannot be found locally 1 ===================================== testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr ===================================== @@ -1,9 +1,15 @@ -module name 'Foo' is ambiguous: -- b-0.0.0:Foo -- d-0.0.0:Foo -module name 'Foo' is ambiguous: -- b-0.0.0:Foo -- d-0.0.0:Foo -module name 'Foo' is ambiguous: -- b-0.0.0:Foo -- d-0.0.0:Foo +<interactive>: error: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:b-0.0.0 + - Foo:d-0.0.0 + +<interactive>: error: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:b-0.0.0 + - Foo:d-0.0.0 + +<interactive>: error: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:b-0.0.0 + - Foo:d-0.0.0 + ===================================== testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr ===================================== @@ -1,9 +1,14 @@ -module name 'Foo' is ambiguous: -- a-0.0.0:Foo -- b-0.0.0:Foo -module name 'Foo' is ambiguous: -- a-0.0.0:Foo -- b-0.0.0:Foo -module name 'Foo' is ambiguous: -- a-0.0.0:Foo -- b-0.0.0:Foo +<interactive>: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:a-0.0.0 + - Foo:b-0.0.0 + +<interactive>: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:a-0.0.0 + - Foo:b-0.0.0 + +<interactive>: [GHCi-59019] + Module name ‘Foo’ is ambiguous + - Foo:a-0.0.0 + - Foo:b-0.0.0 ===================================== testsuite/tests/ghci/prog021/A.hs ===================================== @@ -0,0 +1,5 @@ +module A (f) where + +f x = [x] + +g x = Just x ===================================== testsuite/tests/ghci/prog021/B.hs ===================================== @@ -0,0 +1,5 @@ +module B where + +import A + +h = f ===================================== testsuite/tests/ghci/prog021/Makefile ===================================== @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== testsuite/tests/ghci/prog021/prog021.T ===================================== @@ -0,0 +1,6 @@ +test('prog021', + [req_interp, + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + extra_files(['A.hs', 'B.hs', 'prog021.script']) + ], + ghci_script, ['prog021.script']) ===================================== testsuite/tests/ghci/prog021/prog021.script ===================================== @@ -0,0 +1,15 @@ +-- Loads all targets +:load A B +:m + A B +f 5 +g 5 +h 5 +-- Load only one target +:reload A +:m A +putStrLn "B is not loaded, we can't add it to the context" +:m + B +f 5 +putStrLn "`g` and `h` are not in scope" +g 5 +h 5 ===================================== testsuite/tests/ghci/prog021/prog021.stderr ===================================== @@ -0,0 +1,10 @@ +<no location info>: error: [GHC-35235] + Could not find module ‘B’. + It is not a module in the current program, or in any known package. + +<interactive>:14:1: error: [GHC-88464] + Variable not in scope: g :: t0 -> t + +<interactive>:15:1: error: [GHC-88464] + Variable not in scope: h :: t0 -> t + ===================================== testsuite/tests/ghci/prog021/prog021.stdout ===================================== @@ -0,0 +1,6 @@ +[5] +Just 5 +[5] +B is not loaded, we can't add it to the context +[5] +`g` and `h` are not in scope ===================================== testsuite/tests/ghci/scripts/ghci021.stderr ===================================== @@ -1,3 +1,3 @@ -<no location info>: error: [GHC-82272] - module ‘ThisDoesNotExist’ cannot be found locally +<interactive>: error: [GHCi-81235] + Module ‘ThisDoesNotExist’ cannot be found locally View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/166d218bb79c1979d484c2e09073df5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/166d218bb79c1979d484c2e09073df5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26135] compiler: Export a version of `newNameCache` that is not prone to footguns.
by Zubin (＠wz1000) 24 Jun '25

24 Jun '25

Zubin pushed to branch wip/26135 at Glasgow Haskell Compiler / GHC Commits: 6997abfc by Zubin Duggal at 2025-06-24T16:32:03+05:30 compiler: Export a version of `newNameCache` that is not prone to footguns. `newNameCache` must be initialized with both a non-"reserved" unique tag, as well as a list of known key names. Failing to do so results in hard to debug unique conflicts. It is difficult for API users to tell which unique tags are safe to use. So instead of leaving this up to the user to decide, we now export a version of `newNameCache` which uses a guaranteed non-reserved unique tag. In fact, this is now the way the unique tag is initialized for all invocations of the compiler. The original version of `newNameCache` is now exported as `newNameCache'` for advanced users. We also deprecate `initNameCache` as it is also prone to footguns and is completely subsumed in functionality by `newNameCache` and `newNameCache'`. Fixes #26135 and #26055 - - - - - 3 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Types/Name/Cache.hs - testsuite/tests/hiefile/should_run/TestUtils.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,7 +245,7 @@ import GHC.Types.IPE import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Name -import GHC.Types.Name.Cache ( newNameCache, knownKeysOrigNameCache ) +import GHC.Types.Name.Cache ( newNameCache ) import GHC.Types.Name.Reader import GHC.Types.Name.Ppr import GHC.Types.TyThing @@ -322,7 +322,7 @@ newHscEnv top_dir dflags = do newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do - nc_var <- newNameCache 'r' knownKeysOrigNameCache + nc_var <- newNameCache fc_var <- initFinderCache logger <- initLogger tmpfs <- initTmpFs ===================================== compiler/GHC/Types/Name/Cache.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Types.Name.Cache ( NameCache (..) , newNameCache + , newNameCache' , initNameCache , takeUniqFromNameCache , updateNameCache' @@ -140,11 +141,27 @@ extendOrigNameCache nc mod occ name where combine _ occ_env = extendOccEnv occ_env occ name -newNameCache :: Char -> OrigNameCache -> IO NameCache -newNameCache c nc = NameCache c <$> newMVar nc +-- | Initialize a new name cache +newNameCache :: IO NameCache +newNameCache = newNameCache' 'r' knownKeysOrigNameCache +-- | This is a version of `newNameCache` that lets you supply your +-- own unique tag and set of known key names. This can go wrong if the tag +-- supplied is one reserved by GHC for internal purposes. See #26055 for +-- an example. +-- +-- Use `newNameCache` when possible. +newNameCache' :: Char -> OrigNameCache -> IO NameCache +newNameCache' c nc = NameCache c <$> newMVar nc + +-- | This takes a tag for uniques to be generated and the list of knownKeyNames +-- These must be initialized properly to ensure that names generated from this +-- NameCache do not conflict with known key names. +-- +-- Use `newNameCache` or `newNameCache'` instead +{-# DEPRECATED initNameCache "Use newNameCache or newNameCache' instead" #-} initNameCache :: Char -> [Name] -> IO NameCache -initNameCache c names = newNameCache c (initOrigNames names) +initNameCache c names = newNameCache' c (initOrigNames names) initOrigNames :: [Name] -> OrigNameCache initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names ===================================== testsuite/tests/hiefile/should_run/TestUtils.hs ===================================== @@ -25,9 +25,6 @@ import GHC.Iface.Ext.Utils import GHC.Driver.Session import GHC.SysTools -makeNc :: IO NameCache -makeNc = initNameCache 'z' [] - dynFlagsForPrinting :: String -> IO DynFlags dynFlagsForPrinting libdir = do systemSettings <- initSysTools libdir @@ -37,7 +34,7 @@ readTestHie :: FilePath -> IO (DynFlags, HieFile) readTestHie fp = do libdir:_ <- getArgs df <- dynFlagsForPrinting libdir - nc <- makeNc + nc <- newNameCache hfr <- readHieFile nc fp pure (df, hie_file_result hfr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6997abfc3ef8622eeee8d69696746bf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6997abfc3ef8622eeee8d69696746bf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26114
by Zubin (＠wz1000) 24 Jun '25

24 Jun '25

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

1 0

[Git][ghc/ghc] Pushed new branch wip/26135
by Zubin (＠wz1000) 24 Jun '25

24 Jun '25

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

1 0

[Git][ghc/ghc][master] 2 commits: rts/linker/LoadArchive: Use bool
by Marge Bot (＠marge-bot) 24 Jun '25

24 Jun '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 580a3353 by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Use bool Improve type precision by using `bool` instead of `int` and `StgBool`. - - - - - 76d1041d by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 1 changed file: - rts/linker/LoadArchive.c Changes: ===================================== rts/linker/LoadArchive.c ===================================== @@ -33,6 +33,7 @@ #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__)) + #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Read 4 bytes and convert to host byte order */ static uint32_t read4Bytes(const char buf[static 4]) @@ -40,7 +41,7 @@ static uint32_t read4Bytes(const char buf[static 4]) return ntohl(*(uint32_t*)buf); } -static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) +static bool loadFatArchive(char input[static 20], FILE* f, pathchar* path) { uint32_t nfat_arch, nfat_offset, cputype, cpusubtype; #if defined(i386_HOST_ARCH) @@ -58,8 +59,9 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) #error Unknown Darwin architecture #endif - nfat_arch = read4Bytes(tmp + 4); + nfat_arch = read4Bytes(input + 4); DEBUG_LOG("found a fat archive containing %d architectures\n", nfat_arch); + char tmp[20]; nfat_offset = 0; for (uint32_t i = 0; i < nfat_arch; i++) { /* search for the right arch */ @@ -90,6 +92,7 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } /* Read the header */ + char tmp[20]; n = fread(tmp, 1, 8, f); if (n != 8) { errorBelch("Failed reading header from `%" PATH_FMT "'", path); @@ -107,10 +110,51 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } #endif -static StgBool readThinArchiveMember(int n, int memberSize, pathchar* path, +enum ObjectFileFormat { + NotObject, + COFFAmd64, + COFFI386, + COFFAArch64, + ELF, + MachO32, + MachO64, +}; + +static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz) +{ + if (sz > 2 && ((uint16_t*)buf)[0] == 0x8664) { + return COFFAmd64; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0x014c) { + return COFFI386; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0xaa64) { + return COFFAArch64; + } + if (sz > 4 && memcmp(buf, "\x7f" "ELF", 4) == 0) { + return ELF; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedface) { + return MachO32; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) { + return MachO64; + } + return NotObject; +} + +static enum ObjectFileFormat identifyObjectFile(FILE *f) +{ + char buf[32]; + ssize_t sz = fread(buf, 1, 32, f); + CHECK(fseek(f, -sz, SEEK_CUR) == 0); + return identifyObjectFile_(buf, sz); +} + +static bool readThinArchiveMember(int n, int memberSize, pathchar* path, char* fileName, char* image) { - StgBool has_succeeded = false; + bool has_succeeded = false; FILE* member = NULL; pathchar *pathCopy, *dirName, *memberPath, *objFileName; memberPath = NULL; @@ -148,10 +192,9 @@ inner_fail: return has_succeeded; } -static StgBool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) +static bool checkFatArchive(char magic[static 4], FILE* f, pathchar* path) { - StgBool success; - success = false; + bool success = false; #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Not a standard archive, look for a fat archive magic number: */ if (read4Bytes(magic) == FAT_MAGIC) @@ -175,7 +218,7 @@ static StgBool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) * be reallocated on return; the old value is now _invalid_. * @param gnuFileIndexSize The size of the index. */ -static StgBool +static bool lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize, size_t* fileNameSize) @@ -241,47 +284,21 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, return true; } -HsInt loadArchive_ (pathchar *path) -{ - char *image = NULL; - HsInt retcode = 0; - int memberSize; - int memberIdx = 0; - FILE *f = NULL; - int n; - size_t thisFileNameSize = (size_t)-1; /* shut up bogus GCC warning */ - char *fileName; - size_t fileNameSize; - int isObject, isGnuIndex, isThin, isImportLib; - char tmp[20]; - char *gnuFileIndex; - int gnuFileIndexSize; - int misalignment = 0; - - DEBUG_LOG("start\n"); - DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); +enum ArchiveFormat { + StandardArchive, + ThinArchive, + FatArchive, +}; - /* Check that we haven't already loaded this archive. - Ignore requests to load multiple times */ - if (isAlreadyLoaded(path)) { - IF_DEBUG(linker, - debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); - return 1; /* success */ +static bool identifyArchiveFormat(FILE *f, pathchar *path, enum ArchiveFormat *out) +{ + char tmp[8]; + size_t n = fread(tmp, 1, 8, f); + if (n != 8) { + errorBelch("loadArchive: Failed reading header from `%" PATH_FMT "'", path); \ + return false; } - gnuFileIndex = NULL; - gnuFileIndexSize = 0; - - fileNameSize = 32; - fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); - - isThin = 0; - isImportLib = 0; - - f = pathopen(path, WSTR("rb")); - if (!f) - FAIL("loadObj: can't read `%" PATH_FMT "'", path); - /* Check if this is an archive by looking for the magic "!<arch>\n" * string. Usually, if this fails, we belch an error and return. On * Darwin however, we may have a fat archive, which contains archives for @@ -300,12 +317,10 @@ HsInt loadArchive_ (pathchar *path) * its magic "!<arch>\n" string and continue processing just as if * we had a single architecture archive. */ - - n = fread ( tmp, 1, 8, f ); - if (n != 8) { - FAIL("Failed reading header from `%" PATH_FMT "'", path); + if (strncmp(tmp, "!<arch>\n", 8) == 0) { + *out = StandardArchive; + return true; } - if (strncmp(tmp, "!<arch>\n", 8) == 0) {} /* Check if this is a thin archive by looking for the magic string "!<thin>\n" * * ar thin libraries have the exact same format as normal archives except they @@ -322,16 +337,59 @@ HsInt loadArchive_ (pathchar *path) * */ else if (strncmp(tmp, "!<thin>\n", 8) == 0) { - isThin = 1; + *out = ThinArchive; + return true; } else { - StgBool success = checkFatArchive(tmp, f, path); - if (!success) - goto fail; + bool success = checkFatArchive(tmp, f, path); + if (!success) { + return false; + } + *out = FatArchive; + return true; } +} + +HsInt loadArchive_ (pathchar *path) +{ + char *image = NULL; + HsInt retcode = 0; + int memberIdx = 0; + FILE *f = NULL; + size_t thisFileNameSize = (size_t) -1; /* shut up bogus GCC warning */ + int misalignment = 0; + + DEBUG_LOG("start\n"); + DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); + + /* Check that we haven't already loaded this archive. + Ignore requests to load multiple times */ + if (isAlreadyLoaded(path)) { + IF_DEBUG(linker, + debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); + return 1; /* success */ + } + + char *gnuFileIndex = NULL; + int gnuFileIndexSize = 0; + + size_t fileNameSize = 32; + char *fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = pathopen(path, WSTR("rb")); + if (!f) + FAIL("loadObj: can't read `%" PATH_FMT "'", path); + + enum ArchiveFormat archive_fmt; + if (!identifyArchiveFormat(f, path, &archive_fmt)) { + FAIL("failed to identify archive format of %" PATH_FMT ".", path); + } + bool isThin = archive_fmt == ThinArchive; + DEBUG_LOG("loading archive contents\n"); while (1) { + size_t n; DEBUG_LOG("reading at %ld\n", ftell(f)); n = fread ( fileName, 1, 16, f ); if (n != 16) { @@ -351,6 +409,7 @@ HsInt loadArchive_ (pathchar *path) } #endif + char tmp[32]; n = fread ( tmp, 1, 12, f ); if (n != 12) FAIL("Failed reading mod time from `%" PATH_FMT "'", path); @@ -369,9 +428,16 @@ HsInt loadArchive_ (pathchar *path) tmp[10] = '\0'; for (n = 0; isdigit(tmp[n]); n++); tmp[n] = '\0'; - memberSize = atoi(tmp); + size_t memberSize; + { + char *end; + memberSize = strtol(tmp, &end, 10); + if (tmp == end) { + FAIL("Failed to decode member size"); + } + } - DEBUG_LOG("size of this archive member is %d\n", memberSize); + DEBUG_LOG("size of this archive member is %zd\n", memberSize); n = fread ( tmp, 1, 2, f ); if (n != 2) FAIL("Failed reading magic from `%" PATH_FMT "'", path); @@ -379,7 +445,7 @@ HsInt loadArchive_ (pathchar *path) FAIL("Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]); - isGnuIndex = 0; + bool isGnuIndex = false; /* Check for BSD-variant large filenames */ if (0 == strncmp(fileName, "#1/", 3)) { size_t n = 0; @@ -419,7 +485,7 @@ HsInt loadArchive_ (pathchar *path) else if (0 == strncmp(fileName, "//", 2)) { fileName[0] = '\0'; thisFileNameSize = 0; - isGnuIndex = 1; + isGnuIndex = true; } /* Check for a file in the GNU file index */ else if (fileName[0] == '/') { @@ -460,12 +526,8 @@ HsInt loadArchive_ (pathchar *path) DEBUG_LOG("Found member file `%s'\n", fileName); - /* TODO: Stop relying on file extensions to determine input formats. - Instead try to match file headers. See #13103. */ - isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0) - || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0); + bool is_symbol_table = strcmp("", fileName) == 0; + enum ObjectFileFormat object_fmt = is_symbol_table ? NotObject : identifyObjectFile(f); #if defined(OBJFORMAT_PEi386) /* @@ -479,15 +541,15 @@ HsInt loadArchive_ (pathchar *path) * * Linker members (e.g. filename / are skipped since they are not needed) */ - isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; + bool isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; +#else + bool isImportLib = false; #endif // windows DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize); - DEBUG_LOG("\tisObject = %d\n", isObject); - - if (isObject) { - pathchar *archiveMemberName; + DEBUG_LOG("\tisObject = %d\n", object_fmt); + if ((!is_symbol_table && isThin) || object_fmt != NotObject) { DEBUG_LOG("Member is an object file...loading...\n"); #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -505,14 +567,13 @@ HsInt loadArchive_ (pathchar *path) image = stgMallocBytes(memberSize, "loadArchive(image)"); #endif if (isThin) { - if (!readThinArchiveMember(n, memberSize, path, - fileName, image)) { + if (!readThinArchiveMember(n, memberSize, path, fileName, image)) { goto fail; } } else { - n = fread ( image, 1, memberSize, f ); + size_t n = fread ( image, 1, memberSize, f ); if (n != memberSize) { FAIL("error whilst reading `%" PATH_FMT "'", path); } @@ -523,16 +584,18 @@ HsInt loadArchive_ (pathchar *path) // I don't understand why this extra +1 is needed here; pathprintf // should have given us the correct length but in practice it seems // to be one byte short on Win32. - archiveMemberName = stgMallocBytes((size+1+1) * sizeof(pathchar), "loadArchive(file)"); + pathchar *archiveMemberName = stgMallocBytes((size+1+1) * sizeof(pathchar), "loadArchive(file)"); pathprintf(archiveMemberName, size+1, WSTR("%" PATH_FMT "(#%d:%.*s)"), path, memberIdx, (int)thisFileNameSize, fileName); ObjectCode *oc = mkOc(STATIC_OBJECT, path, image, memberSize, false, archiveMemberName, misalignment); #if defined(OBJFORMAT_MACHO) + ASSERT(object_fmt == MachO32 || object_fmt == MachO64); ocInit_MachO( oc ); #endif #if defined(OBJFORMAT_ELF) + ASSERT(object_fmt == ELF); ocInit_ELF( oc ); #endif @@ -577,7 +640,7 @@ while reading filename from `%" PATH_FMT "'", path); "Skipping...\n"); n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } #endif @@ -588,7 +651,7 @@ while reading filename from `%" PATH_FMT "'", path); if (!isThin || thisFileNameSize == 0) { n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcf68a83980e760d95c0cb335fe774… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcf68a83980e760d95c0cb335fe774… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 5 commits: configure: Don't force value of OTOOL, etc. if not present
by Marge Bot (＠marge-bot) 24 Jun '25

24 Jun '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 83ee7b78 by Ben Gamari at 2025-06-24T05:02:07-04:00 configure: Don't force value of OTOOL, etc. if not present Previously if `otool` and `install_name_tool` were not present they would be overridden by `fp_settings.m4`. This logic was introduced in 4ff93292243888545da452ea4d4c1987f2343591 without explanation. - - - - - 9329c9e1 by Ben Gamari at 2025-06-24T05:02:07-04:00 ghc-toolchain: Add support for otool, install_name_tool Fixes part of ghc#23675. - - - - - 25f5c998 by Ben Gamari at 2025-06-24T05:02:08-04:00 ghc-toolchain: Add support for llc, opt, llvm-as Fixes #23675. - - - - - 51d150dd by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 hadrian: Use settings-use-distro-mingw directly The type `ToolchainSetting` only made sense when we had more settings to fetch from the system config file. Even then "settings-use-distro-mingw" is arguably not a toolchain setting. With the fix for #23675, all toolchain tools were moved to the `ghc-toolchain` `Toolchain` format. Therefore, we can inline `settings-use-distro-mingw` accesses and delete `ToolchainSetting`. - - - - - dcf68a83 by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 configure: Check LlvmTarget exists for LlvmAsFlags If LlvmTarget was empty, LlvmAsFlags would be just "--target=". If it is empty now, simply keep LlvmAsFlags empty. ghc-toolchain already does this right. This fix makes the two configurations match up. - - - - - 13 changed files: - distrib/configure.ac.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - m4/fp_settings.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== distrib/configure.ac.in ===================================== @@ -216,7 +216,7 @@ AC_SUBST([LlvmAsCmd]) dnl We know that `clang` supports `--target` and it is necessary to pass it dnl lest we see #25793. -if test -z "$LlvmAsFlags" ; then +if test -z "$LlvmAsFlags" && ! test -z "$LlvmTarget"; then LlvmAsFlags="--target=$LlvmTarget" fi AC_SUBST([LlvmAsFlags]) ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -38,5 +38,10 @@ Target , tgtRanlib = Nothing , tgtNm = Nm {nmProgram = Program {prgPath = "", prgFlags = []}} , tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) +, tgtLlc = Nothing +, tgtOpt = Nothing +, tgtLlvmAs = Nothing , tgtWindres = Nothing +, tgtOtool = Nothing +, tgtInstallNameTool = Nothing } ===================================== hadrian/cfg/default.target.in ===================================== @@ -38,5 +38,10 @@ Target , tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@RanlibCmd@", prgFlags = []}}) , tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} , tgtMergeObjs = @MergeObjsCmdMaybe@ +, tgtLlc = @LlcCmdMaybeProg@ +, tgtOpt = @OptCmdMaybeProg@ +, tgtLlvmAs = @LlvmAsCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ +, tgtOtool = @OtoolCmdMaybeProg@ +, tgtInstallNameTool = @InstallNameToolCmdMaybeProg@ } ===================================== hadrian/cfg/system.config.in ===================================== @@ -79,13 +79,6 @@ project-git-commit-id = @ProjectGitCommitId@ # generated by configure, to generated being by the build system. Many of these # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] - -settings-otool-command = @SettingsOtoolCommand@ -settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-llc-command = @SettingsLlcCommand@ -settings-opt-command = @SettingsOptCommand@ -settings-llvm-as-command = @SettingsLlvmAsCommand@ -settings-llvm-as-flags = @SettingsLlvmAsFlags@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ target-has-libm = @TargetHasLibm@ ===================================== hadrian/src/Builder.hs ===================================== @@ -34,7 +34,6 @@ import Base import Context import Oracles.Flag import Oracles.Setting (setting, Setting(..)) -import Oracles.Setting (settingsFileSetting, ToolchainSetting(..)) import Packages import GHC.IO.Encoding (getFileSystemEncoding) @@ -240,7 +239,7 @@ instance H.Builder Builder where Ghc _ st -> do root <- buildRoot unlitPath <- builderPath Unlit - distro_mingw <- settingsFileSetting ToolchainSetting_DistroMinGW + distro_mingw <- lookupSystemConfig "settings-use-distro-mingw" libffi_adjustors <- useLibffiForAdjustors use_system_ffi <- flag UseSystemFfi ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -2,7 +2,6 @@ module Oracles.Setting ( configFile, -- * Settings Setting (..), setting, getSetting, - ToolchainSetting (..), settingsFileSetting, -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, @@ -75,25 +74,6 @@ data Setting = CursesIncludeDir | BourneShell | EmsdkVersion --- TODO compute solely in Hadrian, removing these variables' definitions --- from aclocal.m4 whenever they can be calculated from other variables --- already fed into Hadrian. - --- | All 'ToolchainSetting's are computed by the ghc-toolchain utility for configuring toolchains. --- This used to be defined by 'FP_SETTINGS' in aclocal.m4. --- --- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain --- Move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain --- * First we will get rid of DistroMinGW when we fix the windows build -data ToolchainSetting - = ToolchainSetting_OtoolCommand - | ToolchainSetting_InstallNameToolCommand - | ToolchainSetting_LlcCommand - | ToolchainSetting_OptCommand - | ToolchainSetting_LlvmAsCommand - | ToolchainSetting_LlvmAsFlags - | ToolchainSetting_DistroMinGW - -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. setting :: Setting -> Action String @@ -134,20 +114,6 @@ setting key = lookupSystemConfig $ case key of BourneShell -> "bourne-shell" EmsdkVersion -> "emsdk-version" --- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the --- result. --- See Note [tooldir: How GHC finds mingw on Windows] --- ROMES:TODO: This should be queryTargetTargetConfig -settingsFileSetting :: ToolchainSetting -> Action String -settingsFileSetting key = lookupSystemConfig $ case key of - ToolchainSetting_OtoolCommand -> "settings-otool-command" - ToolchainSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - ToolchainSetting_LlcCommand -> "settings-llc-command" - ToolchainSetting_OptCommand -> "settings-opt-command" - ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command" - ToolchainSetting_LlvmAsFlags -> "settings-llvm-as-flags" - ToolchainSetting_DistroMinGW -> "settings-use-distro-mingw" -- ROMES:TODO: This option doesn't seem to be in ghc-toolchain yet. It corresponds to EnableDistroToolchain - -- | An expression that looks up the value of a 'Setting' in @cfg/system.config@, -- tracking the result. getSetting :: Setting -> Expr c b String ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -424,7 +424,7 @@ bindistRules = do , interpolateSetting "LlvmMinVersion" LlvmMinVersion , interpolateVar "LlvmTarget" $ getTarget tgtLlvmTarget , interpolateSetting "ProjectVersion" ProjectVersion - , interpolateVar "SettingsUseDistroMINGW" $ settingsFileSetting ToolchainSetting_DistroMinGW + , interpolateVar "SettingsUseDistroMINGW" $ lookupSystemConfig "settings-use-distro-mingw" , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode , interpolateVar "TargetHasLibm" $ lookupSystemConfig "target-has-libm" , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple @@ -508,9 +508,9 @@ generateSettings settingsFile = do , ("ar flags", queryTarget arFlags) , ("ar supports at file", queryTarget arSupportsAtFile') , ("ar supports -L", queryTarget arSupportsDashL') - , ("ranlib command", queryTarget ranlibPath) - , ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand) - , ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand) + , ("ranlib command", queryTarget ranlibPath) + , ("otool command", queryTarget otoolPath) + , ("install_name_tool command", queryTarget installNameToolPath) , ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me. , ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) @@ -525,11 +525,11 @@ generateSettings settingsFile = do , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", queryTarget (yesNo . tgtUnregisterised)) , ("LLVM target", queryTarget tgtLlvmTarget) - , ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand) - , ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand) - , ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand) - , ("LLVM llvm-as flags", expr $ settingsFileSetting ToolchainSetting_LlvmAsFlags) - , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW) + , ("LLVM llc command", queryTarget llcPath) + , ("LLVM opt command", queryTarget optPath) + , ("LLVM llvm-as command", queryTarget llvmAsPath) + , ("LLVM llvm-as flags", queryTarget llvmAsFlags) + , ("Use inplace MinGW toolchain", expr $ lookupSystemConfig "settings-use-distro-mingw") , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) @@ -571,10 +571,16 @@ generateSettings settingsFile = do linkSupportsFilelist = yesNo . ccLinkSupportsFilelist . tgtCCompilerLink linkSupportsCompactUnwind = yesNo . ccLinkSupportsCompactUnwind . tgtCCompilerLink linkIsGnu = yesNo . ccLinkIsGnu . tgtCCompilerLink + llcPath = maybe "" prgPath . tgtLlc + optPath = maybe "" prgPath . tgtOpt + llvmAsPath = maybe "" prgPath . tgtLlvmAs + llvmAsFlags = escapeArgs . maybe [] prgFlags . tgtLlvmAs arPath = prgPath . arMkArchive . tgtAr arFlags = escapeArgs . prgFlags . arMkArchive . tgtAr arSupportsAtFile' = yesNo . arSupportsAtFile . tgtAr arSupportsDashL' = yesNo . arSupportsDashL . tgtAr + otoolPath = maybe "" prgPath . tgtOtool + installNameToolPath = maybe "" prgPath . tgtInstallNameTool ranlibPath = maybe "" (prgPath . ranlibProgram) . tgtRanlib mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -127,9 +127,9 @@ inTreeCompilerArgs stg = do platform <- queryTargetTarget targetPlatformTriple wordsize <- show @Int . (*8) <$> queryTargetTarget (wordSize2Bytes . tgtWordSize) - llc_cmd <- settingsFileSetting ToolchainSetting_LlcCommand - llvm_as_cmd <- settingsFileSetting ToolchainSetting_LlvmAsCommand - have_llvm <- liftIO (all isJust <$> mapM findExecutable [llc_cmd, llvm_as_cmd]) + llc_cmd <- queryTargetTarget tgtLlc + llvm_as_cmd <- queryTargetTarget tgtLlvmAs + let have_llvm = all isJust [llc_cmd, llvm_as_cmd] top <- topDirectory ===================================== m4/fp_settings.m4 ===================================== @@ -136,14 +136,7 @@ AC_DEFUN([FP_SETTINGS], fi # Mac-only tools - if test -z "$OtoolCmd"; then - OtoolCmd="otool" - fi SettingsOtoolCommand="$OtoolCmd" - - if test -z "$InstallNameToolCmd"; then - InstallNameToolCmd="install_name_tool" - fi SettingsInstallNameToolCommand="$InstallNameToolCmd" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -107,6 +107,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs + echo "--llc=$LlcCmd" >> acargs + echo "--opt=$OptCmd" >> acargs + echo "--llvm-as=$LlvmAsCmd" >> acargs if test -n "$USER_LD"; then echo "--ld=$USER_LD" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -10,6 +10,38 @@ # This toolchain will additionally be used to validate the one generated by # ghc-toolchain. See Note [ghc-toolchain consistency checking]. +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# i.e. +# "arg1 arg2 arg3" +# ==> +# ["arg1","arg2","arg3"] +# +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + # PREP_MAYBE_SIMPLE_PROGRAM # ========================= # @@ -27,6 +59,25 @@ AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_PROGRAM +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty +# * Just (Program {prgPath = "$$1", prgFlags = [elements of $$2]}), otherwise +# +# $1 = optional program path +# $2 = program arguments +AC_DEFUN([PREP_MAYBE_PROGRAM],[ + if test -z "$$1"; then + $1MaybeProg=Nothing + else + PREP_LIST([$2]) + $1MaybeProg="Just (Program {prgPath = \"$$1\", prgFlags = $$2List})" + fi + AC_SUBST([$1MaybeProg]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -86,38 +137,6 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ AC_SUBST([Not$1Bool]) ]) -# PREP_LIST -# ============ -# -# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a -# space-separated list of args -# i.e. -# "arg1 arg2 arg3" -# ==> -# ["arg1","arg2","arg3"] -# -# $1 = list variable to substitute -dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. -AC_DEFUN([PREP_LIST],[ - # shell array - set -- $$1 - $1List="@<:@" - if test "[$]#" -eq 0; then - # no arguments - true - else - $1List="${$1List}\"[$]1\"" - shift # drop first elem - for arg in "[$]@" - do - $1List="${$1List},\"$arg\"" - done - fi - $1List="${$1List}@:>@" - - AC_SUBST([$1List]) -]) - # Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE # Prepares required substitutions to generate the target file AC_DEFUN([PREP_TARGET_FILE],[ @@ -148,7 +167,12 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([JavaScriptCPPArgs]) PREP_LIST([CmmCPPArgs]) PREP_LIST([CmmCPPArgs_STAGE0]) + PREP_MAYBE_SIMPLE_PROGRAM([LlcCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([OptCmd]) + PREP_MAYBE_PROGRAM([LlvmAsCmd], [LlvmAsFlags]) PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([OtoolCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([InstallNameToolCmd]) PREP_MAYBE_STRING([TargetVendor_CPP]) PREP_MAYBE_STRING([HostVendor_CPP]) PREP_LIST([CONF_CPP_OPTS_STAGE2]) ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -52,7 +52,12 @@ data Opts = Opts , optNm :: ProgOpt , optReadelf :: ProgOpt , optMergeObjs :: ProgOpt + , optLlc :: ProgOpt + , optOpt :: ProgOpt + , optLlvmAs :: ProgOpt , optWindres :: ProgOpt + , optOtool :: ProgOpt + , optInstallNameTool :: ProgOpt -- Note we don't actually configure LD into anything but -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt @@ -99,8 +104,13 @@ emptyOpts = Opts , optNm = po0 , optReadelf = po0 , optMergeObjs = po0 + , optLlc = po0 + , optOpt = po0 + , optLlvmAs = po0 , optWindres = po0 , optLd = po0 + , optOtool = po0 + , optInstallNameTool = po0 , optUnregisterised = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing @@ -112,7 +122,8 @@ emptyOpts = Opts po0 = emptyProgOpt _optCc, _optCxx, _optCpp, _optHsCpp, _optJsCpp, _optCmmCpp, _optCcLink, _optAr, - _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optWindres, _optLd + _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optLlc, _optOpt, _optLlvmAs, + _optWindres, _optLd, _optOtool, _optInstallNameTool :: Lens Opts ProgOpt _optCc = Lens optCc (\x o -> o {optCc=x}) _optCxx = Lens optCxx (\x o -> o {optCxx=x}) @@ -126,8 +137,13 @@ _optRanlib = Lens optRanlib (\x o -> o {optRanlib=x}) _optNm = Lens optNm (\x o -> o {optNm=x}) _optReadelf = Lens optReadelf (\x o -> o {optReadelf=x}) _optMergeObjs = Lens optMergeObjs (\x o -> o {optMergeObjs=x}) +_optLlc = Lens optLlc (\x o -> o {optLlc=x}) +_optOpt = Lens optOpt (\x o -> o {optOpt=x}) +_optLlvmAs = Lens optLlvmAs (\x o -> o {optLlvmAs=x}) _optWindres = Lens optWindres (\x o -> o {optWindres=x}) -_optLd = Lens optLd (\x o -> o {optLd= x}) +_optLd = Lens optLd (\x o -> o {optLd=x}) +_optOtool = Lens optOtool (\x o -> o {optOtool=x}) +_optInstallNameTool = Lens optInstallNameTool (\x o -> o {optInstallNameTool=x}) _optTriple :: Lens Opts (Maybe String) _optTriple = Lens optTriple (\x o -> o {optTriple=x}) @@ -183,8 +199,13 @@ options = , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs + , progOpts "llc" "LLVM llc utility" _optLlc + , progOpts "opt" "LLVM opt utility" _optOpt + , progOpts "llvm-as" "Assembler used for LLVM backend (typically clang)" _optLlvmAs , progOpts "windres" "windres utility" _optWindres , progOpts "ld" "linker" _optLd + , progOpts "otool" "otool utility" _optOtool + , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -436,6 +457,11 @@ mkTarget opts = do when (isNothing mergeObjs && not (arSupportsDashL ar)) $ throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" + -- LLVM toolchain + llc <- optional $ findProgram "llc" (optLlc opts) ["llc"] + opt <- optional $ findProgram "opt" (optOpt opts) ["opt"] + llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] + -- Windows-specific utilities windres <- case archOS_OS archOs of @@ -444,6 +470,15 @@ mkTarget opts = do return (Just windres) _ -> return Nothing + -- Darwin-specific utilities + (otool, installNameTool) <- + case archOS_OS archOs of + OSDarwin -> do + otool <- findProgram "otool" (optOtool opts) ["otool"] + installNameTool <- findProgram "install_name_tool" (optInstallNameTool opts) ["install_name_tool"] + return (Just otool, Just installNameTool) + _ -> return (Nothing, Nothing) + -- various other properties of the platform tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc @@ -480,7 +515,12 @@ mkTarget opts = do , tgtRanlib = ranlib , tgtNm = nm , tgtMergeObjs = mergeObjs + , tgtLlc = llc + , tgtOpt = opt + , tgtLlvmAs = llvmAs , tgtWindres = windres + , tgtOtool = otool + , tgtInstallNameTool = installNameTool , tgtWordSize , tgtEndianness , tgtUnregisterised ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -22,15 +22,6 @@ data WordSize = WS4 | WS8 data Endianness = LittleEndian | BigEndian deriving (Show, Read, Eq, Ord) --- TODO(#23674): Move the remaining relevant `settings-xxx` to Target: --- * llc command --- * opt command --- * install_name_tool --- * otool command --- --- Those are all things that are put into GHC's settings, and that might be --- different across targets - -- | A 'Target' consists of: -- -- * a target architecture and operating system @@ -72,8 +63,18 @@ data Target = Target , tgtMergeObjs :: Maybe MergeObjs -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@ + -- LLVM backend toolchain + , tgtLlc :: Maybe Program + , tgtOpt :: Maybe Program + , tgtLlvmAs :: Maybe Program + -- ^ assembler used to assemble LLVM backend output; typically @clang@ + -- Windows-specific tools , tgtWindres :: Maybe Program + + -- Darwin-specific tools + , tgtOtool :: Maybe Program + , tgtInstallNameTool :: Maybe Program } deriving (Read, Eq, Ord) @@ -121,6 +122,11 @@ instance Show Target where , ", tgtRanlib = " ++ show tgtRanlib , ", tgtNm = " ++ show tgtNm , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtLlc = " ++ show tgtLlc + , ", tgtOpt = " ++ show tgtOpt + , ", tgtLlvmAs = " ++ show tgtLlvmAs , ", tgtWindres = " ++ show tgtWindres + , ", tgtOtool = " ++ show tgtOtool + , ", tgtInstallNameTool = " ++ show tgtInstallNameTool , "}" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf6720eff5e86e673568e756161e6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf6720eff5e86e673568e756161e6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] rename HsThingRn to SrcCodeOrigin
by Apoorv Ingle (＠ani) 24 Jun '25

24 Jun '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: da6e83b0 by Apoorv Ingle at 2025-06-24T00:17:51-05:00 rename HsThingRn to SrcCodeOrigin - - - - - 7 changed files: - compiler/GHC/Hs.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs Changes: ===================================== compiler/GHC/Hs.hs ===================================== @@ -150,16 +150,8 @@ data HsParsedModule = HsParsedModule { -- them change (#3589) } --- All the various located syntax things that sets the user context code in TcLclEnv --- data SrcCodeOrigin = --- ExprThing (HsExpr GhcRn) --- | PatThing (LPat GhcRn) --- | StmtThing (ExprLStmt GhcRn) HsDoFlavour - --- I'm a looking at a generated thing or am I a user written thing? -data SrcCodeCtxt = UserCode | GeneratedCode HsThingRn - --- mkSrcCodeOrigin :: HsThingRn -> SrcCodeOrigin --- mkSrcCodeOrigin (OrigExpr e) = ExprThing e --- mkSrcCodeOrigin (OrigPat p) = PatThing p --- mkSrcCodeOrigin (OrigStmt s f) = StmtThing e f +-- Used in TcLclCtxt.tcl_in_gen_code to mark if the current expression +-- is a user generated code or a compiler generated expansion of some user written code +data SrcCodeCtxt + = UserCode + | GeneratedCode SrcCodeOrigin ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -672,12 +672,13 @@ type instance XXExpr GhcTc = XXExprGhcTc -- | The different source constructs that we use to instantiate the "original" field -- in an `XXExprGhcRn original expansion` -- See Note [Handling overloaded and rebindable constructs] in `GHC.Rename.Expr` -data HsThingRn = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression - | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from - | OrigPat (LPat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints +data SrcCodeOrigin + = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression + | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from + | OrigPat (LPat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints data XXExprGhcRn - = ExpandedThingRn { xrn_orig :: HsThingRn -- The original source thing to be used for error messages + = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages , xrn_expanded :: HsExpr GhcRn -- The compiler generated expanded thing } @@ -718,7 +719,7 @@ data XXExprGhcTc | ExpandedThingTc -- See Note [Rebindable syntax and XXExprGhcRn] -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do` - { xtc_orig :: HsThingRn -- The original user written thing + { xtc_orig :: SrcCodeOrigin -- The original user written thing , xtc_expanded :: HsExpr GhcTc } -- The expanded typechecked expression | ConLikeTc -- Result of typechecking a data-con @@ -752,10 +753,10 @@ mkExpandedExprTc :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcTc -- ^ expanded typechecked expression -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedExprTc oExpr eExpr = XExpr (ExpandedThingTc (OrigExpr oExpr) eExpr) +mkExpandedExprTc oExpr eExpr = mkExpandedTc (OrigExpr oExpr) eExpr mkExpandedTc - :: HsThingRn -- ^ source do statement + :: SrcCodeOrigin -- ^ source, user written do statement/expression -> HsExpr GhcTc -- ^ expanded typechecked expression -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' mkExpandedTc o e = XExpr (ExpandedThingTc o e) @@ -1020,7 +1021,7 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x -instance Outputable HsThingRn where +instance Outputable SrcCodeOrigin where ppr thing = case thing of OrigExpr x -> ppr_builder "<OrigExpr>:" x @@ -1087,7 +1088,7 @@ ppr_infix_expr_tc (HsTick {}) = Nothing ppr_infix_expr_tc (HsBinTick {}) = Nothing ppr_infix_expr_tc (HsRecSelTc f) = Just (pprInfixOcc f) -ppr_infix_hs_expansion :: HsThingRn -> Maybe SDoc +ppr_infix_hs_expansion :: SrcCodeOrigin -> Maybe SDoc ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e ppr_infix_hs_expansion _ = Nothing @@ -1195,7 +1196,7 @@ hsExprNeedsParens prec = go go_x_rn (PopErrCtxt a) = hsExprNeedsParens prec a go_x_rn (HsRecSelRn{}) = False - hsExpandedNeedsParens :: HsThingRn -> Bool + hsExpandedNeedsParens :: SrcCodeOrigin -> Bool hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e hsExpandedNeedsParens _ = False @@ -1248,7 +1249,7 @@ isAtomicHsExpr (XExpr x) go_x_rn (PopErrCtxt a) = isAtomicHsExpr a go_x_rn (HsRecSelRn{}) = True - isAtomicExpandedThingRn :: HsThingRn -> Bool + isAtomicExpandedThingRn :: SrcCodeOrigin -> Bool isAtomicExpandedThingRn (OrigExpr e) = isAtomicHsExpr e isAtomicExpandedThingRn _ = False ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -591,7 +591,7 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- -deriving instance Data HsThingRn +deriving instance Data SrcCodeOrigin deriving instance Data XXExprGhcRn deriving instance Data a => Data (WithUserRdr a) ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -611,7 +611,7 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts)) ListComp -> Just $ BinBox QualBinBox _ -> Nothing --- addTickHsExpanded :: HsThingRn -> HsExpr GhcTc -> TM (HsExpr GhcTc) +-- addTickHsExpanded :: SrcCodeOrigin -> HsExpr GhcTc -> TM (HsExpr GhcTc) -- addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of -- -- We always want statements to get a tick, so we can step over each one. -- -- To avoid duplicates we blacklist SrcSpans we already inserted here. ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -5306,11 +5306,9 @@ pprArising :: CtLoc -> SDoc -- We've done special processing for TypeEq, KindEq, givens pprArising ct_loc | suppress_origin = empty - | in_generated_code = pprCtOrigin orig -- TODO ANI: maybe should go way | otherwise = pprCtOrigin orig where orig = ctLocOrigin ct_loc - in_generated_code = ctLocEnvInGeneratedCode (ctLocEnv ct_loc) suppress_origin | isGivenOrigin orig = True | otherwise = case orig of ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -763,18 +763,18 @@ exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression" exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms] exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms] exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms] -exprCtOrigin (XExpr (ExpandedThingRn {})) = Shouldn'tHappenOrigin "XExpr ExpandedThingRn" +exprCtOrigin (XExpr (ExpandedThingRn o _)) = srcCodeOriginCtOrigin o exprCtOrigin (XExpr (PopErrCtxt e)) = exprCtOrigin e exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel (foExt f) -hsThingCtOrigin :: HsThingRn -> CtOrigin -hsThingCtOrigin (OrigExpr e) = exprCtOrigin e -hsThingCtOrigin (OrigStmt{}) = DoStmtOrigin -hsThingCtOrigin (OrigPat p) = DoPatOrigin p +srcCodeOriginCtOrigin :: SrcCodeOrigin -> CtOrigin +srcCodeOriginCtOrigin (OrigExpr e) = exprCtOrigin e +srcCodeOriginCtOrigin (OrigStmt{}) = DoStmtOrigin +srcCodeOriginCtOrigin (OrigPat p) = DoPatOrigin p srcCodeCtxtCtOrigin :: HsExpr GhcRn -> SrcCodeCtxt -> CtOrigin srcCodeCtxtCtOrigin e UserCode = exprCtOrigin e -srcCodeCtxtCtOrigin _ (GeneratedCode e) = hsThingCtOrigin e +srcCodeCtxtCtOrigin _ (GeneratedCode e) = srcCodeOriginCtOrigin e -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -990,9 +990,9 @@ getSrcCodeCtxt = getLclEnvSrcCodeCtxt <$> getLclEnv -- | Mark the inner computation as being done inside generated code. -- -- See Note [Error contexts in generated code] -setInGeneratedCode :: HsThingRn -> TcRn a -> TcRn a -setInGeneratedCode syntax_thing thing_inside = - updLclCtxt (setLclCtxtSrcCodeCtxt (GeneratedCode syntax_thing)) thing_inside +setInGeneratedCode :: SrcCodeOrigin -> TcRn a -> TcRn a +setInGeneratedCode scOrig thing_inside = + updLclCtxt (setLclCtxtSrcCodeCtxt (GeneratedCode scOrig)) thing_inside setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a setSrcSpanA l = setSrcSpan (locA l) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da6e83b044e60a5a4bd8cf249582b21… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da6e83b044e60a5a4bd8cf249582b21… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 2 commits: accept the right test output
by Apoorv Ingle (＠ani) 24 Jun '25

24 Jun '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 0b60a5d1 by Apoorv Ingle at 2025-06-23T23:45:45-05:00 accept the right test output - - - - - e74f1260 by Apoorv Ingle at 2025-06-23T23:54:47-05:00 make make sure to set inGenerated code for RecordUpdate checks - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/printer/T17697.stderr Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -650,20 +650,20 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr do { -- Expand the record update. See Note [Record Updates]. ; (ds_expr, ds_res_ty, err_ctxt) <- expandRecordUpd record_expr possible_parents rbnds res_ty - - -- Typecheck the expanded expression. - ; expr' <- addErrCtxt err_ctxt $ - setInGeneratedCode (OrigExpr expr) $ - tcExpr ds_expr (Check ds_res_ty) - -- NB: it's important to use ds_res_ty and not res_ty here. - -- Test case: T18802b. - - ; addErrCtxt err_ctxt $ tcWrapResultMono expr expr' ds_res_ty res_ty - -- We need to unify the result type of the expanded - -- expression with the expected result type. - -- - -- See Note [Unifying result types in tcRecordUpd]. - -- Test case: T10808. + ; addErrCtxt err_ctxt $ + setInGeneratedCode (OrigExpr expr) $ + do { -- Typecheck the expanded expression. + expr' <- tcExpr ds_expr (Check ds_res_ty) + -- NB: it's important to use ds_res_ty and not res_ty here. + -- Test case: T18802b. + + ; tcWrapResultMono expr expr' ds_res_ty res_ty + -- We need to unify the result type of the expanded + -- expression with the expected result type. + -- + -- See Note [Unifying result types in tcRecordUpd]. + -- Test case: T10808. + } } tcExpr e@(RecordUpd { rupd_flds = OverloadedRecUpdFields {}}) _ ===================================== testsuite/tests/printer/T17697.stderr ===================================== @@ -1,7 +1,3 @@ -T17697.hs:5:8: warning: [GHC-81995] [-Wunused-do-bind (in -Wall)] - A do-notation statement discarded a result of type - ‘GHC.Internal.Types.ZonkAny 1’ - Suggested fix: Suppress this warning by saying ‘_ <- threadDelay 1’ - T17697.hs:6:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)] Variable not in scope: threadDelay :: t0 -> IO a0 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7282035491eb8210ccb78544a1d041… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7282035491eb8210ccb78544a1d041… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: configure: Don't force value of OTOOL, etc. if not present
by Marge Bot (＠marge-bot) 23 Jun '25

23 Jun '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 83bf9f4a by Ben Gamari at 2025-06-23T23:11:42-04:00 configure: Don't force value of OTOOL, etc. if not present Previously if `otool` and `install_name_tool` were not present they would be overridden by `fp_settings.m4`. This logic was introduced in 4ff93292243888545da452ea4d4c1987f2343591 without explanation. - - - - - 72e42f55 by Ben Gamari at 2025-06-23T23:11:42-04:00 ghc-toolchain: Add support for otool, install_name_tool Fixes part of ghc#23675. - - - - - 03c3a06f by Ben Gamari at 2025-06-23T23:11:42-04:00 ghc-toolchain: Add support for llc, opt, llvm-as Fixes #23675. - - - - - f1d3df62 by Rodrigo Mesquita at 2025-06-23T23:11:42-04:00 hadrian: Use settings-use-distro-mingw directly The type `ToolchainSetting` only made sense when we had more settings to fetch from the system config file. Even then "settings-use-distro-mingw" is arguably not a toolchain setting. With the fix for #23675, all toolchain tools were moved to the `ghc-toolchain` `Toolchain` format. Therefore, we can inline `settings-use-distro-mingw` accesses and delete `ToolchainSetting`. - - - - - d3ea8b38 by Rodrigo Mesquita at 2025-06-23T23:11:42-04:00 configure: Check LlvmTarget exists for LlvmAsFlags If LlvmTarget was empty, LlvmAsFlags would be just "--target=". If it is empty now, simply keep LlvmAsFlags empty. ghc-toolchain already does this right. This fix makes the two configurations match up. - - - - - 3de4061c by Ben Gamari at 2025-06-23T23:11:43-04:00 rts/linker/LoadArchive: Use bool Improve type precision by using `bool` instead of `int` and `StgBool`. - - - - - bbfc1f7d by Ben Gamari at 2025-06-23T23:11:43-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 14 changed files: - distrib/configure.ac.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - m4/fp_settings.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - rts/linker/LoadArchive.c - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== distrib/configure.ac.in ===================================== @@ -216,7 +216,7 @@ AC_SUBST([LlvmAsCmd]) dnl We know that `clang` supports `--target` and it is necessary to pass it dnl lest we see #25793. -if test -z "$LlvmAsFlags" ; then +if test -z "$LlvmAsFlags" && ! test -z "$LlvmTarget"; then LlvmAsFlags="--target=$LlvmTarget" fi AC_SUBST([LlvmAsFlags]) ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -38,5 +38,10 @@ Target , tgtRanlib = Nothing , tgtNm = Nm {nmProgram = Program {prgPath = "", prgFlags = []}} , tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) +, tgtLlc = Nothing +, tgtOpt = Nothing +, tgtLlvmAs = Nothing , tgtWindres = Nothing +, tgtOtool = Nothing +, tgtInstallNameTool = Nothing } ===================================== hadrian/cfg/default.target.in ===================================== @@ -38,5 +38,10 @@ Target , tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@RanlibCmd@", prgFlags = []}}) , tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} , tgtMergeObjs = @MergeObjsCmdMaybe@ +, tgtLlc = @LlcCmdMaybeProg@ +, tgtOpt = @OptCmdMaybeProg@ +, tgtLlvmAs = @LlvmAsCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ +, tgtOtool = @OtoolCmdMaybeProg@ +, tgtInstallNameTool = @InstallNameToolCmdMaybeProg@ } ===================================== hadrian/cfg/system.config.in ===================================== @@ -79,13 +79,6 @@ project-git-commit-id = @ProjectGitCommitId@ # generated by configure, to generated being by the build system. Many of these # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] - -settings-otool-command = @SettingsOtoolCommand@ -settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-llc-command = @SettingsLlcCommand@ -settings-opt-command = @SettingsOptCommand@ -settings-llvm-as-command = @SettingsLlvmAsCommand@ -settings-llvm-as-flags = @SettingsLlvmAsFlags@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ target-has-libm = @TargetHasLibm@ ===================================== hadrian/src/Builder.hs ===================================== @@ -34,7 +34,6 @@ import Base import Context import Oracles.Flag import Oracles.Setting (setting, Setting(..)) -import Oracles.Setting (settingsFileSetting, ToolchainSetting(..)) import Packages import GHC.IO.Encoding (getFileSystemEncoding) @@ -240,7 +239,7 @@ instance H.Builder Builder where Ghc _ st -> do root <- buildRoot unlitPath <- builderPath Unlit - distro_mingw <- settingsFileSetting ToolchainSetting_DistroMinGW + distro_mingw <- lookupSystemConfig "settings-use-distro-mingw" libffi_adjustors <- useLibffiForAdjustors use_system_ffi <- flag UseSystemFfi ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -2,7 +2,6 @@ module Oracles.Setting ( configFile, -- * Settings Setting (..), setting, getSetting, - ToolchainSetting (..), settingsFileSetting, -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, @@ -75,25 +74,6 @@ data Setting = CursesIncludeDir | BourneShell | EmsdkVersion --- TODO compute solely in Hadrian, removing these variables' definitions --- from aclocal.m4 whenever they can be calculated from other variables --- already fed into Hadrian. - --- | All 'ToolchainSetting's are computed by the ghc-toolchain utility for configuring toolchains. --- This used to be defined by 'FP_SETTINGS' in aclocal.m4. --- --- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain --- Move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain --- * First we will get rid of DistroMinGW when we fix the windows build -data ToolchainSetting - = ToolchainSetting_OtoolCommand - | ToolchainSetting_InstallNameToolCommand - | ToolchainSetting_LlcCommand - | ToolchainSetting_OptCommand - | ToolchainSetting_LlvmAsCommand - | ToolchainSetting_LlvmAsFlags - | ToolchainSetting_DistroMinGW - -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. setting :: Setting -> Action String @@ -134,20 +114,6 @@ setting key = lookupSystemConfig $ case key of BourneShell -> "bourne-shell" EmsdkVersion -> "emsdk-version" --- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the --- result. --- See Note [tooldir: How GHC finds mingw on Windows] --- ROMES:TODO: This should be queryTargetTargetConfig -settingsFileSetting :: ToolchainSetting -> Action String -settingsFileSetting key = lookupSystemConfig $ case key of - ToolchainSetting_OtoolCommand -> "settings-otool-command" - ToolchainSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - ToolchainSetting_LlcCommand -> "settings-llc-command" - ToolchainSetting_OptCommand -> "settings-opt-command" - ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command" - ToolchainSetting_LlvmAsFlags -> "settings-llvm-as-flags" - ToolchainSetting_DistroMinGW -> "settings-use-distro-mingw" -- ROMES:TODO: This option doesn't seem to be in ghc-toolchain yet. It corresponds to EnableDistroToolchain - -- | An expression that looks up the value of a 'Setting' in @cfg/system.config@, -- tracking the result. getSetting :: Setting -> Expr c b String ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -424,7 +424,7 @@ bindistRules = do , interpolateSetting "LlvmMinVersion" LlvmMinVersion , interpolateVar "LlvmTarget" $ getTarget tgtLlvmTarget , interpolateSetting "ProjectVersion" ProjectVersion - , interpolateVar "SettingsUseDistroMINGW" $ settingsFileSetting ToolchainSetting_DistroMinGW + , interpolateVar "SettingsUseDistroMINGW" $ lookupSystemConfig "settings-use-distro-mingw" , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode , interpolateVar "TargetHasLibm" $ lookupSystemConfig "target-has-libm" , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple @@ -508,9 +508,9 @@ generateSettings settingsFile = do , ("ar flags", queryTarget arFlags) , ("ar supports at file", queryTarget arSupportsAtFile') , ("ar supports -L", queryTarget arSupportsDashL') - , ("ranlib command", queryTarget ranlibPath) - , ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand) - , ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand) + , ("ranlib command", queryTarget ranlibPath) + , ("otool command", queryTarget otoolPath) + , ("install_name_tool command", queryTarget installNameToolPath) , ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me. , ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) @@ -525,11 +525,11 @@ generateSettings settingsFile = do , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", queryTarget (yesNo . tgtUnregisterised)) , ("LLVM target", queryTarget tgtLlvmTarget) - , ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand) - , ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand) - , ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand) - , ("LLVM llvm-as flags", expr $ settingsFileSetting ToolchainSetting_LlvmAsFlags) - , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW) + , ("LLVM llc command", queryTarget llcPath) + , ("LLVM opt command", queryTarget optPath) + , ("LLVM llvm-as command", queryTarget llvmAsPath) + , ("LLVM llvm-as flags", queryTarget llvmAsFlags) + , ("Use inplace MinGW toolchain", expr $ lookupSystemConfig "settings-use-distro-mingw") , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) @@ -571,10 +571,16 @@ generateSettings settingsFile = do linkSupportsFilelist = yesNo . ccLinkSupportsFilelist . tgtCCompilerLink linkSupportsCompactUnwind = yesNo . ccLinkSupportsCompactUnwind . tgtCCompilerLink linkIsGnu = yesNo . ccLinkIsGnu . tgtCCompilerLink + llcPath = maybe "" prgPath . tgtLlc + optPath = maybe "" prgPath . tgtOpt + llvmAsPath = maybe "" prgPath . tgtLlvmAs + llvmAsFlags = escapeArgs . maybe [] prgFlags . tgtLlvmAs arPath = prgPath . arMkArchive . tgtAr arFlags = escapeArgs . prgFlags . arMkArchive . tgtAr arSupportsAtFile' = yesNo . arSupportsAtFile . tgtAr arSupportsDashL' = yesNo . arSupportsDashL . tgtAr + otoolPath = maybe "" prgPath . tgtOtool + installNameToolPath = maybe "" prgPath . tgtInstallNameTool ranlibPath = maybe "" (prgPath . ranlibProgram) . tgtRanlib mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -127,9 +127,9 @@ inTreeCompilerArgs stg = do platform <- queryTargetTarget targetPlatformTriple wordsize <- show @Int . (*8) <$> queryTargetTarget (wordSize2Bytes . tgtWordSize) - llc_cmd <- settingsFileSetting ToolchainSetting_LlcCommand - llvm_as_cmd <- settingsFileSetting ToolchainSetting_LlvmAsCommand - have_llvm <- liftIO (all isJust <$> mapM findExecutable [llc_cmd, llvm_as_cmd]) + llc_cmd <- queryTargetTarget tgtLlc + llvm_as_cmd <- queryTargetTarget tgtLlvmAs + let have_llvm = all isJust [llc_cmd, llvm_as_cmd] top <- topDirectory ===================================== m4/fp_settings.m4 ===================================== @@ -136,14 +136,7 @@ AC_DEFUN([FP_SETTINGS], fi # Mac-only tools - if test -z "$OtoolCmd"; then - OtoolCmd="otool" - fi SettingsOtoolCommand="$OtoolCmd" - - if test -z "$InstallNameToolCmd"; then - InstallNameToolCmd="install_name_tool" - fi SettingsInstallNameToolCommand="$InstallNameToolCmd" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -107,6 +107,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs + echo "--llc=$LlcCmd" >> acargs + echo "--opt=$OptCmd" >> acargs + echo "--llvm-as=$LlvmAsCmd" >> acargs if test -n "$USER_LD"; then echo "--ld=$USER_LD" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -10,6 +10,38 @@ # This toolchain will additionally be used to validate the one generated by # ghc-toolchain. See Note [ghc-toolchain consistency checking]. +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# i.e. +# "arg1 arg2 arg3" +# ==> +# ["arg1","arg2","arg3"] +# +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + # PREP_MAYBE_SIMPLE_PROGRAM # ========================= # @@ -27,6 +59,25 @@ AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_PROGRAM +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty +# * Just (Program {prgPath = "$$1", prgFlags = [elements of $$2]}), otherwise +# +# $1 = optional program path +# $2 = program arguments +AC_DEFUN([PREP_MAYBE_PROGRAM],[ + if test -z "$$1"; then + $1MaybeProg=Nothing + else + PREP_LIST([$2]) + $1MaybeProg="Just (Program {prgPath = \"$$1\", prgFlags = $$2List})" + fi + AC_SUBST([$1MaybeProg]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -86,38 +137,6 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ AC_SUBST([Not$1Bool]) ]) -# PREP_LIST -# ============ -# -# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a -# space-separated list of args -# i.e. -# "arg1 arg2 arg3" -# ==> -# ["arg1","arg2","arg3"] -# -# $1 = list variable to substitute -dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. -AC_DEFUN([PREP_LIST],[ - # shell array - set -- $$1 - $1List="@<:@" - if test "[$]#" -eq 0; then - # no arguments - true - else - $1List="${$1List}\"[$]1\"" - shift # drop first elem - for arg in "[$]@" - do - $1List="${$1List},\"$arg\"" - done - fi - $1List="${$1List}@:>@" - - AC_SUBST([$1List]) -]) - # Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE # Prepares required substitutions to generate the target file AC_DEFUN([PREP_TARGET_FILE],[ @@ -148,7 +167,12 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([JavaScriptCPPArgs]) PREP_LIST([CmmCPPArgs]) PREP_LIST([CmmCPPArgs_STAGE0]) + PREP_MAYBE_SIMPLE_PROGRAM([LlcCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([OptCmd]) + PREP_MAYBE_PROGRAM([LlvmAsCmd], [LlvmAsFlags]) PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([OtoolCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([InstallNameToolCmd]) PREP_MAYBE_STRING([TargetVendor_CPP]) PREP_MAYBE_STRING([HostVendor_CPP]) PREP_LIST([CONF_CPP_OPTS_STAGE2]) ===================================== rts/linker/LoadArchive.c ===================================== @@ -33,6 +33,7 @@ #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__)) + #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Read 4 bytes and convert to host byte order */ static uint32_t read4Bytes(const char buf[static 4]) @@ -40,7 +41,7 @@ static uint32_t read4Bytes(const char buf[static 4]) return ntohl(*(uint32_t*)buf); } -static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) +static bool loadFatArchive(char input[static 20], FILE* f, pathchar* path) { uint32_t nfat_arch, nfat_offset, cputype, cpusubtype; #if defined(i386_HOST_ARCH) @@ -58,8 +59,9 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) #error Unknown Darwin architecture #endif - nfat_arch = read4Bytes(tmp + 4); + nfat_arch = read4Bytes(input + 4); DEBUG_LOG("found a fat archive containing %d architectures\n", nfat_arch); + char tmp[20]; nfat_offset = 0; for (uint32_t i = 0; i < nfat_arch; i++) { /* search for the right arch */ @@ -90,6 +92,7 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } /* Read the header */ + char tmp[20]; n = fread(tmp, 1, 8, f); if (n != 8) { errorBelch("Failed reading header from `%" PATH_FMT "'", path); @@ -107,10 +110,51 @@ static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } #endif -static StgBool readThinArchiveMember(int n, int memberSize, pathchar* path, +enum ObjectFileFormat { + NotObject, + COFFAmd64, + COFFI386, + COFFAArch64, + ELF, + MachO32, + MachO64, +}; + +static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz) +{ + if (sz > 2 && ((uint16_t*)buf)[0] == 0x8664) { + return COFFAmd64; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0x014c) { + return COFFI386; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0xaa64) { + return COFFAArch64; + } + if (sz > 4 && memcmp(buf, "\x7f" "ELF", 4) == 0) { + return ELF; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedface) { + return MachO32; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) { + return MachO64; + } + return NotObject; +} + +static enum ObjectFileFormat identifyObjectFile(FILE *f) +{ + char buf[32]; + ssize_t sz = fread(buf, 1, 32, f); + CHECK(fseek(f, -sz, SEEK_CUR) == 0); + return identifyObjectFile_(buf, sz); +} + +static bool readThinArchiveMember(int n, int memberSize, pathchar* path, char* fileName, char* image) { - StgBool has_succeeded = false; + bool has_succeeded = false; FILE* member = NULL; pathchar *pathCopy, *dirName, *memberPath, *objFileName; memberPath = NULL; @@ -148,10 +192,9 @@ inner_fail: return has_succeeded; } -static StgBool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) +static bool checkFatArchive(char magic[static 4], FILE* f, pathchar* path) { - StgBool success; - success = false; + bool success = false; #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Not a standard archive, look for a fat archive magic number: */ if (read4Bytes(magic) == FAT_MAGIC) @@ -175,7 +218,7 @@ static StgBool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) * be reallocated on return; the old value is now _invalid_. * @param gnuFileIndexSize The size of the index. */ -static StgBool +static bool lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize, size_t* fileNameSize) @@ -241,47 +284,21 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, return true; } -HsInt loadArchive_ (pathchar *path) -{ - char *image = NULL; - HsInt retcode = 0; - int memberSize; - int memberIdx = 0; - FILE *f = NULL; - int n; - size_t thisFileNameSize = (size_t)-1; /* shut up bogus GCC warning */ - char *fileName; - size_t fileNameSize; - int isObject, isGnuIndex, isThin, isImportLib; - char tmp[20]; - char *gnuFileIndex; - int gnuFileIndexSize; - int misalignment = 0; - - DEBUG_LOG("start\n"); - DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); +enum ArchiveFormat { + StandardArchive, + ThinArchive, + FatArchive, +}; - /* Check that we haven't already loaded this archive. - Ignore requests to load multiple times */ - if (isAlreadyLoaded(path)) { - IF_DEBUG(linker, - debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); - return 1; /* success */ +static bool identifyArchiveFormat(FILE *f, pathchar *path, enum ArchiveFormat *out) +{ + char tmp[8]; + size_t n = fread(tmp, 1, 8, f); + if (n != 8) { + errorBelch("loadArchive: Failed reading header from `%" PATH_FMT "'", path); \ + return false; } - gnuFileIndex = NULL; - gnuFileIndexSize = 0; - - fileNameSize = 32; - fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); - - isThin = 0; - isImportLib = 0; - - f = pathopen(path, WSTR("rb")); - if (!f) - FAIL("loadObj: can't read `%" PATH_FMT "'", path); - /* Check if this is an archive by looking for the magic "!<arch>\n" * string. Usually, if this fails, we belch an error and return. On * Darwin however, we may have a fat archive, which contains archives for @@ -300,12 +317,10 @@ HsInt loadArchive_ (pathchar *path) * its magic "!<arch>\n" string and continue processing just as if * we had a single architecture archive. */ - - n = fread ( tmp, 1, 8, f ); - if (n != 8) { - FAIL("Failed reading header from `%" PATH_FMT "'", path); + if (strncmp(tmp, "!<arch>\n", 8) == 0) { + *out = StandardArchive; + return true; } - if (strncmp(tmp, "!<arch>\n", 8) == 0) {} /* Check if this is a thin archive by looking for the magic string "!<thin>\n" * * ar thin libraries have the exact same format as normal archives except they @@ -322,16 +337,59 @@ HsInt loadArchive_ (pathchar *path) * */ else if (strncmp(tmp, "!<thin>\n", 8) == 0) { - isThin = 1; + *out = ThinArchive; + return true; } else { - StgBool success = checkFatArchive(tmp, f, path); - if (!success) - goto fail; + bool success = checkFatArchive(tmp, f, path); + if (!success) { + return false; + } + *out = FatArchive; + return true; } +} + +HsInt loadArchive_ (pathchar *path) +{ + char *image = NULL; + HsInt retcode = 0; + int memberIdx = 0; + FILE *f = NULL; + size_t thisFileNameSize = (size_t) -1; /* shut up bogus GCC warning */ + int misalignment = 0; + + DEBUG_LOG("start\n"); + DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); + + /* Check that we haven't already loaded this archive. + Ignore requests to load multiple times */ + if (isAlreadyLoaded(path)) { + IF_DEBUG(linker, + debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); + return 1; /* success */ + } + + char *gnuFileIndex = NULL; + int gnuFileIndexSize = 0; + + size_t fileNameSize = 32; + char *fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = pathopen(path, WSTR("rb")); + if (!f) + FAIL("loadObj: can't read `%" PATH_FMT "'", path); + + enum ArchiveFormat archive_fmt; + if (!identifyArchiveFormat(f, path, &archive_fmt)) { + FAIL("failed to identify archive format of %" PATH_FMT ".", path); + } + bool isThin = archive_fmt == ThinArchive; + DEBUG_LOG("loading archive contents\n"); while (1) { + size_t n; DEBUG_LOG("reading at %ld\n", ftell(f)); n = fread ( fileName, 1, 16, f ); if (n != 16) { @@ -351,6 +409,7 @@ HsInt loadArchive_ (pathchar *path) } #endif + char tmp[32]; n = fread ( tmp, 1, 12, f ); if (n != 12) FAIL("Failed reading mod time from `%" PATH_FMT "'", path); @@ -369,9 +428,16 @@ HsInt loadArchive_ (pathchar *path) tmp[10] = '\0'; for (n = 0; isdigit(tmp[n]); n++); tmp[n] = '\0'; - memberSize = atoi(tmp); + size_t memberSize; + { + char *end; + memberSize = strtol(tmp, &end, 10); + if (tmp == end) { + FAIL("Failed to decode member size"); + } + } - DEBUG_LOG("size of this archive member is %d\n", memberSize); + DEBUG_LOG("size of this archive member is %zd\n", memberSize); n = fread ( tmp, 1, 2, f ); if (n != 2) FAIL("Failed reading magic from `%" PATH_FMT "'", path); @@ -379,7 +445,7 @@ HsInt loadArchive_ (pathchar *path) FAIL("Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]); - isGnuIndex = 0; + bool isGnuIndex = false; /* Check for BSD-variant large filenames */ if (0 == strncmp(fileName, "#1/", 3)) { size_t n = 0; @@ -419,7 +485,7 @@ HsInt loadArchive_ (pathchar *path) else if (0 == strncmp(fileName, "//", 2)) { fileName[0] = '\0'; thisFileNameSize = 0; - isGnuIndex = 1; + isGnuIndex = true; } /* Check for a file in the GNU file index */ else if (fileName[0] == '/') { @@ -460,12 +526,8 @@ HsInt loadArchive_ (pathchar *path) DEBUG_LOG("Found member file `%s'\n", fileName); - /* TODO: Stop relying on file extensions to determine input formats. - Instead try to match file headers. See #13103. */ - isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0) - || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0); + bool is_symbol_table = strcmp("", fileName) == 0; + enum ObjectFileFormat object_fmt = is_symbol_table ? NotObject : identifyObjectFile(f); #if defined(OBJFORMAT_PEi386) /* @@ -479,15 +541,15 @@ HsInt loadArchive_ (pathchar *path) * * Linker members (e.g. filename / are skipped since they are not needed) */ - isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; + bool isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; +#else + bool isImportLib = false; #endif // windows DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize); - DEBUG_LOG("\tisObject = %d\n", isObject); - - if (isObject) { - pathchar *archiveMemberName; + DEBUG_LOG("\tisObject = %d\n", object_fmt); + if ((!is_symbol_table && isThin) || object_fmt != NotObject) { DEBUG_LOG("Member is an object file...loading...\n"); #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -505,14 +567,13 @@ HsInt loadArchive_ (pathchar *path) image = stgMallocBytes(memberSize, "loadArchive(image)"); #endif if (isThin) { - if (!readThinArchiveMember(n, memberSize, path, - fileName, image)) { + if (!readThinArchiveMember(n, memberSize, path, fileName, image)) { goto fail; } } else { - n = fread ( image, 1, memberSize, f ); + size_t n = fread ( image, 1, memberSize, f ); if (n != memberSize) { FAIL("error whilst reading `%" PATH_FMT "'", path); } @@ -523,16 +584,18 @@ HsInt loadArchive_ (pathchar *path) // I don't understand why this extra +1 is needed here; pathprintf // should have given us the correct length but in practice it seems // to be one byte short on Win32. - archiveMemberName = stgMallocBytes((size+1+1) * sizeof(pathchar), "loadArchive(file)"); + pathchar *archiveMemberName = stgMallocBytes((size+1+1) * sizeof(pathchar), "loadArchive(file)"); pathprintf(archiveMemberName, size+1, WSTR("%" PATH_FMT "(#%d:%.*s)"), path, memberIdx, (int)thisFileNameSize, fileName); ObjectCode *oc = mkOc(STATIC_OBJECT, path, image, memberSize, false, archiveMemberName, misalignment); #if defined(OBJFORMAT_MACHO) + ASSERT(object_fmt == MachO32 || object_fmt == MachO64); ocInit_MachO( oc ); #endif #if defined(OBJFORMAT_ELF) + ASSERT(object_fmt == ELF); ocInit_ELF( oc ); #endif @@ -577,7 +640,7 @@ while reading filename from `%" PATH_FMT "'", path); "Skipping...\n"); n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } #endif @@ -588,7 +651,7 @@ while reading filename from `%" PATH_FMT "'", path); if (!isThin || thisFileNameSize == 0) { n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } } ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -52,7 +52,12 @@ data Opts = Opts , optNm :: ProgOpt , optReadelf :: ProgOpt , optMergeObjs :: ProgOpt + , optLlc :: ProgOpt + , optOpt :: ProgOpt + , optLlvmAs :: ProgOpt , optWindres :: ProgOpt + , optOtool :: ProgOpt + , optInstallNameTool :: ProgOpt -- Note we don't actually configure LD into anything but -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt @@ -99,8 +104,13 @@ emptyOpts = Opts , optNm = po0 , optReadelf = po0 , optMergeObjs = po0 + , optLlc = po0 + , optOpt = po0 + , optLlvmAs = po0 , optWindres = po0 , optLd = po0 + , optOtool = po0 + , optInstallNameTool = po0 , optUnregisterised = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing @@ -112,7 +122,8 @@ emptyOpts = Opts po0 = emptyProgOpt _optCc, _optCxx, _optCpp, _optHsCpp, _optJsCpp, _optCmmCpp, _optCcLink, _optAr, - _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optWindres, _optLd + _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optLlc, _optOpt, _optLlvmAs, + _optWindres, _optLd, _optOtool, _optInstallNameTool :: Lens Opts ProgOpt _optCc = Lens optCc (\x o -> o {optCc=x}) _optCxx = Lens optCxx (\x o -> o {optCxx=x}) @@ -126,8 +137,13 @@ _optRanlib = Lens optRanlib (\x o -> o {optRanlib=x}) _optNm = Lens optNm (\x o -> o {optNm=x}) _optReadelf = Lens optReadelf (\x o -> o {optReadelf=x}) _optMergeObjs = Lens optMergeObjs (\x o -> o {optMergeObjs=x}) +_optLlc = Lens optLlc (\x o -> o {optLlc=x}) +_optOpt = Lens optOpt (\x o -> o {optOpt=x}) +_optLlvmAs = Lens optLlvmAs (\x o -> o {optLlvmAs=x}) _optWindres = Lens optWindres (\x o -> o {optWindres=x}) -_optLd = Lens optLd (\x o -> o {optLd= x}) +_optLd = Lens optLd (\x o -> o {optLd=x}) +_optOtool = Lens optOtool (\x o -> o {optOtool=x}) +_optInstallNameTool = Lens optInstallNameTool (\x o -> o {optInstallNameTool=x}) _optTriple :: Lens Opts (Maybe String) _optTriple = Lens optTriple (\x o -> o {optTriple=x}) @@ -183,8 +199,13 @@ options = , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs + , progOpts "llc" "LLVM llc utility" _optLlc + , progOpts "opt" "LLVM opt utility" _optOpt + , progOpts "llvm-as" "Assembler used for LLVM backend (typically clang)" _optLlvmAs , progOpts "windres" "windres utility" _optWindres , progOpts "ld" "linker" _optLd + , progOpts "otool" "otool utility" _optOtool + , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -436,6 +457,11 @@ mkTarget opts = do when (isNothing mergeObjs && not (arSupportsDashL ar)) $ throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" + -- LLVM toolchain + llc <- optional $ findProgram "llc" (optLlc opts) ["llc"] + opt <- optional $ findProgram "opt" (optOpt opts) ["opt"] + llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] + -- Windows-specific utilities windres <- case archOS_OS archOs of @@ -444,6 +470,15 @@ mkTarget opts = do return (Just windres) _ -> return Nothing + -- Darwin-specific utilities + (otool, installNameTool) <- + case archOS_OS archOs of + OSDarwin -> do + otool <- findProgram "otool" (optOtool opts) ["otool"] + installNameTool <- findProgram "install_name_tool" (optInstallNameTool opts) ["install_name_tool"] + return (Just otool, Just installNameTool) + _ -> return (Nothing, Nothing) + -- various other properties of the platform tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc @@ -480,7 +515,12 @@ mkTarget opts = do , tgtRanlib = ranlib , tgtNm = nm , tgtMergeObjs = mergeObjs + , tgtLlc = llc + , tgtOpt = opt + , tgtLlvmAs = llvmAs , tgtWindres = windres + , tgtOtool = otool + , tgtInstallNameTool = installNameTool , tgtWordSize , tgtEndianness , tgtUnregisterised ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -22,15 +22,6 @@ data WordSize = WS4 | WS8 data Endianness = LittleEndian | BigEndian deriving (Show, Read, Eq, Ord) --- TODO(#23674): Move the remaining relevant `settings-xxx` to Target: --- * llc command --- * opt command --- * install_name_tool --- * otool command --- --- Those are all things that are put into GHC's settings, and that might be --- different across targets - -- | A 'Target' consists of: -- -- * a target architecture and operating system @@ -72,8 +63,18 @@ data Target = Target , tgtMergeObjs :: Maybe MergeObjs -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@ + -- LLVM backend toolchain + , tgtLlc :: Maybe Program + , tgtOpt :: Maybe Program + , tgtLlvmAs :: Maybe Program + -- ^ assembler used to assemble LLVM backend output; typically @clang@ + -- Windows-specific tools , tgtWindres :: Maybe Program + + -- Darwin-specific tools + , tgtOtool :: Maybe Program + , tgtInstallNameTool :: Maybe Program } deriving (Read, Eq, Ord) @@ -121,6 +122,11 @@ instance Show Target where , ", tgtRanlib = " ++ show tgtRanlib , ", tgtNm = " ++ show tgtNm , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtLlc = " ++ show tgtLlc + , ", tgtOpt = " ++ show tgtOpt + , ", tgtLlvmAs = " ++ show tgtLlvmAs , ", tgtWindres = " ++ show tgtWindres + , ", tgtOtool = " ++ show tgtOtool + , ", tgtInstallNameTool = " ++ show tgtInstallNameTool , "}" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f09c251941ecbb870828fbb7763fe0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f09c251941ecbb870828fbb7763fe0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 28 commits: Move ModuleGraph into UnitEnv
by Apoorv Ingle (＠ani) 23 Jun '25

23 Jun '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 0fb37893 by Matthew Pickering at 2025-06-23T13:55:10-04:00 Move ModuleGraph into UnitEnv The ModuleGraph is a piece of information associated with the ExternalPackageState and HomeUnitGraph. Therefore we should store it inside the HomeUnitEnv. - - - - - 3bf6720e by soulomoon at 2025-06-23T13:55:52-04:00 Remove hptAllFamInstances usage during upsweep Fixes #26118 This change eliminates the use of hptAllFamInstances during the upsweep phase, as it could access non-below modules from the home package table. The following updates were made: * Updated checkFamInstConsistency to accept an explicit ModuleEnv FamInstEnv parameter and removed the call to hptAllFamInstances. * Adjusted hugInstancesBelow so we can construct ModuleEnv FamInstEnv from its result, * hptAllFamInstances and allFamInstances functions are removed. - - - - - 4cd6429d by Apoorv Ingle at 2025-06-23T17:53:11-05:00 - Remove one `SrcSpan` field from `VAExpansion`. It is no longer needed. - Make `tcExpr` take a `Maybe HsThingRn` which will be passed on to tcApp and used by splitHsApps to determine a more accurate `AppCtx` - `tcXExpr` is less hacky now - do not look through HsExpansion applications - kill OrigPat and remove HsThingRn From VAExpansion - look through XExpr ExpandedThingRn while inferring type of head - always set in generated code after stepping inside a ExpandedThingRn - fixing record update error messages - remove special case of tcbody from tcLambdaMatches - wrap last stmt expansion in a HsPar so that the error messages are prettier - remove special case of dsExpr for ExpandedThingTc - make EExpand (HsExpr GhcRn) instead of EExpand HsThingRn - fixing error messages for rebindable - - - - - fe55834b by Apoorv Ingle at 2025-06-23T17:53:11-05:00 some progress on tick - - - - - a258d0e7 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 remove adhoc cases from ticks - - - - - a620300b by Apoorv Ingle at 2025-06-23T17:53:11-05:00 fix the case where head of the application chain is an expanded expression and the argument is a type application c.f. T19167.hs - - - - - 0eba8097 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 move setQLInstLevel inside tcInstFun - - - - - ab6d8ea9 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 ignore ds warnings originating from gen locations - - - - - bcfecf7e by Apoorv Ingle at 2025-06-23T17:53:11-05:00 filter expr stmts error msgs - - - - - 2f877d2f by Apoorv Ingle at 2025-06-23T17:53:11-05:00 exception for AppDo while making error ctxt - - - - - d8e66ef2 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 moving around things for locations and error ctxts - - - - - 001515a0 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 popErrCtxt doesn't push contexts and popErrCtxts in the first argument to bind and >> in do expansion statements - - - - - c3e320f3 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 accept test cases with changed error messages ------------------------- Metric Decrease: T9020 ------------------------- - - - - - 8a34d35f by Apoorv Ingle at 2025-06-23T17:53:11-05:00 look through PopErrCtxt while splitting exprs in application chains - - - - - 6a3fd9ce by Apoorv Ingle at 2025-06-23T17:53:11-05:00 remove special case for HsExpanded in Ticks - - - - - d7b17d49 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 check the right origin for record selector incomplete warnings - - - - - d5895136 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 kill VAExpansion - - - - - 84731698 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 pass CtOrigin to tcApp for instantiateSigma - - - - - 9a7dcbca by Apoorv Ingle at 2025-06-23T17:53:11-05:00 do not suppress pprArising - - - - - 8a6b5771 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 kill VACall - - - - - c538fa76 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 kill AppCtxt - - - - - 82fbc450 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 remove addHeadCtxt - - - - - 875ba420 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 fix pprArising for MonadFailErrors - - - - - 4b6cdbc9 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 rename ctxt to sloc - - - - - aa53551b by Apoorv Ingle at 2025-06-23T17:53:11-05:00 fix RepPolyDoBind error message herald - - - - - a347731a by Apoorv Ingle at 2025-06-23T17:53:11-05:00 SrcCodeCtxt more changes - - - - - ef425b46 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 make tcl_in_gen_code a SrcCodeCtxt and rename DoOrigin to DoStmtOrigin - - - - - 72820354 by Apoorv Ingle at 2025-06-23T17:53:11-05:00 make error messages for records saner - - - - - 58 changed files: - compiler/GHC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - + compiler/GHC/Tc/Gen/App.hs-boot - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Home/PackageTable.hs - ghc/GHCi/UI.hs - testsuite/tests/deSugar/should_compile/T10662.stderr - testsuite/tests/deSugar/should_compile/T3263-1.stderr - testsuite/tests/deSugar/should_compile/T3263-2.stderr - testsuite/tests/default/default-fail05.stderr - testsuite/tests/indexed-types/should_fail/T2693.stderr - testsuite/tests/indexed-types/should_fail/T5439.stderr - testsuite/tests/plugins/test-defaulting-plugin.stderr - testsuite/tests/polykinds/T13393.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/typecheck/should_compile/T14590.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/DoExpansion1.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/T10971d.stderr - testsuite/tests/typecheck/should_fail/T13311.stderr - testsuite/tests/typecheck/should_fail/T24064.stderr - testsuite/tests/typecheck/should_fail/T3323.stderr - testsuite/tests/typecheck/should_fail/T3613.stderr - testsuite/tests/typecheck/should_fail/T7851.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr - testsuite/tests/typecheck/should_fail/tcfail102.stderr - testsuite/tests/typecheck/should_fail/tcfail128.stderr - testsuite/tests/typecheck/should_fail/tcfail168.stderr - testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61531f23e4885ff8065480f7672a0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61531f23e4885ff8065480f7672a0… You're receiving this email because of your account on gitlab.haskell.org.

1 0