- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/ghc-sample-profiler] 2 commits: WIP: dont commit this, just for profiling
by Hannes Siebenhandl (＠fendor) 27 Oct '25

27 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-sample-profiler at Glasgow Haskell Compiler / GHC Commits: c5d76d58 by fendor at 2025-10-17T11:52:06+02:00 WIP: dont commit this, just for profiling - - - - - f3e2839a by Matthew Pickering at 2025-10-27T08:41:03+01:00 Verious stuff that needs to be revisited - - - - - 9 changed files: - .gitmodules - + ghc-debug - + ghc/GHC/EventLog/Sample.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + instructions.md Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,6 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "ghc-debug"] + path = ghc-debug + url = git@gitlab.haskell.org:ghc/ghc-debug.git ===================================== ghc-debug ===================================== @@ -0,0 +1 @@ +Subproject commit 1b0f36fab86e9baa9734c88dcc1dbe17d10d8c93 ===================================== ghc/GHC/EventLog/Sample.hs ===================================== @@ -0,0 +1,376 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE CPP #-} + +module GHC.EventLog.Sample where +import Prelude + +import Control.Concurrent +import Control.Exception +import Control.Monad +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as List +import GHC.Conc +import GHC.Conc.Sync + +import Control.Concurrent +import Control.Monad (replicateM, when) +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as BU +import qualified System.IO.Unsafe as Unsafe +import qualified Data.ByteString.Lazy as LBS +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Typeable (cast) +import Data.Maybe +import qualified Data.List.NonEmpty as NonEmpty +import Unsafe.Coerce +import GHC.Exts (Ptr(..), Int(..), traceBinaryEvent#) +import GHC.IO (IO(..)) +import GHC.Stack.Annotation.Experimental + +import GHC.Stack.CloneStack (StackSnapshot(..), cloneThreadStack) +import GHC.Internal.Conc.Sync + +import GHC.Internal.Conc.Sync +import GHC.Internal.InfoProv.Types (InfoProv(..), lookupIpProvId) +import GHC.Internal.Heap.Closures +import qualified GHC.Internal.Stack.Decode as Decode +import GHC.Internal.Stack.Types + +import Control.Monad (replicateM) +import Data.Binary +import Data.Binary.Put +import Data.Binary.Get + +import GHC.Internal.RTS.Flags.Test + +import Debug.Trace +import GHC.Profiling.Eras + +traceBinaryEventIO :: B.ByteString -> IO () +traceBinaryEventIO bytes = traceBinaryEventIO' bytes + +traceBinaryEventIO' :: B.ByteString -> IO () +traceBinaryEventIO' bytes = + BU.unsafeUseAsCStringLen bytes $ \(Ptr p, I# n) -> IO $ \s -> + case traceBinaryEvent# p n s of + s' -> (# s', () #) + +data SamplerThread = MkSamplerThread + { samplerThreadId :: ThreadId + } deriving (Show, Eq, Ord) + +withSampleProfiler :: Int -> IO a -> IO a +withSampleProfiler delay act = do + enabled <- getUserEventTracingEnabled + if enabled + then bracket setupSamplers tearDownSamplers (const act) + else act + where + setupSamplers = do + samplerThreadConfigMVar <- newEmptyMVar + sid <- forkIO $ do + config <- takeMVar samplerThreadConfigMVar + sampleThreadId <- myThreadId + labelThread sampleThreadId "Sample Profiler Thread" + forever $ do + tids <- listThreads + userThreads <- filterM (isThreadOfInterest config) tids + forM_ userThreads $ \tid -> + sampleToEventlog tid + -- TODO: this is wrong, we don't sample every delay time as sampling takes time as well + threadDelay delay + + let sampleThreadConf = MkSamplerThread + { samplerThreadId = sid + } + putMVar samplerThreadConfigMVar sampleThreadConf + pure sampleThreadConf + + tearDownSamplers MkSamplerThread{samplerThreadId} = + killThread samplerThreadId + + isThreadOfInterest :: SamplerThread -> ThreadId -> IO Bool + isThreadOfInterest config tid = do + lbl <- threadLabel tid + pure $ not $ or + [ isProfilerThread config tid lbl + , isBuiltinThread tid lbl + ] + +isProfilerThread :: SamplerThread -> ThreadId -> Maybe String -> Bool +isProfilerThread MkSamplerThread {samplerThreadId} tid lbl = tid == samplerThreadId + +isBuiltinThread :: ThreadId -> Maybe String -> Bool +isBuiltinThread _ Nothing = False +isBuiltinThread _tid (Just lbl) = + lbl `elem` ["TimerManager"] || "IOManager on cap" `List.isPrefixOf` lbl + + +sampleToEventlog :: ThreadId -> IO () +sampleToEventlog tid = do + sampleThread tid >>= \ case + Nothing -> pure () + Just threadSample -> do + msg <- serializeThreadSample threadSample + traceBinaryEventIO $ LBS.toStrict msg + + +---- + + +newtype CapabilityId = + CapabilityId + { getCapabilityId :: Word64 + } + deriving (Show, Eq, Ord) + +data ThreadSample = + ThreadSample + { threadSampleId :: ThreadId + , threadSampleCapability :: CapabilityId + , threadSampleStackSnapshot :: StackSnapshot + } + +sampleThread :: ThreadId -> IO (Maybe ThreadSample) +sampleThread tid = do + (cap, blocked) <- threadCapability tid + if blocked + then pure Nothing + else do + stack <- cloneThreadStack tid + pure $ Just $ ThreadSample + { threadSampleId = tid + , threadSampleCapability = CapabilityId $ intToWord64 cap + , threadSampleStackSnapshot = stack + } + +serializeThreadSample :: ThreadSample -> IO LBS.ByteString +serializeThreadSample sample = do + callStackMessage <- threadSampleToCallStackMessage sample + pure $ runPut $ put callStackMessage + +deserializeCallStackMessage :: LBS.ByteString -> Either String CallStackMessage +deserializeCallStackMessage = Right . runGet get + +-- Message format: +-- +-- MESSAGE +-- := "CA" "11" <STACK> +-- STACK +-- := <capability: Word32> <threadId: Word32> <length: Word32> <ENTRY>+ +-- ENTRY +-- := "01" <ipe: Word64> +-- | "02" <string: STRING> +-- | "03" <row: Word32> <col: Word32> <function: CStringLen> <filename: CStringLen> +-- CStringLen +-- := <length: Word8> <Char>+ + +data CallStackMessage = + MkCallStackMessage + { callThreadId :: Word64 + , callCapabilityId :: CapabilityId + , callStack :: [StackItem] + } + deriving (Eq, Ord, Show) + +data StackItem + = IpeId !Word64 + | UserMessage !String + | SourceLocation !SourceLocation + deriving (Eq, Ord, Show) + +data SourceLocation = + MkSourceLocation + { line :: !Word32 + , column :: !Word32 + , functionName :: !Text + , fileName :: !Text + } + deriving (Eq, Ord, Show) + +instance Binary CallStackMessage where + put msg = do + putByteString "CA" + putByteString "11" + putWord32 $ word64ToWord32 $ getCapabilityId $ callCapabilityId msg + putWord32 $ word64ToWord32 $ callThreadId msg + putWord8 $ intToWord8 $ min cutOffLength $ length $ callStack msg -- TODO: limit number of stack entries to 2^32 + mapM_ put $ take cutOffLength $ callStack msg + + get = do + _ <- getByteString 2 -- CA + _ <- getByteString 2 -- 11 + capId <- getWord32 + tid <- getWord32 + len <- getWord8 + items <- replicateM (word8ToInt len) get + pure MkCallStackMessage + { callThreadId = word32ToWord64 tid + , callCapabilityId = CapabilityId $ word32ToWord64 capId + , callStack = items + } + +instance Binary SourceLocation where + put loc = do + putWord32 $ line loc + putWord32 $ column loc + putStringLen $ Text.unpack $ functionName loc + putStringLen $ Text.unpack $ fileName loc + + get = do + MkSourceLocation + <$> getWord32 + <*> getWord32 + <*> (Text.pack <$> getStringLen) + <*> (Text.pack <$> getStringLen) + +instance Binary StackItem where + put = \ case + IpeId ipeId -> do + putWord8 1 + putWord64 ipeId + UserMessage msg -> do + putWord8 2 + putStringLen msg + SourceLocation loc -> do + putWord8 3 + put loc + + get = do + getWord8 >>= \ case + 1 -> IpeId <$> getWord64 + 2 -> UserMessage <$> getStringLen + 3 -> SourceLocation <$> get + n -> fail $ "StackItem: Unexpected tag byte encounter: " <> show n + +decodeStackWithIpProvId :: StackSnapshot -> IO [(StackFrame, Maybe Word64)] +decodeStackWithIpProvId snapshot = do + concat . snd <$> Decode.decodeStackWithFrameUnpack unpackStackFrameWithIpProvId snapshot + +unpackStackFrameWithIpProvId :: Decode.StackFrameLocation -> IO (StackFrame, Maybe Word64) +unpackStackFrameWithIpProvId stackFrameLoc = do + Decode.unpackStackFrameTo stackFrameLoc + (\ info infoKey nextChunk@(StackSnapshot stack#) -> do + framesWithIpe <- decodeStackWithIpProvId nextChunk + mIpeId <- lookupIpProvId infoKey + pure + ( UnderflowFrame + { info_tbl = info, + nextChunk = + GenStgStackClosure + { ssc_info = info, + ssc_stack_size = Decode.getStackFields stack#, + ssc_stack = map fst framesWithIpe + } + } + , mIpeId + ) + + ) + (\ frame infoKey -> do + mIpeId <- lookupIpProvId infoKey + pure (frame, mIpeId) + ) + +threadSampleToCallStackMessage :: ThreadSample -> IO CallStackMessage +threadSampleToCallStackMessage sample = do + frames <- decodeStackWithIpProvId $ threadSampleStackSnapshot sample + let stackMessages = fmap List.head . List.group $ mapMaybe (uncurry stackFrameToStackItem) frames + pure MkCallStackMessage + { callThreadId = fromThreadId $ threadSampleId sample + , callCapabilityId = threadSampleCapability sample + , callStack = stackMessages + } + +stackFrameToStackItem :: StackFrame -> Maybe Word64 -> Maybe StackItem +stackFrameToStackItem frame mIpe = + case frame of + AnnFrame { annotation = Box someStackAnno } -> + case unsafeCoerce someStackAnno of + SomeStackAnnotation ann -> + case cast ann of + Just (CallStackAnnotation cs) -> + case getCallStack cs of + [] -> Nothing + ((name, sourceLoc):_) -> + Just $ SourceLocation $ MkSourceLocation + { line = intToWord32 $ srcLocStartLine sourceLoc + , column = intToWord32 $ srcLocStartCol sourceLoc + , functionName = Text.pack $ name + , fileName = Text.pack $ srcLocFile sourceLoc + } + + Nothing -> case cast ann of + Just (StringAnnotation msg) -> + Just $ UserMessage msg + Nothing -> + Nothing + _ -> + IpeId <$> mIpe + +-------- + +cutOffLength :: Int +cutOffLength = 255 + +putStringLenWithTag :: Word8 -> String -> Put +putStringLenWithTag tag msg = + putWord8 tag <> putStringLen msg + +putStringLen :: String -> Put +putStringLen msg = + putWord8 len <> putStringUtf8 msg + where + shortName = take cutOffLength msg + -- this is safe as we made sure that cutOffLength fits in a Word8 + len = intToWord8 $ length shortName + +getStringLen :: Get String +getStringLen = do + len <- getWord8 + replicateM (word8ToInt len) get + +putWord64 :: Word64 -> Put +putWord64 = putWord64be + +putWord32 :: Word32 -> Put +putWord32 = putWord32be + +getWord64 :: Get Word64 +getWord64 = getWord64be + +getWord32 :: Get Word32 +getWord32 = getWord32be + +word64ToWord32 :: Word64 -> Word32 +word64ToWord32 = fromIntegral + +word32ToWord64 :: Word32 -> Word64 +word32ToWord64 = fromIntegral + +word32ToInt :: Word32 -> Int +word32ToInt = fromIntegral + +word64ToInt :: Word64 -> Int +word64ToInt = fromIntegral + +intToWord64 :: Int -> Word64 +intToWord64 = fromIntegral + +intToWord32 :: Int -> Word32 +intToWord32 = fromIntegral + +intToWord8 :: Int -> Word8 +intToWord8 = fromIntegral + +word8ToInt :: Word8 -> Int +word8ToInt = fromIntegral + ===================================== ghc/Main.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic +import GHC.Driver.Monad import GHC.Platform import GHC.Platform.Host @@ -92,6 +93,14 @@ import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(GHC_DEBUG) +import GHC.Debug.Stub +#endif + +#if defined(SAMPLE_TRACER) +import GHC.EventLog.Sample +#endif + ----------------------------------------------------------------------------- -- ToDo: @@ -104,8 +113,24 @@ import qualified Data.List.NonEmpty as NE ----------------------------------------------------------------------------- -- GHC's command-line interface +withGhcSampleProfiler :: IO () -> IO () +#if defined(SAMPLE_TRACER) +withGhcSampleProfiler = + withSampleProfiler 10000 +#else +withGhcSampleProfiler = + id +#endif + +debugWrapper :: IO a -> IO a +#if defined(GHC_DEBUG) +debugWrapper = withGhcDebug +#else +debugWrapper = id +#endif + main :: IO () -main = do +main = withGhcSampleProfiler $ do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering @@ -152,8 +177,10 @@ main = do ShowGhcUsage -> showGhcUsage dflags ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) - Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + Right postLoadMode -> do + reifyGhc $ \session -> debugWrapper $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session + main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -22,11 +22,21 @@ Flag internal-interpreter Default: False Manual: True +Flag ghc-debug + Description: Build with support for ghc-debug. + Default: False + Manual: True + Flag threaded Description: Link the ghc executable against the threaded RTS Default: True Manual: True +Flag sampleTracer + Description: Link the ghc executable against the threaded RTS + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -42,9 +52,20 @@ Executable ghc filepath >= 1.5 && < 1.6, containers >= 0.5 && < 0.9, transformers >= 0.5 && < 0.7, + ghc-internal, ghc-experimental, binary, + text, ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + CPP-OPTIONS: -DSAMPLE_TRACER + other-modules: + GHC.EventLog.Sample + + if flag(ghc-debug) + build-depends: ghc-debug-stub + CPP-OPTIONS: -DGHC_DEBUG + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -12,7 +12,7 @@ module Packages ( runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, - ghcPackages, isGhcPackage, + ghcPackages, isGhcPackage, ghc_debug_convention, ghc_debug_stub, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +43,9 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace + , ghc_debug_convention + , ghc_debug_stub ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -133,6 +135,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_debug_convention = lib "ghc-debug-convention" `setPath` "ghc-debug/convention" +ghc_debug_stub = lib "ghc-debug-stub" `setPath` "ghc-debug/stub" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -174,6 +174,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_debug_convention + , ghc_debug_stub ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -116,6 +116,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "ghc-debug" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. @@ -124,6 +125,7 @@ packageArgs = do -- We build a threaded stage N, N>1 if the configuration calls -- for it. (compilerStageOption ghcThreaded `cabalFlag` "threaded") + , notStage0 `cabalFlag` "sampleTracer" ] ] ===================================== instructions.md ===================================== @@ -0,0 +1,45 @@ +# Building GHC + +* Add the following to _build/hadrian.settings + +``` +stage1.*.ghc.hs.opts += -finfo-table-map -fdistinct-constructor-tables +``` + +* Build GHC as normal + +``` +./hadrian/build -j8 +``` + +* The result is a ghc-debug enabled compiler + +# Building a debugger + +* Use the compiler you just built to build ghc-debug + +``` +cd ghc-debug +cabal update +cabal new-build debugger -w ../_build/stage1/bin/ghc +``` + +# Running the debugger + +Modify `test/Test.hs` to implement the debugging thing you want to do. Perhaps +start with `p30`, which is a program to generate a profile. + + +* Start the process you want to debug +``` +GHC_DEBUG_SOCKET=/tmp/ghc-debug build-cabal +``` + +* Start the debugger +``` +cabal new-run debugger -w ... +``` + +* Open a ticket about the memory issue you find. + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67ea2dcc1582dc863c8c8e3a6af965… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67ea2dcc1582dc863c8c8e3a6af965… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ani/kill-popErrCtxt] 57 commits: Add a perf test for #26425
by Apoorv Ingle (＠ani) 27 Oct '25

27 Oct '25

Apoorv Ingle pushed to branch wip/ani/kill-popErrCtxt at Glasgow Haskell Compiler / GHC Commits: 41bdb16f by Andreas Klebinger at 2025-10-06T18:04:34-04:00 Add a perf test for #26425 - - - - - 1da0c700 by Andreas Klebinger at 2025-10-06T18:05:14-04:00 Testsuite: Silence warnings about Wx-partial in concprog001 - - - - - 7471eb6a by sheaf at 2025-10-07T21:39:43-04:00 Improve how we detect user type errors in types This commit cleans up all the code responsible for detecting whether a type contains "TypeError msg" applications nested inside it. All the logic is now in 'userTypeError_maybe', which is always deep. Whether it looks inside type family applications is determined by the passed-in boolean flag: - When deciding whether a constraint is definitely insoluble, don't look inside type family applications, as they may still reduce -- in which case the TypeError could disappear. - When reporting unsolved constraints, look inside type family applications: they had the chance to reduce but didn't, and the custom type error might contain valuable information. All the details are explained in Note [Custom type errors in constraints] in GHC.Tc.Types.Constraint. Another benefit of this change is that it allows us to get rid of the deeply dodgy 'getUserTypeErrorMsg' function. This commit also improves the detection of custom type errors, for example in equality constraints: TypeError blah ~# rhs It used to be the case that we didn't detect the TypeError on the LHS, because we never considered that equality constraints could be insoluble due to the presence of custom type errors. Addressing this oversight improves detection of redundant pattern match warnings, fixing #26400. - - - - - 29955267 by Rodrigo Mesquita at 2025-10-07T21:40:25-04:00 cleanup: Drop obsolete settings from config.mk.in These values used to be spliced into the bindist's `config.mk` s.t. when `make` was run, the values were read and written into the bindist installation `settings` file. However, we now carry these values to the bindist directly in the default.target toolchain file, and `make` writes almost nothing to `settings` now (see #26227) The entries deleted in this MR were already unused. Fixes #26478 - - - - - f7adfed2 by ARATA Mizuki at 2025-10-08T08:37:24-04:00 T22033 is only relevant if the word size is 64-bit Fixes #25497 - - - - - ff1650c9 by Ben Gamari at 2025-10-08T08:38:07-04:00 rts/posix: Enforce iteration limit on heap reservation logic Previously we could loop indefinitely when attempting to get an address space reservation for our heap. Limit the logic to 8 iterations to ensure we instead issue a reasonable error message. Addresses #26151. - - - - - 01844557 by Ben Gamari at 2025-10-08T08:38:07-04:00 rts/posix: Hold on to low reservations when reserving heap Previously when the OS gave us an address space reservation in low memory we would immediately release it and try again. However, on some platforms this meant that we would get the same allocation again in the next iteration (since mmap's `hint` argument is just that, a hint). Instead we now hold on to low reservations until we have found a suitable heap reservation. Fixes #26151. - - - - - b2c8d052 by Sven Tennie at 2025-10-08T08:38:47-04:00 Build terminfo only in upper stages in cross-builds (#26288) Currently, there's no way to provide library paths for [n]curses for both - build and target - in cross-builds. As stage0 is only used to build upper stages, it should be fine to build terminfo only for them. This re-enables building cross-compilers with terminfo. - - - - - c58f9a61 by Julian Ospald at 2025-10-08T08:39:36-04:00 ghc-toolchain: Drop `ld.gold` from merge object command It's deprecated. Also see #25716 - - - - - 2b8baada by sheaf at 2025-10-08T18:23:37-04:00 Improvements to 'mayLookIdentical' This commit makes significant improvements to the machinery that decides when we should pretty-print the "invisible bits" of a type, such as: - kind applications, e.g. '@k' in 'Proxy @k ty' - RuntimeReps, e.g. 'TYPE r' - multiplicities and linear arrows 'a %1 -> b' To do this, this commit refactors 'mayLookIdentical' to return **which** of the invisible bits don't match up, e.g. in (a %1 -> b) ~ (a %Many -> b) we find that the invisible bit that doesn't match up is a multiplicity, so we should set 'sdocLinearTypes = True' when pretty-printing, and with e.g. Proxy @k1 ~ Proxy @k2 we find that the invisible bit that doesn't match up is an invisible TyCon argument, so we set 'sdocPrintExplicitKinds = True'. We leverage these changes to remove the ad-hoc treatment of linearity of data constructors with 'dataConDisplayType' and 'dataConNonLinearType'. This is now handled by the machinery of 'pprWithInvisibleBits'. Fixes #26335 #26340 - - - - - 129ce32d by sheaf at 2025-10-08T18:23:37-04:00 Store SDoc context in SourceError This commits modifies the SourceError datatype which is used for throwing and then reporting exceptions by storing all the info we need to be able to print the SDoc, including whether we should print with explicit kinds, explicit runtime-reps, etc. This is done using the new datatype: data SourceErrorContext = SEC !DiagOpts !(DiagnosticOpts GhcMessage) Now, when we come to report an error (by handling the exception), we have access to the full context we need. Fixes #26387 - - - - - f9790ca8 by Ben Gamari at 2025-10-08T18:24:19-04:00 gitlab-ci: Make RELEASE_JOB an input Rather than an undocumented variable. - - - - - 14281a22 by Ben Gamari at 2025-10-11T14:06:47-04:00 rts/nonmoving: Fix comment spelling - - - - - bedd38b0 by Ben Gamari at 2025-10-11T14:06:47-04:00 rts/nonmoving: Use atomic operations to update bd->flags - - - - - 215d6841 by Ben Gamari at 2025-10-11T14:06:47-04:00 nonmoving: Use get_itbl instead of explicit loads This is cleaner and also fixes unnecessary (and unsound) use of `volatile`. - - - - - 2c94aa3a by Ben Gamari at 2025-10-11T14:06:47-04:00 rts/Scav: Handle WHITEHOLEs in scavenge_one `scavenge_one`, used to scavenge mutable list entries, may encounter `WHITEHOLE`s when the non-moving GC is in use via two paths: 1. when an MVAR is being marked concurrently 2. when the object belongs to a chain of selectors being short-cutted. Fixes #26204. - - - - - 6bd8155c by Matthew Pickering at 2025-10-11T14:07:29-04:00 Add support for generating bytecode objects This commit adds the `-fwrite-byte-code` option which makes GHC emit a `.gbc` file which contains a serialised representation of bytecode. The bytecode can be loaded by the compiler to avoid having to reinterpret a module when using the bytecode interpreter (for example, in GHCi). There are also the new options: * -gbcdir=<DIR>: Specify the directory to place the gbc files * -gbcsuf=<suffix>: Specify the suffix for gbc files The option `-fbyte-code-and-object-code` now implies `-fwrite-byte-code`. These performance tests fail due to https://github.com/haskell/directory/issues/204 ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiComponentModulesRecomp MultiLayerModulesRecomp MultiLayerModulesTH_Make MultiLayerModulesTH_OneShot T13701 ------------------------- The bytecode serialisation part was implemented by Cheng Shao Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - dc8f9599 by Matthew Pickering at 2025-10-11T14:07:30-04:00 Revert "Add a perf test for #26425" This test has a large memory spike currently, which makes the test sensitive, since if you allocate a little more or less, the precise location where GC happens shifts and you observe a different part of the spike. Andreas told me to revert the patch for now, and he will add it back when he fixes the memory spike. This reverts commit 41bdb16fd083110a06507248f648c507a2feb4af. - - - - - e10dcd65 by Sven Tennie at 2025-10-12T10:24:56+00:00 T22859: Increase threadDelay for small machines The previously used thread delay led to failures on my RISC-V test setups. - - - - - d59ef6b6 by Hai / @BestYeen at 2025-10-14T21:51:14-04:00 Change Alex and Happy m4 scripts to display which version was found in the system, adapt small formatting details in Happy script to be more like the Alex script again. - - - - - c98abb6a by Hai / @BestYeen at 2025-10-14T21:52:08-04:00 Update occurrences of return to pure and add a sample for redefining :m to mean :main - - - - - 70ee825a by Cheng Shao at 2025-10-14T21:52:50-04:00 testsuite: fix T3586 for non-SSE3 platforms `T3586.hs` contains `-fvia-C -optc-msse3` which I think is a best-effort basis to harvest the C compiler's auto vectorization optimizations via the C backend back when the test was added. The `-fvia-C` part is now a deprecated no-op because GHC can't fall back to the C backend on a non-unregisterised build, and `-optc-msse3` might actually cause the test to fail on non x86/x64 platforms, e.g. recent builds of wasi-sdk would report `wasm32-wasi-clang: error: unsupported option '-msse3' for target 'wasm32-unknown-wasi'`. So this patch cleans up this historical cruft. `-fvia-C` is removed, and `-optc-msse3` is only passed when cpuid contains `pni` (which indicates support of SSE3). - - - - - 4be32153 by Teo Camarasu at 2025-10-15T08:06:09-04:00 Add submodules for template-haskell-lift and template-haskell-quasiquoter These two new boot libraries expose stable subsets of the template-haskell interface. This is an implemenation of the GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/696 Work towards #25262 - - - - - 0c00c9c3 by Ben Gamari at 2025-10-15T08:06:51-04:00 rts: Eliminate uses of implicit constant arrays Folding of `const`-sized variable-length arrays to a constant-length array is a gnu extension which clang complains about. Closes #26502. - - - - - bf902a1d by Fendor at 2025-10-15T16:00:59-04:00 Refactor distinct constructor tables map construction Adds `GHC.Types.Unique.FM.alterUFM_L`, `GHC.Types.Unique.DFM.alterUDFM_L` `GHC.Data.Word64Map.alterLookup` to support fusion of distinct constructor data insertion and lookup during the construction of the `DataCon` map in `GHC.Stg.Debug.numberDataCon`. Co-authored-by: Fendor <fendor(a)posteo.de> Co-authored-by: Finley McIlwaine <finleymcilwaine(a)gmail.com> - - - - - b3585ba1 by Fendor at 2025-10-15T16:00:59-04:00 Allow per constructor refinement of distinct-constructor-tables Introduce `-fno-distinct-constructor-tables`. A distinct constructor table configuration is built from the combination of flags given, in order. For example, to only generate distinct constructor tables for a few specific constructors and no others, just pass `-fdistinct-constructor-tables-only=C1,...,CN`. This flag can be supplied multiple times to extend the set of constructors to generate a distinct info table for. You can disable generation of distinct constructor tables for all configurations by passing `-fno-distinct-constructor-tables`. The various configurations of these flags is included in the `DynFlags` fingerprints, which should result in the expected recompilation logic. Adds a test that checks for distinct tables for various given or omitted constructors. Updates CountDepsAst and CountDepsParser tests to account for new dependencies. Fixes #23703 Co-authored-by: Fendor <fendor(a)posteo.de> Co-authored-by: Finley McIlwaine <finleymcilwaine(a)gmail.com> - - - - - e17dc695 by fendor at 2025-10-15T16:01:41-04:00 Fix typos in haddock documentation for stack annotation API - - - - - f85058d3 by Zubin Duggal at 2025-10-17T13:50:52+05:30 compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag Fixes #26264 Metric Decrease: T9233 - - - - - c85c845d by sheaf at 2025-10-17T22:35:32-04:00 Don't prematurely final-zonk PatSyn declarations This commit makes GHC hold off on the final zonk for pattern synonym declarations, in 'GHC.Tc.TyCl.PatSyn.tc_patsyn_finish'. This accommodates the fact that pattern synonym declarations without a type signature can contain unfilled metavariables, e.g. if the RHS of the pattern synonym involves view-patterns whose type mentions promoted (level 0) metavariables. Just like we do for ordinary function bindings, we should allow these metavariables to be settled later, instead of eagerly performing a final zonk-to-type. Now, the final zonking-to-type for pattern synonyms is performed in GHC.Tc.Module.zonkTcGblEnv. Fixes #26465 - - - - - ba3e5bdd by Rodrigo Mesquita at 2025-10-18T16:57:18-04:00 Move code-gen aux symbols from ghc-internal to rts These symbols were all previously defined in ghc-internal and made the dependency structure awkward, where the rts may refer to some of these symbols and had to work around that circular dependency the way described in #26166. Moreover, the code generator will produce code that uses these symbols! Therefore, they should be available in the rts: PRINCIPLE: If the code generator may produce code which uses this symbol, then it should be defined in the rts rather than, say, ghc-internal. That said, the main motivation is towards fixing #26166. Towards #26166. Pre-requisite of !14892 - - - - - f31de2a9 by Ben Gamari at 2025-10-18T16:57:18-04:00 rts: Avoid static symbol references to ghc-internal This resolves #26166, a bug due to new constraints placed by Apple's linker on undefined references. One source of such references in the RTS is the many symbols referenced in ghc-internal. To mitigate #26166, we make these references dynamic, as described in Note [RTS/ghc-internal interface]. Fixes #26166 Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com> Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - 43fdfddc by Ben Gamari at 2025-10-18T16:57:18-04:00 compiler: Rename isMathFun -> isLibcFun This set includes more than just math functions. - - - - - 4ed5138f by Ben Gamari at 2025-10-18T16:57:18-04:00 compiler: Add libc allocator functions to libc_funs Prototypes for these are now visible from `Prim.h`, resulting in multiple-declaration warnings in the unregisterised job. - - - - - 9a0a076b by Ben Gamari at 2025-10-18T16:57:18-04:00 rts: Minimize header dependencies of Prim.h Otherwise we will end up with redundant and incompatible declarations resulting in warnings during the unregisterised build. - - - - - 26b8a414 by Diego Antonio Rosario Palomino at 2025-10-18T16:58:10-04:00 Cmm Parser: Fix incorrect example in comment The Parser.y file contains a comment with an incorrect example of textual Cmm (used in .cmm files). This commit updates the comment to ensure it reflects valid textual Cmm syntax. Fixes #26313 - - - - - d4a9d6d6 by ARATA Mizuki at 2025-10-19T18:43:47+09:00 Handle implications between x86 feature flags This includes: * Multiple -msse* options can be specified * -mavx implies -msse4.2 * -mavx2 implies -mavx * -mfma implies -mavx * -mavx512f implies -mavx2 and -mfma * -mavx512{cd,er,pf} imply -mavx512f Closes #24989 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - c9b8465c by Cheng Shao at 2025-10-20T10:16:00-04:00 wasm: workaround WebKit bug in dyld This patch works around a WebKit bug and allows dyld to run on WebKit based platforms as well. See added note for detailed explanation. Co-authored-by: Codex <codex(a)openai.com> - - - - - 91b6be10 by Julian Ospald at 2025-10-20T18:21:03-04:00 Improve error handling in 'getPackageArchives' When the library dirs in the package conf files are not set up correctly, the JS linker will happily ignore such packages and not link against them, although they're part of the link plan. Fixes #26383 - - - - - 6c5269da by Sven Tennie at 2025-10-20T18:21:44-04:00 Align coding style Improve readability by using the same style for all constructor calls in this function. - - - - - 3d305889 by Sven Tennie at 2025-10-20T18:21:44-04:00 Reduce complexity by removing joins with mempty ldArgs, cArgs and cppArgs are all `mempty`. Thus concatenating them adds nothing but some complexity while reading the code. - - - - - 38d65187 by Matthew Pickering at 2025-10-21T13:12:20+01:00 Fix stack decoding when using profiled runtime There are three fixes in this commit. * We need to replicate the `InfoTable` and `InfoTableProf` approach for the other stack constants (see the new Stack.ConstantsProf file). * Then we need to appropiately import the profiled or non-profiled versions. * Finally, there was an incorrect addition in `stackFrameSize`. We need to cast after performing addition on words. Fixes #26507 - - - - - 17231bfb by fendor at 2025-10-21T13:12:20+01:00 Add regression test for #26507 - - - - - 4f5bf93b by Simon Peyton Jones at 2025-10-25T04:05:34-04:00 Postscript to fix for #26255 This MR has comments only - - - - - 6ef22fa0 by IC Rainbow at 2025-10-26T18:23:01-04:00 Add SIMD primops for bitwise logical operations This adds 128-bit wide and/or/xor instructions for X86 NCG, with both SSE and AVX encodings. ``` andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# -- andps / vandps andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# -- andpd / vandpd andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# -- pand / vpand ``` The new primops are available on ARM when using LLVM backend. Tests added: - simd015 (floats and doubles) - simd016 (integers) - simd017 (words) Fixes #26417 - - - - - fbdc623a by sheaf at 2025-10-26T18:23:52-04:00 Add hints for unsolved HasField constraints This commit adds hints and explanations for unsolved 'HasField' constraints. GHC will now provide additional explanations for an unsolved constraint of the form 'HasField fld_name rec_ty fld_ty'; the details are laid out in Note [Error messages for unsolved HasField constraints], but briefly: 1. Provide similar name suggestions (e.g. mis-spelled field name) and import suggestions (record field not in scope). These result in actionable 'GhcHints', which is helpful to provide code actions in HLS. 2. Explain why GHC did not solve the constraint, e.g.: - 'fld_name' is not a string literal (e.g. a type variable) - 'rec_ty' is a TyCon without any fields, e.g. 'Int' or 'Bool'. - 'fld_ty' contains existentials variables or foralls. - The record field is a pattern synonym field (GHC does not generate HasField instances for those). - 'HasField' is a custom 'TyCon', not actually the built-in 'HasField' typeclass from 'GHC.Records'. On the way, we slightly refactor the mechanisms for import suggestions in GHC.Rename.Unbound. This is to account for the fact that, for 'HasField', we don't care whether the field is imported qualified or unqualified. 'importSuggestions' was refactored, we now have 'sameQualImportSuggestions' and 'anyQualImportSuggestions'. Fixes #18776 #22382 #26480 - - - - - 99d5707f by sheaf at 2025-10-26T18:23:52-04:00 Rename PatSyn MatchContext to PatSynCtx to avoid punning - - - - - 87b43d8e by Apoorv Ingle at 2025-10-26T20:49:14-05:00 This commit: - Streamlines implementations of `tcExpr` and `tcXExpr` to work on `XExpr` Calls `setInGeneratedCode` everytime the typechecker goes over an `XExpr` - Kills `VACtxt` (and its associated VAExpansion and VACall) datatype, it is subsumed by simply a SrcSpan. - Kills the function `addHeadCtxt` as it is now mearly setting a location - The function `tcValArgs` does its own argument number management - Makes `splitHsApps` not look through `XExpr` - `tcExprSigma` is called if the head of the expression after calling `splitHsApps` turns out to be an `XExpr` - Removes location information from `OrigPat` payload - Removes special case of tcBody from `tcLambdaMatches` - Removes special case of `dsExpr` for `ExpandedThingTc` - Moves `setQLInstLevel` inside `tcInstFun` - Rename `HsThingRn` to `SrcCodeCtxt` - Kills `tcl_in_gen_code` and `tcl_err_ctxt`. It is subsumed by `ErrCtxtStack` - Kills `ExpectedFunTyOrig`. It is subsumed by `CtOrigin` - Fixes `CtOrigin` for `HsProjection` case in `exprCtOrigin`. It was previously assigned to be `SectionOrigin`. It is now just the expression - Adds a new `CtOrigin.ExpansionOrigin` for storing the original syntax - Adds a new `CtOrigin.ExpectedTySyntax` as a replacement for `ExpectedTySyntaxOp`. Cannot kill the former yet because of `ApplicativeDo` - Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr` - Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span` Notes added [Error Context Stack] Notes updated Note [Expanding HsDo with XXExprGhcRn] ------------------------- Metric Decrease: T9020 ------------------------- - - - - - 2285692a by Apoorv Ingle at 2025-10-26T20:49:34-05:00 This commit: - Streamlines implementations of `tcExpr` and `tcXExpr` to work on `XExpr` Calls `setInGeneratedCode` everytime the typechecker goes over an `XExpr` - Kills `VACtxt` (and its associated VAExpansion and VACall) datatype, it is subsumed by simply a SrcSpan. - Kills the function `addHeadCtxt` as it is now mearly setting a location - The function `tcValArgs` does its own argument number management - Makes `splitHsApps` not look through `XExpr` - `tcExprSigma` is called if the head of the expression after calling `splitHsApps` turns out to be an `XExpr` - Removes location information from `OrigPat` payload - Removes special case of tcBody from `tcLambdaMatches` - Removes special case of `dsExpr` for `ExpandedThingTc` - Moves `setQLInstLevel` inside `tcInstFun` - Rename `HsThingRn` to `SrcCodeCtxt` - Kills `tcl_in_gen_code` and `tcl_err_ctxt`. It is subsumed by `ErrCtxtStack` - Kills `ExpectedFunTyOrig`. It is subsumed by `CtOrigin` - Fixes `CtOrigin` for `HsProjection` case in `exprCtOrigin`. It was previously assigned to be `SectionOrigin`. It is now just the expression - Adds a new `CtOrigin.ExpansionOrigin` for storing the original syntax - Adds a new `CtOrigin.ExpectedTySyntax` as a replacement for `ExpectedTySyntaxOp`. Cannot kill the former yet because of `ApplicativeDo` - Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr` - Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span` Notes added [Error Context Stack] Notes updated Note [Expanding HsDo with XXExprGhcRn] ------------------------- Metric Decrease: T9020 ------------------------- - - - - - 884138ce by Apoorv Ingle at 2025-10-26T20:49:34-05:00 some initial experiment to make ErrCtxt more expressive - - - - - 43aec828 by Apoorv Ingle at 2025-10-26T20:49:34-05:00 bring back tcl_in_gen_code - - - - - 7831fe5c by Apoorv Ingle at 2025-10-26T20:49:34-05:00 wombat - - - - - dace5b21 by Apoorv Ingle at 2025-10-26T20:49:34-05:00 some progress with addArgCtxt - - - - - 6bdab4e0 by Apoorv Ingle at 2025-10-26T20:49:34-05:00 change add arg ctxt to be verbose - - - - - b2a7a323 by Apoorv Ingle at 2025-10-26T20:49:34-05:00 make sure context is not updated when tcl_in_gen is set - - - - - 3bd8e5fd by Apoorv Ingle at 2025-10-26T20:49:34-05:00 remote tcl_in_gen_code - - - - - f90464af by Apoorv Ingle at 2025-10-26T20:49:35-05:00 kill popErrCtxt - - - - - c9d26f37 by Apoorv Ingle at 2025-10-26T21:43:39-05:00 wibbles - - - - - 431 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Breakpoints.hs - + compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/UniqueRenamer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - + compiler/GHC/Driver/ByteCode.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Config/Stg/Debug.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Messager.hs - compiler/GHC/Driver/Monad.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Flags.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/JS/JStg/Monad.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Dynamic.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Platform.hs - compiler/GHC/Platform/Reg.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Stg/Debug.hs - + compiler/GHC/Stg/Debug/Types.hs - compiler/GHC/Stg/EnforceEpt.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/ExtCode.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.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/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/CtLoc.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Unify.hs-boot - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/SourceError.hs - compiler/GHC/Types/SptEntry.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Types/TyThing/Ppr.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/DSM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/Module/WholeCoreBindings.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Error.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - + libraries/ghc-internal/cbits/RtsIface.c - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/include/RtsIfaceSymbols.h - + libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - libraries/ghc-internal/tests/stack-annotation/all.T - libraries/ghc-prim/changelog.md - + libraries/template-haskell-lift - + libraries/template-haskell-quasiquoter - m4/fptools_alex.m4 - m4/fptools_happy.m4 - rts/BuiltinClosures.c - rts/CloneStack.h - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/Prelude.h - rts/PrimOps.cmm - rts/Printer.c - rts/RtsAPI.c - rts/RtsStartup.c - rts/RtsSymbols.c - + rts/RtsToHsIface.c - rts/StgStdThunks.cmm - rts/configure.ac - − rts/external-symbols.list.in - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/Stg.h - + rts/include/rts/RtsToHsIface.h - rts/include/rts/Types.h - rts/include/rts/storage/Block.h - rts/include/stg/Prim.h - rts/posix/OSMem.c - rts/posix/Signals.c - libraries/ghc-internal/cbits/atomic.c → rts/prim/atomic.c - libraries/ghc-internal/cbits/bitrev.c → rts/prim/bitrev.c - libraries/ghc-internal/cbits/bswap.c → rts/prim/bswap.c - libraries/ghc-internal/cbits/clz.c → rts/prim/clz.c - libraries/ghc-internal/cbits/ctz.c → rts/prim/ctz.c - libraries/ghc-internal/cbits/int64x2minmax.c → rts/prim/int64x2minmax.c - libraries/ghc-internal/cbits/longlong.c → rts/prim/longlong.c - libraries/ghc-internal/cbits/mulIntMayOflo.c → rts/prim/mulIntMayOflo.c - libraries/ghc-internal/cbits/pdep.c → rts/prim/pdep.c - libraries/ghc-internal/cbits/pext.c → rts/prim/pext.c - libraries/ghc-internal/cbits/popcnt.c → rts/prim/popcnt.c - libraries/ghc-internal/cbits/vectorQuotRem.c → rts/prim/vectorQuotRem.c - libraries/ghc-internal/cbits/word2float.c → rts/prim/word2float.c - − rts/rts.buildinfo.in - rts/rts.cabal - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Scav.c - rts/wasm/JSFFI.c - rts/wasm/scheduler.cmm - rts/win32/libHSghc-internal.def - testsuite/driver/cpu_features.py - testsuite/tests/bytecode/T24634/T24634a.stdout - testsuite/tests/bytecode/T24634/T24634b.stdout - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_gen_asm/mavx-should-enable-popcnt.asm - + testsuite/tests/codeGen/should_gen_asm/mavx-should-enable-popcnt.hs - + testsuite/tests/codeGen/should_gen_asm/msse-option-order.asm - + testsuite/tests/codeGen/should_gen_asm/msse-option-order.hs - testsuite/tests/concurrent/prog001/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/cpranal/should_compile/T18174.stderr - + testsuite/tests/deSugar/should_compile/T10662 - testsuite/tests/default/default-fail05.stderr - testsuite/tests/driver/T11429c.stderr - testsuite/tests/driver/T21682.stderr - + testsuite/tests/driver/bytecode-object/A.hs - + testsuite/tests/driver/bytecode-object/BytecodeForeign.c - + testsuite/tests/driver/bytecode-object/BytecodeForeign.hs - + testsuite/tests/driver/bytecode-object/BytecodeMain.hs - + testsuite/tests/driver/bytecode-object/BytecodeTest.hs - + testsuite/tests/driver/bytecode-object/Makefile - + testsuite/tests/driver/bytecode-object/all.T - + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr - + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object19.script - + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object25.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout - testsuite/tests/driver/fat-iface/T22405/T22405.stdout - testsuite/tests/driver/fat-iface/T22405/T22405b.stdout - testsuite/tests/driver/fat-iface/fat011.stderr - testsuite/tests/ghc-api/T10942.hs - + testsuite/tests/ghc-api/T26264.hs - + testsuite/tests/ghc-api/T26264.stdout - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/annotations-literals/literals.hs - + testsuite/tests/ghci.debugger/Do - + testsuite/tests/ghci.debugger/Do.hs - + testsuite/tests/ghci.debugger/T25996.hs - testsuite/tests/indexed-types/should_fail/T14887.stderr - testsuite/tests/indexed-types/should_fail/T2693.stderr - testsuite/tests/indexed-types/should_fail/T5439.stderr - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/linear/should_fail/T19361.stderr - testsuite/tests/llvm/should_run/all.T - testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr - testsuite/tests/overloadedrecflds/should_fail/T16745.stderr - testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux1.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux2.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - + testsuite/tests/patsyn/should_compile/T26465b.hs - + testsuite/tests/patsyn/should_compile/T26465c.hs - + testsuite/tests/patsyn/should_compile/T26465d.hs - + testsuite/tests/patsyn/should_compile/T26465d.stderr - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/patsyn/should_fail/T26465.hs - + testsuite/tests/patsyn/should_fail/T26465.stderr - testsuite/tests/patsyn/should_fail/all.T - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithBytecodeFiles.script - testsuite/tests/perf/compiler/all.T - testsuite/tests/perf/should_run/T3586.hs - testsuite/tests/perf/should_run/UniqLoop.hs - testsuite/tests/perf/should_run/all.T - testsuite/tests/plugins/test-defaulting-plugin.stderr - + testsuite/tests/pmcheck/should_compile/T26400.hs - + testsuite/tests/pmcheck/should_compile/T26400.stderr - + testsuite/tests/pmcheck/should_compile/T26400b.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/polykinds/T13393.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/regalloc/regalloc_unit_tests.hs - testsuite/tests/rename/should_fail/T19843h.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/roles/should_compile/Roles13.stderr - testsuite/tests/rts/T22859.hs - + testsuite/tests/rts/ipe/distinct-tables/Main.hs - + testsuite/tests/rts/ipe/distinct-tables/Makefile - + testsuite/tests/rts/ipe/distinct-tables/X.hs - + testsuite/tests/rts/ipe/distinct-tables/all.T - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables01.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables02.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables03.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables04.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables05.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables06.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables07.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables08.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables09.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables10.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables11.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables12.stdout - + testsuite/tests/rts/ipe/distinct-tables/distinct_tables13.stdout - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/simd015.hs - + testsuite/tests/simd/should_run/simd015.stdout - + testsuite/tests/simd/should_run/simd016.hs - + testsuite/tests/simd/should_run/simd016.stdout - + testsuite/tests/simd/should_run/simd017.hs - + testsuite/tests/simd/should_run/simd017.stdout - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T17673.stderr - testsuite/tests/simplCore/should_compile/T18078.stderr - testsuite/tests/simplCore/should_compile/T18995.stderr - testsuite/tests/simplCore/should_compile/T19890.stderr - testsuite/tests/simplCore/should_compile/T21948.stderr - testsuite/tests/simplCore/should_compile/T21960.stderr - testsuite/tests/simplCore/should_compile/T24808.stderr - − testsuite/tests/simplCore/should_compile/T25713.stderr - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/rule2.stderr - testsuite/tests/simplStg/should_compile/T22840.stderr - testsuite/tests/th/T8761.stderr - testsuite/tests/typecheck/no_skolem_info/T20232.stderr - testsuite/tests/typecheck/should_compile/T14590.stderr - + testsuite/tests/typecheck/should_compile/T25996.hs - 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/T11672.stderr - testsuite/tests/typecheck/should_fail/T12373.stderr - testsuite/tests/typecheck/should_fail/T13311.stderr - testsuite/tests/typecheck/should_fail/T15807.stderr - testsuite/tests/typecheck/should_fail/T16074.stderr - testsuite/tests/typecheck/should_fail/T18357a.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T20241b.stderr - testsuite/tests/typecheck/should_fail/T21530a.stderr - testsuite/tests/typecheck/should_fail/T24064.stderr - + testsuite/tests/typecheck/should_fail/T25970.hs - + testsuite/tests/typecheck/should_fail/T25996.hs - 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/UnliftedNewtypesFamilyKindFail2.stderr - testsuite/tests/typecheck/should_fail/VisFlag1.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 - utils/check-exact/Parsers.hs - utils/check-exact/Preprocess.hs - utils/deriveConstants/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/436d9f72a594aefd81f4be10291677… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/436d9f72a594aefd81f4be10291677… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/backports-9.14] 3 commits: testsuite: Accept new base-exports output
by Ben Gamari (＠bgamari) 27 Oct '25

27 Oct '25

Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC Commits: a343b2a3 by Ben Gamari at 2025-10-26T20:05:37-04:00 testsuite: Accept new base-exports output - - - - - df252ddd by Ben Gamari at 2025-10-26T20:05:37-04:00 template-haskell: Accept T15321 - - - - - 405c2315 by Ben Gamari at 2025-10-26T20:05:37-04:00 testsuite: Accept new template-haskell-exports output - - - - - 8 changed files: - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/th/T15321.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/387872bdf05feec31489a5f0873a58… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/387872bdf05feec31489a5f0873a58… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26349] More
by Simon Peyton Jones (＠simonpj) 27 Oct '25

27 Oct '25

Simon Peyton Jones pushed to branch wip/T26349 at Glasgow Haskell Compiler / GHC Commits: 2004c1aa by Simon Peyton Jones at 2025-10-26T23:43:34+00:00 More - - - - - 5 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -809,7 +809,7 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args = do { let herald = case fun_ctxt of VAExpansion (OrigStmt{}) _ _ -> ExpectedFunTySyntaxOp DoOrigin tc_fun _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) (unLoc arg) - ; (wrap, arg_ty, res_ty) <- + ; (fun_co, arg_ty, res_ty) <- -- NB: matchActualFunTy does the rep-poly check. -- For example, suppose we have f :: forall r (a::TYPE r). a -> Int -- In an application (f x), we need 'x' to have a fixed runtime @@ -820,7 +820,7 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args (n_val_args, fun_sigma) fun_ty ; arg' <- quickLookArg do_ql ctxt arg arg_ty - ; let acc' = arg' : addArgWrap wrap acc + ; let acc' = arg' : addArgWrap (mkWpCastN fun_co) acc ; go (pos+1) acc' res_ty rest_args } new_arg_ty :: LHsExpr GhcRn -> Int -> TcM (Scaled TcType) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -765,13 +765,13 @@ tcInferOverLit lit@(OverLit { ol_val = val thing = NameThing from_name mb_thing = Just thing herald = ExpectedFunTyArg thing (HsLit noExtField hs_lit) - ; (wrap2, sarg_ty, res_ty) <- matchActualFunTy herald mb_thing (1, from_ty) from_ty + ; (co2, sarg_ty, res_ty) <- matchActualFunTy herald mb_thing (1, from_ty) from_ty ; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty) -- See Note [Source locations for implicit function calls] in GHC.Iface.Ext.Ast ; let lit_expr = L (l2l loc) $ mkHsWrapCo co $ HsLit noExtField hs_lit - from_expr = mkHsWrap (wrap2 <.> wrap1) $ + from_expr = mkHsWrap (mkWpCastN co2 <.> wrap1) $ mkHsVar (L loc from_id) witness = HsApp noExtField (L (l2l loc) from_expr) lit_expr lit' = OverLit { ol_val = val ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -701,7 +701,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of -- Expression must be a function ; let herald = ExpectedFunTyViewPat $ unLoc expr - ; (expr_wrap1, Scaled _mult inf_arg_ty, inf_res_sigma) + ; (expr_co1, Scaled _mult inf_arg_ty, inf_res_sigma) <- matchActualFunTy herald (Just . HsExprRnThing $ unLoc expr) (1,expr_rho) expr_rho -- See Note [View patterns and polymorphism] -- expr_wrap1 :: expr_rho "->" (inf_arg_ty -> inf_res_sigma) @@ -722,7 +722,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of -- NB: pat_ty comes from matchActualFunTy, so it has a -- fixed RuntimeRep, as needed to call mkWpFun. - expr_wrap = expr_wrap2' <.> expr_wrap1 + expr_wrap = expr_wrap2' <.> mkWpCastN expr_co1 ; return $ (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res) } ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -290,19 +290,24 @@ mkWpFun :: HsWrapper -> HsWrapper -> TcType -- ^ Either "from" type or "to" type of the second wrapper -- (used only when the second wrapper is the identity) -> HsWrapper -mkWpFun WpHole WpHole _ _ = WpHole -mkWpFun w_arg w_res t1 t2 = WpFun w_arg w_res t1 t2 - -- In this case, we will desugar to a lambda - -- - -- \x. w_res[ e w_arg[x] ] - -- - -- To satisfy Note [Representation polymorphism invariants] in GHC.Core, - -- it must be the case that both the lambda bound variable x and the function - -- argument w_arg[x] have a fixed runtime representation, i.e. that both the - -- "from" and "to" types of the first wrapper "w_arg" have a fixed runtime representation. - -- - -- Unfortunately, we can't check this with an assertion here, because of - -- [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. +mkWpFun w1 w2 st1@(Scaled m1 t1) t2 + = case (w1,w2) of + (WpHole, WpHole) -> WpHole + (WpHole, WpCast co2) -> WpCast (mk_wp_fun_co m1 (mkRepReflCo t1) co2) + (WpCast co1, WpHole) -> WpCast (mk_wp_fun_co m1 (mkSymCo co1) (mkRepReflCo t2)) + (WpCast co1, WpCast co2) -> WpCast (mk_wp_fun_co m1 (mkSymCo co1) co2) + (_, _) -> WpFun w1 w2 st1 t2 + -- In the WpFun case, we will desugar to a lambda + -- + -- \x. w_res[ e w_arg[x] ] + -- + -- To satisfy Note [Representation polymorphism invariants] in GHC.Core, + -- it must be the case that both the lambda bound variable x and the function + -- argument w_arg[x] have a fixed runtime representation, i.e. that both the + -- "from" and "to" types of the first wrapper "w_arg" have a fixed runtime representation. + -- + -- Unfortunately, we can't check this with an assertion here, because of + -- [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. mkWpSubType :: HsWrapper -> HsWrapper -- See (DSST2) in Note [Deep subsumption and WpSubType] @@ -446,7 +451,7 @@ optSubTypeHsWrapper wrap opt1 (WpEvLam ev) ws = opt_ev_lam ev ws opt1 (WpTyLam tv) ws = opt_ty_lam tv ws opt1 (WpLet binds) ws = pushWpLet binds ws - opt1 (WpFun w1 w2 sty1 ty2) ws = mk_wp_fun (opt w1) (opt w2) sty1 ty2 ws + opt1 (WpFun w1 w2 sty1 ty2) ws = opt_fun w1 w2 sty1 ty2 ws opt1 w@(WpTyApp {}) ws = w : ws opt1 w@(WpEvApp {}) ws = w : ws @@ -459,6 +464,7 @@ optSubTypeHsWrapper wrap opt_ty_lam tv (WpTyApp ty : ws) | Just tv' <- getTyVar_maybe ty , tv==tv' + , all (not_in tv) ws = ws -- (WpTyLam a <+> WpCastCo co <+> w) @@ -475,6 +481,7 @@ optSubTypeHsWrapper wrap opt_ev_lam ev (WpEvApp ev_tm : ws) | EvExpr (Var ev') <- ev_tm , ev == ev' + , all (not_in ev) ws = ws -- (WpEvLam ev <.> WpCast co <.> w) @@ -497,15 +504,28 @@ optSubTypeHsWrapper wrap | otherwise = WpCast co : ws ------------------ - mk_wp_fun w1 w2 sty1@(Scaled w t1) ty2 ws - = case (w1, w2) of - (WpHole, WpHole) -> ws - (WpHole, WpCast co2) -> co_ify (mkRepReflCo t1) co2 - (WpCast co1, WpHole) -> co_ify (mkSymCo co1) (mkRepReflCo ty2) - (WpCast co1, WpCast co2) -> co_ify (mkSymCo co1) co2 - (w1', w2') -> WpFun w1' w2' sty1 ty2 : ws - where - co_ify co1 co2 = opt_co (mk_wp_fun_co w co1 co2) ws + opt_fun w1 w2 sty1 ty2 ws + = case mkWpFun (opt w1) (opt w2) sty1 ty2 of + WpHole -> ws + WpCast co -> opt_co co ws + w -> w : ws + + ------------------ + -- Tiresome check that the lambda-bound type/evidence variable that we + -- want to eta-reduce isn't free in the rest of the wrapper + not_in :: TyVar -> HsWrapper -> Bool + not_in _ WpHole = True + not_in v (WpCast co) = not (anyFreeVarsOfCo (== v) co) + not_in v (WpTyApp ty) = not (anyFreeVarsOfType (== v) ty) + not_in v (WpFun w1 w2 _ _) = not_in v w1 && not_in v w2 + not_in v (WpSubType w) = not_in v w + not_in v (WpCompose w1 w2) = not_in v w1 && not_in v w2 + not_in v (WpEvApp (EvExpr e)) = not (v `elemVarSet` exprFreeVars e) + not_in _ (WpEvApp (EvTypeable {})) = False -- Giving up; conservative + not_in _ (WpEvApp (EvFun {})) = False -- Giving up; conservative + not_in _ (WpTyLam {}) = False -- Give up; conservative + not_in _ (WpEvLam {}) = False -- Ditto + not_in _ (WpLet {}) = False -- Ditto pushWpLet :: TcEvBinds -> [HsWrapper] -> [HsWrapper] -- See if we can transform ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -147,7 +147,7 @@ matchActualFunTy -- (Both are used only for error messages) -> TcRhoType -- ^ Type to analyse: a TcRhoType - -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) + -> TcM (TcCoercion, Scaled TcSigmaTypeFRR, TcSigmaType) -- This function takes in a type to analyse (a RhoType) and returns -- an argument type and a result type (splitting apart a function arrow). -- The returned argument type is a SigmaType with a fixed RuntimeRep; @@ -171,13 +171,13 @@ matchActualFunTy herald mb_thing err_info fun_ty -- hide the forall inside a meta-variable go :: TcRhoType -- The type we're processing, perhaps after -- expanding type synonyms - -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) + -> TcM (TcCoercion, Scaled TcSigmaTypeFRR, TcSigmaType) go ty | Just ty' <- coreView ty = go ty' go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty }) = assert (isVisibleFunArg af) $ do { hasFixedRuntimeRep_syntactic (FRRExpectedFunTy herald 1) arg_ty - ; return (idHsWrapper, Scaled w arg_ty, res_ty) } + ; return (mkNomReflCo fun_ty, Scaled w arg_ty, res_ty) } go ty@(TyVarTy tv) | isMetaTyVar tv @@ -209,7 +209,7 @@ matchActualFunTy herald mb_thing err_info fun_ty ; res_ty <- newOpenFlexiTyVarTy ; let unif_fun_ty = mkScaledFunTys [arg_ty] res_ty ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, arg_ty, res_ty) } + ; return (co, arg_ty, res_ty) } ------------ mk_ctxt :: TcType -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) @@ -248,8 +248,8 @@ matchActualFunTys :: ExpectedFunTyOrigin -- ^ See Note [Herald for matchExpected -> Arity -> TcSigmaType -> TcM (HsWrapper, [Scaled TcSigmaTypeFRR], TcRhoType) --- If matchActualFunTys n ty = (wrap, [t1,..,tn], res_ty) --- then wrap : ty ~> (t1 -> ... -> tn -> res_ty) +-- If matchActualFunTys n fun_ty = (wrap, [t1,..,tn], res_ty) +-- then wrap : fun_ty ~> (t1 -> ... -> tn -> res_ty) -- and res_ty is a RhoType -- NB: the returned type is top-instantiated; it's a RhoType matchActualFunTys herald ct_orig n_val_args_wanted top_ty @@ -264,15 +264,13 @@ matchActualFunTys herald ct_orig n_val_args_wanted top_ty go 0 _ fun_ty = return (idHsWrapper, [], fun_ty) go n so_far fun_ty - = do { (wrap_fun1, arg_ty1, res_ty1) <- matchActualFunTy - herald Nothing - (n_val_args_wanted, top_ty) - fun_ty - ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1 + = do { (co1, arg_ty1, res_ty1) <- matchActualFunTy herald Nothing + (n_val_args_wanted, top_ty) fun_ty + ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1 ; let wrap_fun2 = mkWpFun idHsWrapper wrap_res arg_ty1 res_ty -- NB: arg_ty1 comes from matchActualFunTy, so it has - -- a syntactically fixed RuntimeRep as needed to call mkWpFun. - ; return (wrap_fun2 <.> wrap_fun1, arg_ty1:arg_tys, res_ty) } + -- a syntactically fixed RuntimeRep + ; return (wrap_fun2 <.> mkWpCastN co1, arg_ty1:arg_tys, res_ty) } {- ************************************************************************ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2004c1aab855043dd009f10df32f0fc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2004c1aab855043dd009f10df32f0fc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-spj] 16 commits: Fix stack decoding when using profiled runtime
by Simon Peyton Jones (＠simonpj) 27 Oct '25

27 Oct '25

Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC Commits: 38d65187 by Matthew Pickering at 2025-10-21T13:12:20+01:00 Fix stack decoding when using profiled runtime There are three fixes in this commit. * We need to replicate the `InfoTable` and `InfoTableProf` approach for the other stack constants (see the new Stack.ConstantsProf file). * Then we need to appropiately import the profiled or non-profiled versions. * Finally, there was an incorrect addition in `stackFrameSize`. We need to cast after performing addition on words. Fixes #26507 - - - - - 17231bfb by fendor at 2025-10-21T13:12:20+01:00 Add regression test for #26507 - - - - - 4f5bf93b by Simon Peyton Jones at 2025-10-25T04:05:34-04:00 Postscript to fix for #26255 This MR has comments only - - - - - 6ef22fa0 by IC Rainbow at 2025-10-26T18:23:01-04:00 Add SIMD primops for bitwise logical operations This adds 128-bit wide and/or/xor instructions for X86 NCG, with both SSE and AVX encodings. ``` andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# -- andps / vandps andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# -- andpd / vandpd andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# -- pand / vpand ``` The new primops are available on ARM when using LLVM backend. Tests added: - simd015 (floats and doubles) - simd016 (integers) - simd017 (words) Fixes #26417 - - - - - fbdc623a by sheaf at 2025-10-26T18:23:52-04:00 Add hints for unsolved HasField constraints This commit adds hints and explanations for unsolved 'HasField' constraints. GHC will now provide additional explanations for an unsolved constraint of the form 'HasField fld_name rec_ty fld_ty'; the details are laid out in Note [Error messages for unsolved HasField constraints], but briefly: 1. Provide similar name suggestions (e.g. mis-spelled field name) and import suggestions (record field not in scope). These result in actionable 'GhcHints', which is helpful to provide code actions in HLS. 2. Explain why GHC did not solve the constraint, e.g.: - 'fld_name' is not a string literal (e.g. a type variable) - 'rec_ty' is a TyCon without any fields, e.g. 'Int' or 'Bool'. - 'fld_ty' contains existentials variables or foralls. - The record field is a pattern synonym field (GHC does not generate HasField instances for those). - 'HasField' is a custom 'TyCon', not actually the built-in 'HasField' typeclass from 'GHC.Records'. On the way, we slightly refactor the mechanisms for import suggestions in GHC.Rename.Unbound. This is to account for the fact that, for 'HasField', we don't care whether the field is imported qualified or unqualified. 'importSuggestions' was refactored, we now have 'sameQualImportSuggestions' and 'anyQualImportSuggestions'. Fixes #18776 #22382 #26480 - - - - - 99d5707f by sheaf at 2025-10-26T18:23:52-04:00 Rename PatSyn MatchContext to PatSynCtx to avoid punning - - - - - 19f27e96 by Richard Eisenberg at 2025-10-26T22:34:44+00:00 Refactor fundep solving This commit is a large-scale refactor of the increasingly-messy code that handles functional dependencies. It has virtually no effect on what compiles but improves error messages a bit. And it does the groundwork for #23162. The big picture is described in Note [Overview of functional dependencies in type inference] in GHC.Tc.Solver.FunDeps * New module GHC.Tc.Solver.FunDeps contains all the fundep-handling code for the constraint solver. * Fundep-equalities are solved in a nested scope; they may generate unifications but otherwise have no other effect. See GHC.Tc.Solver.FunDeps.solveFunDeps The nested needs to start from the Givens in the inert set, but not the Wanteds; hence a new function `resetInertCans`, used in `nestFunDepsTcS`. * That in turn means that fundep equalities never show up in error messages, so the complicated FunDepOrigin tracking can all disappear. * We need to be careful about tracking unifications, so we kick out constraints from the inert set after doing unifications. Unification tracking has been majorly reformed: see Note [WhatUnifications] in GHC.Tc.Utils.Unify. A good consequence is that the hard-to-grok `resetUnificationFlag` has been replaced with a simpler use of `reportCoarseGrainUnifications` Smaller things: * Rename `FunDepEqn` to `FunDepEqns` since it contains multiple type equalities. Some compile time improvement Metrics: compile_time/bytes allocated Baseline Test value New value Change ---------------------- -------------------------------------- T5030(normal) 173,839,232 148,115,248 -14.8% GOOD hard_hole_fits(normal) 286,768,048 284,015,416 -1.0% geo. mean -0.2% minimum -14.8% maximum +0.3% Metric Decrease: T5030 - - - - - 0a5edc57 by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 QuickLook's tcInstFun should make instantiation variables directly tcInstFun must make "instantiation variables", not regular unification variables, when instantiating function types. That was previously implemented by a hack: set the /ambient/ level to QLInstTyVar. But the hack finally bit me, when I was refactoring WhatUnifications. And it was always wrong: see the now-expunged (TCAPP2) note. This commit does it right, by making tcInstFun call its own instantiation functions. That entails a small bit of duplication, but the result is much, much cleaner. - - - - - 91ecdff2 by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Build implication for constraints from (static e) This commit addresses #26466, by buiding an implication for the constraints arising from a (static e) form. The implication has a special ic_info field of StaticFormSkol, which tells the constraint solver to use an empty set of Givens. See (SF3) in Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable This commit also reinstates an `assert` in GHC.Tc.Solver.Equality. The test `StaticPtrTypeFamily` was failing with an assertion failure, but it now works. - - - - - b6c3e03d by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Comments about defaulting representation equalities - - - - - 7092e1cd by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Improve tracking of rewriter-sets This refactor substantially improves the treatment of so-called "rewriter-sets" in the constraint solver. The story is described in the rewritten Note [Wanteds rewrite Wanteds: rewriter-sets] in GHC.Tc.Types.Constraint Some highlights * Trace the free coercion holes of a filled CoercionHole, in CoercionPlusHoles. See Note [Coercion holes] (COH5) This avoids taking having to take the free coercion variables of a coercion when zonking a rewrriter-set * Many knock on changes * Make fillCoercionHole take CoercionPlusHoles as its argument rather than to separate arguments. * Similarly setEqIfWanted, setWantedE, wrapUnifierAndEmit. * Be more careful about passing the correct CoHoleSet to `rewriteEqEvidence` and friends * Make kickOurAfterFillingCoercionHole more clever. See new Note [Kick out after filling a coercion hole] Smaller matters * Rename RewriterSet to CoHoleSet * Add special-case helper `rewriteEqEvidenceSwapOnly` - - - - - 47d5baaa by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Tidy up constraint solving for foralls * In `can_eq_nc_forall` make sure to track Givens that are used in the nested solve step. * Tiny missing-swap bug-fix in `lookup_eq_in_qcis` * Fix some leftover mess from commit 14123ee646f2b9738a917b7cec30f9d3941c13de Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Wed Aug 20 00:35:48 2025 +0100 Solve forall-constraints via an implication, again Specifically, trySolveImplication is now dead. - - - - - d1781171 by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Do not treat CoercionHoles as free variables in coercions This fixes a long-standing wart in the free-variable finder; now CoercionHoles are no longer treated as a "free variable" of a coercion. I got big and unexpected performance regressions when making this change. Turned out that CallArity didn't discover that the free variable finder could be eta-expanded, which gave very poor code. So I re-used Note [The one-shot state monad trick] for Endo, resulting in GHC.Utils.EndoOS. Very simple, big win. - - - - - e23d6b31 by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Update debug-tracing in CallArity No effect on behaviour, and commented out anyway - - - - - 24c958bb by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Comments only -- remove dangling Note references - - - - - b24482e2 by Simon Peyton Jones at 2025-10-26T22:34:53+00:00 Accept error message wibbles - - - - - 152 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - + compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Unique/DSM.hs - + compiler/GHC/Utils/EndoOS.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - libraries/ghc-internal/tests/stack-annotation/all.T - libraries/ghc-prim/changelog.md - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/default/default-fail05.stderr - testsuite/tests/dependent/should_fail/T13135_simple.stderr - testsuite/tests/deriving/should_fail/T3621.stderr - testsuite/tests/indexed-types/should_fail/T14369.stderr - testsuite/tests/indexed-types/should_fail/T1897b.stderr - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/linters/notes.stdout - + testsuite/tests/overloadedrecflds/should_fail/T26480.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux1.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux2.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - testsuite/tests/parser/should_fail/T20654a.stderr - testsuite/tests/partial-sigs/should_fail/T14584a.stderr - testsuite/tests/polykinds/T6068.stdout - testsuite/tests/quantified-constraints/T15359.hs - testsuite/tests/rename/should_fail/T19843h.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRightSection.stderr - testsuite/tests/rep-poly/T13233.stderr - testsuite/tests/rep-poly/T19709b.stderr - testsuite/tests/rep-poly/T23903.stderr - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/simd015.hs - + testsuite/tests/simd/should_run/simd015.stdout - + testsuite/tests/simd/should_run/simd016.hs - + testsuite/tests/simd/should_run/simd016.stdout - + testsuite/tests/simd/should_run/simd017.hs - + testsuite/tests/simd/should_run/simd017.stdout - testsuite/tests/typecheck/no_skolem_info/T13499.stderr - testsuite/tests/typecheck/should_compile/T13651.hs - − testsuite/tests/typecheck/should_compile/T13651.stderr - + testsuite/tests/typecheck/should_compile/T14745.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr - testsuite/tests/typecheck/should_compile/tc126.hs - testsuite/tests/typecheck/should_fail/AmbigFDs.hs - − testsuite/tests/typecheck/should_fail/AmbigFDs.stderr - testsuite/tests/typecheck/should_fail/FD3.stderr - testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr - testsuite/tests/typecheck/should_fail/T13506.stderr - testsuite/tests/typecheck/should_fail/T16512a.stderr - testsuite/tests/typecheck/should_fail/T18851b.hs - − testsuite/tests/typecheck/should_fail/T18851b.stderr - testsuite/tests/typecheck/should_fail/T18851c.hs - − testsuite/tests/typecheck/should_fail/T18851c.stderr - testsuite/tests/typecheck/should_fail/T19415.stderr - testsuite/tests/typecheck/should_fail/T19415b.stderr - testsuite/tests/typecheck/should_fail/T22684.stderr - + testsuite/tests/typecheck/should_fail/T23162a.hs - + testsuite/tests/typecheck/should_fail/T23162a.stderr - testsuite/tests/typecheck/should_fail/T25325.stderr - testsuite/tests/typecheck/should_fail/T5246.stderr - testsuite/tests/typecheck/should_fail/T5978.stderr - testsuite/tests/typecheck/should_fail/T7368a.stderr - testsuite/tests/typecheck/should_fail/T7696.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr - testsuite/tests/typecheck/should_fail/TcStaticPointersFail03.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail122.stderr - testsuite/tests/typecheck/should_fail/tcfail143.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bea7fbdfe64e5d96f29813bc3ef927… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bea7fbdfe64e5d96f29813bc3ef927… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Add hints for unsolved HasField constraints
by Marge Bot (＠marge-bot) 27 Oct '25

27 Oct '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fbdc623a by sheaf at 2025-10-26T18:23:52-04:00 Add hints for unsolved HasField constraints This commit adds hints and explanations for unsolved 'HasField' constraints. GHC will now provide additional explanations for an unsolved constraint of the form 'HasField fld_name rec_ty fld_ty'; the details are laid out in Note [Error messages for unsolved HasField constraints], but briefly: 1. Provide similar name suggestions (e.g. mis-spelled field name) and import suggestions (record field not in scope). These result in actionable 'GhcHints', which is helpful to provide code actions in HLS. 2. Explain why GHC did not solve the constraint, e.g.: - 'fld_name' is not a string literal (e.g. a type variable) - 'rec_ty' is a TyCon without any fields, e.g. 'Int' or 'Bool'. - 'fld_ty' contains existentials variables or foralls. - The record field is a pattern synonym field (GHC does not generate HasField instances for those). - 'HasField' is a custom 'TyCon', not actually the built-in 'HasField' typeclass from 'GHC.Records'. On the way, we slightly refactor the mechanisms for import suggestions in GHC.Rename.Unbound. This is to account for the fact that, for 'HasField', we don't care whether the field is imported qualified or unqualified. 'importSuggestions' was refactored, we now have 'sameQualImportSuggestions' and 'anyQualImportSuggestions'. Fixes #18776 #22382 #26480 - - - - - 99d5707f by sheaf at 2025-10-26T18:23:52-04:00 Rename PatSyn MatchContext to PatSynCtx to avoid punning - - - - - 29 changed files: - compiler/GHC/Core/ConLike.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Expr.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux1.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux2.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - testsuite/tests/rename/should_fail/T19843h.stderr Changes: ===================================== compiler/GHC/Core/ConLike.hs ===================================== @@ -26,6 +26,8 @@ module GHC.Core.ConLike ( , conLikeFieldType , conLikeIsInfix , conLikeHasBuilder + + , isExistentialRecordField ) where import GHC.Prelude @@ -35,7 +37,7 @@ import GHC.Core.Multiplicity import GHC.Core.PatSyn import GHC.Core.TyCo.Rep (Type, ThetaType) import GHC.Core.TyCon (tyConDataCons) -import GHC.Core.Type(mkTyConApp) +import GHC.Core.Type(mkTyConApp, tyCoVarsOfType) import GHC.Types.Unique import GHC.Types.Name import GHC.Types.Name.Reader @@ -43,6 +45,7 @@ import GHC.Types.Basic import GHC.Types.GREInfo import GHC.Types.Var +import GHC.Types.Var.Set import GHC.Utils.Misc import GHC.Utils.Outputable @@ -239,3 +242,23 @@ conLikeFieldType (RealDataCon dc) label = dataConFieldType dc label conLikeIsInfix :: ConLike -> Bool conLikeIsInfix (RealDataCon dc) = dataConIsInfix dc conLikeIsInfix (PatSynCon ps) = patSynIsInfix ps + +-- | Is this record field a naughty record field due to the presence of +-- existential type variables? +-- +-- Different from 'isNaughtyRecordSelector' because the latter is also true +-- in the presence of @-XNoFieldSelectors@. +-- +-- See Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. +isExistentialRecordField :: Type -> ConLike -> Bool +isExistentialRecordField field_ty con = + case con of + RealDataCon {} -> not $ field_ty_tvs `subVarSet` res_ty_tvs + PatSynCon {} -> not $ field_ty_tvs `subVarSet` mkVarSet univ_tvs + -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but + -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in + -- GHC.Core.PatSyn, so no need to check them. + where + field_ty_tvs = tyCoVarsOfType field_ty + res_ty_tvs = tyCoVarsOfType data_ty + (univ_tvs, _, _, _, _, _, data_ty) = conLikeFullSig con ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1898,7 +1898,7 @@ matchSeparator PatBindRhs = text "=" matchSeparator PatBindGuards = text "=" matchSeparator StmtCtxt{} = text "<-" matchSeparator RecUpd = text "=" -- This can be printed by the pattern -matchSeparator PatSyn = text "<-" -- match checker trace +matchSeparator PatSynCtx = text "<-" -- match checker trace matchSeparator LazyPatCtx = panic "unused" matchSeparator ThPatSplice = panic "unused" matchSeparator ThPatQuote = panic "unused" @@ -2494,7 +2494,7 @@ instance Outputable fn => Outputable (HsMatchContext fn) where ppr (StmtCtxt _) = text "StmtCtxt _" ppr ThPatSplice = text "ThPatSplice" ppr ThPatQuote = text "ThPatQuote" - ppr PatSyn = text "PatSyn" + ppr PatSynCtx = text "PatSynCtx" ppr LazyPatCtx = text "LazyPatCtx" instance Outputable HsLamVariant where @@ -2538,7 +2538,7 @@ matchContextErrString RecUpd = text "record update" matchContextErrString (ArrowMatchCtxt c) = matchArrowContextErrString c matchContextErrString ThPatSplice = panic "matchContextErrString" -- Not used at runtime matchContextErrString ThPatQuote = panic "matchContextErrString" -- Not used at runtime -matchContextErrString PatSyn = text "pattern synonym" +matchContextErrString PatSynCtx = text "pattern synonym" matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c) matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c) matchContextErrString (StmtCtxt (PatGuard _)) = text "pattern guard" @@ -2613,7 +2613,7 @@ pprMatchContextNoun PatBindGuards = text "pattern binding guards" pprMatchContextNoun (ArrowMatchCtxt c) = pprArrowMatchContextNoun c pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" $$ pprAStmtContext ctxt -pprMatchContextNoun PatSyn = text "pattern synonym declaration" +pprMatchContextNoun PatSynCtx = text "pattern synonym declaration" pprMatchContextNoun LazyPatCtx = text "irrefutable pattern" pprMatchContextNouns :: Outputable fn => HsMatchContext fn -> SDoc ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -93,7 +93,7 @@ exhaustiveWarningFlag (ArrowMatchCtxt c) = arrowMatchContextExhaustiveWarningFla exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd exhaustiveWarningFlag LazyPatCtx = Just Opt_WarnIncompleteUniPatterns exhaustiveWarningFlag ThPatSplice = Nothing -exhaustiveWarningFlag PatSyn = Nothing +exhaustiveWarningFlag PatSynCtx = Nothing exhaustiveWarningFlag ThPatQuote = Nothing -- Don't warn about incomplete patterns in list comprehensions, pattern guards -- etc. They are often *supposed* to be incomplete ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; let scoped_tvs = sig_fn name ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ - rnPat PatSyn pat $ \pat' -> + rnPat PatSynCtx pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported -- from the left-hand side ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -2453,8 +2453,8 @@ badImportItemErr iface decl_spec ie sub avails = do -- Only keep imported items, and set the "HowInScope" to -- "Nothing" to avoid printing "imported from..." in the suggestion -- error message. - imported_item (SimilarRdrName rdr_name (Just (ImportedBy {}))) - = Just (SimilarRdrName rdr_name Nothing) + imported_item (SimilarRdrName rdr_name gre (Just (ImportedBy {}))) + = Just (SimilarRdrName rdr_name gre Nothing) imported_item _ = Nothing checkIfDataCon = checkIfAvailMatches isDataConName ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -18,6 +18,7 @@ module GHC.Rename.Unbound , unknownNameSuggestionsMessage , similarNameSuggestions , fieldSelectorSuggestions + , anyQualImportSuggestions , WhatLooking(..) , WhereLooking(..) , LookingFor(..) @@ -215,7 +216,7 @@ unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env , map (ImportSuggestion $ rdrNameOcc tried_rdr_name) imp_suggs , extensionSuggestions tried_rdr_name , fieldSelectorSuggestions global_env tried_rdr_name ] - (imp_errs, imp_suggs) = importSuggestions looking_for hpt curr_mod imports tried_rdr_name + (imp_errs, imp_suggs) = sameQualImportSuggestions looking_for hpt curr_mod imports tried_rdr_name if_ne :: (NonEmpty a -> b) -> [a] -> [b] if_ne _ [] = [] @@ -242,7 +243,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env all_possibilities :: [(String, SimilarName)] all_possibilities = case what_look of WL_None -> [] - _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc)) + _ -> [ (showPpr dflags r, SimilarRdrName r Nothing (Just $ LocallyBoundAt loc)) | (r,loc) <- local_possibilities local_env ] ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] @@ -273,7 +274,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)] global_possibilities global_env - | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how)) + | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just gre) (Just how)) | gre <- globalRdrEnvElts global_env , isGreOk looking_for gre , let occ = greOccName gre @@ -288,7 +289,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env rdr_unqual = mkRdrUnqual occ , is_relevant occ , sim <- case (unquals_in_scope gre, quals_only gre) of - (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ] + (how:_, _) -> [ SimilarRdrName rdr_unqual (Just gre) (Just how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] ([], []) -> [] ] @@ -316,45 +317,74 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env quals_only :: GlobalRdrElt -> [SimilarName] -- Ones for which *only* the qualified version is in scope quals_only (gre@GRE { gre_imp = is }) - = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec)) + = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just gre) (Just $ ImportedBy ispec)) | i <- bagToList is, let ispec = is_decl i, is_qual ispec ] +-- | Provide import suggestions, without filtering by module qualification. +-- Used to suggest imports for 'HasField', which doesn't care about whether a +-- name is imported qualified or unqualified. +-- +-- For example: +-- +-- > import M1 () -- M1 exports fld1 +-- > import qualified M2 hiding ( fld2 ) +-- > x r = r.fld1 -- suggest adding 'fld1' to M1 import +-- > y r = getField @"fld2" r -- suggest unhiding 'fld' from M2 import +anyQualImportSuggestions :: LookingFor -> LookupGRE GREInfo -> TcM [ImportSuggestion] +anyQualImportSuggestions looking_for lookup_gre = + do { imp_info <- getImports + ; let interesting_imports = interestingImports imp_info (const True) + ; return $ + importSuggestions_ looking_for interesting_imports lookup_gre + } --- | Generate errors and helpful suggestions if a qualified name Mod.foo is not in scope. -importSuggestions :: LookingFor - -> InteractiveContext -> Module - -> ImportAvails -> RdrName -> ([ImportError], [ImportSuggestion]) -importSuggestions looking_for ic currMod imports rdr_name - | WL_LocalOnly <- lf_where looking_for = ([], []) - | WL_LocalTop <- lf_where looking_for = ([], []) +-- | The given 'RdrName' is not in scope. Try to find out why that is by looking +-- at the import list, to suggest e.g. changing the import list somehow. +-- +-- For example: +-- +-- > import qualified M1 hiding ( blah1 ) +-- > x = M1.blah -- suggest unhiding blah1 +-- > y = XX.blah1 -- import error: no imports provide the XX qualification prefix +sameQualImportSuggestions + :: LookingFor + -> InteractiveContext + -> Module + -> ImportAvails + -> RdrName + -> ([ImportError], [ImportSuggestion]) +sameQualImportSuggestions looking_for ic currMod imports rdr_name | not (isQual rdr_name || isUnqual rdr_name) = ([], []) - | Just name <- mod_name - , show_not_imported_line name - = ([MissingModule name], []) + | Just rdr_mod_name <- mb_rdr_mod_name + , show_not_imported_line rdr_mod_name + = ([MissingModule rdr_mod_name], []) | is_qualified - , null helpful_imports + , null import_suggs , (mod : mods) <- map fst interesting_imports = ([ModulesDoNotExport (mod :| mods) (lf_which looking_for) occ_name], []) - | mod : mods <- helpful_imports_non_hiding - = ([], [CouldImportFrom (mod :| mods)]) - | mod : mods <- helpful_imports_hiding - = ([], [CouldUnhideFrom (mod :| mods)]) | otherwise - = ([], []) - where + = ([], import_suggs) + where + + interesting_imports = interestingImports imports right_qual_import + + import_suggs = + importSuggestions_ looking_for interesting_imports $ + (LookupOccName (rdrNameOcc rdr_name) $ RelevantGREsFOS WantNormal) + is_qualified = isQual rdr_name - (mod_name, occ_name) = case rdr_name of + (mb_rdr_mod_name, occ_name) = case rdr_name of Unqual occ_name -> (Nothing, occ_name) Qual mod_name occ_name -> (Just mod_name, occ_name) - _ -> panic "importSuggestions: dead code" - + _ -> panic "sameQualImportSuggestions: dead code" - -- What import statements provide "Mod" at all - -- or, if this is an unqualified name, are not qualified imports - interesting_imports = [ (mod, imp) - | (mod, mod_imports) <- M.toList (imp_mods imports) - , Just imp <- return $ pick (importedByUser mod_imports) - ] + -- See Note [When to show/hide the module-not-imported line] + show_not_imported_line :: ModuleName -> Bool -- #15611 + show_not_imported_line modnam + | not (null interactive_imports) = False -- 1 (interactive context) + | not (null interesting_imports) = False -- 1 (normal module import) + | moduleName currMod == modnam = False -- 2 + | otherwise = True -- Choose the imports from the interactive context which might have provided -- a module. @@ -362,18 +392,52 @@ importSuggestions looking_for ic currMod imports rdr_name filter pick_interactive (ic_imports ic) pick_interactive :: InteractiveImport -> Bool - pick_interactive (IIDecl d) | mod_name == Just (unLoc (ideclName d)) = True - | mod_name == fmap unLoc (ideclAs d) = True - pick_interactive (IIModule m) | mod_name == Just (moduleName m) = True + pick_interactive (IIDecl d) | mb_rdr_mod_name == Just (unLoc (ideclName d)) = True + | mb_rdr_mod_name == fmap unLoc (ideclAs d) = True + pick_interactive (IIModule m) | mb_rdr_mod_name == Just (moduleName m) = True pick_interactive _ = False + right_qual_import imv = + case mb_rdr_mod_name of + -- Qual RdrName: only want qualified imports with the same module name + Just rdr_mod_name -> imv_name imv == rdr_mod_name + -- UnQual RdrName: import must be unqualified + Nothing -> not (imv_qualified imv) + +-- | What import statements are relevant? +-- +-- - If we are looking for a qualified name @Mod.blah@, which imports provide @Mod@ at all, +-- - If we are looking for an unqualified name, which imports are themselves unqualified. +interestingImports :: ImportAvails -> (ImportedModsVal -> Bool) -> [(Module, ImportedModsVal)] +interestingImports imports ok_mod_name = + [ (mod, imp) + | (mod, mod_imports) <- M.toList (imp_mods imports) + , Just imp <- return $ pick (importedByUser mod_imports) + ] + + where -- We want to keep only one for each original module; preferably one with an -- explicit import list (for no particularly good reason) pick :: [ImportedModsVal] -> Maybe ImportedModsVal - pick = listToMaybe . sortBy cmp . filter select - where select imv = case mod_name of Just name -> imv_name imv == name - Nothing -> not (imv_qualified imv) - cmp = on compare imv_is_hiding S.<> on SrcLoc.leftmost_smallest imv_span + pick = listToMaybe . sortBy cmp . filter ok_mod_name + where + cmp = on compare imv_is_hiding S.<> on SrcLoc.leftmost_smallest imv_span + +importSuggestions_ + :: LookingFor + -> [(Module, ImportedModsVal)] + -> LookupGRE GREInfo + -> [ImportSuggestion] +importSuggestions_ looking_for interesting_imports lookup_gre + | WL_LocalOnly <- lf_where looking_for = [] + | WL_LocalTop <- lf_where looking_for = [] + | mod : mods <- helpful_imports_non_hiding + = [CouldImportFrom (mod :| mods)] + | mod : mods <- helpful_imports_hiding + = [CouldUnhideFrom (mod :| mods)] + | otherwise + = [] + where -- Which of these would export a 'foo' -- (all of these are restricted imports, because if they were not, we @@ -382,21 +446,13 @@ importSuggestions looking_for ic currMod imports rdr_name where helpful (_,imv) = any (isGreOk looking_for) $ lookupGRE (imv_all_exports imv) - (LookupOccName occ_name $ RelevantGREsFOS WantNormal) + lookup_gre -- Which of these do that because of an explicit hiding list resp. an -- explicit import list (helpful_imports_hiding, helpful_imports_non_hiding) = partition (imv_is_hiding . snd) helpful_imports - -- See Note [When to show/hide the module-not-imported line] - show_not_imported_line :: ModuleName -> Bool -- #15611 - show_not_imported_line modnam - | not (null interactive_imports) = False -- 1 (interactive context) - | not (null interesting_imports) = False -- 1 (normal module import) - | moduleName currMod == modnam = False -- 2 - | otherwise = True - extensionSuggestions :: RdrName -> [GhcHint] extensionSuggestions rdrName | rdrName == mkUnqual varName (fsLit "mdo") || ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -17,6 +17,8 @@ module GHC.Tc.Errors( import GHC.Prelude +import GHC.Builtin.Names (hasFieldClassName) + import GHC.Driver.Env (hsc_units) import GHC.Driver.DynFlags import GHC.Driver.Ppr @@ -31,6 +33,7 @@ import GHC.Tc.Errors.Ppr import GHC.Tc.Types.Constraint import GHC.Tc.Types.CtLoc import GHC.Tc.Utils.TcMType +import GHC.Tc.Utils.Env (tcLookupId, tcLookupDataCon) import GHC.Tc.Zonk.Type import GHC.Tc.Utils.TcType import GHC.Tc.Zonk.TcType @@ -43,6 +46,7 @@ import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits, getHoleFitDispConf import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.Id +import GHC.Types.Id.Info (IdDetails(..), RecSelParent (..)) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env @@ -50,13 +54,18 @@ import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Error +import GHC.Types.Hint (SimilarName (..)) import qualified GHC.Types.Unique.Map as UM +import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Unit.Module import qualified GHC.LanguageExtensions as LangExt +import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate import GHC.Core.Type +import GHC.Core.Class (className) +import GHC.Core.ConLike (isExistentialRecordField, ConLike (..)) import GHC.Core.Coercion import GHC.Core.TyCo.Ppr ( pprTyVars ) import GHC.Core.TyCo.Tidy @@ -75,13 +84,18 @@ import GHC.Data.List.SetOps ( equivClasses, nubOrdBy ) import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict + +import Language.Haskell.Syntax.Basic (FieldLabelString(..)) + import Control.Monad ( unless, when, foldM, forM_ ) +import Data.Bifunctor ( bimap ) import Data.Foldable ( toList ) import Data.Function ( on ) import Data.List ( partition, union, sort, sortBy ) import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) import qualified Data.List.NonEmpty as NE import Data.Ord ( comparing ) +import Data.Either (partitionEithers) {- ************************************************************************ @@ -1470,8 +1484,8 @@ coercion. mkIrredErr :: SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport mkIrredErr ctxt items = do { (ctxt, binds, item1) <- relevantBindings True ctxt item1 - ; let msg = important ctxt $ mkPlainMismatchMsg $ - CouldNotDeduce (getUserGivens ctxt) (item1 :| others) Nothing + ; couldNotDeduceErr <- mkCouldNotDeduceErr (getUserGivens ctxt) (item1 :| others) Nothing + ; let msg = important ctxt $ mkPlainMismatchMsg couldNotDeduceErr ; return $ add_relevant_bindings binds msg } where item1:|others = tryFilter (not . ei_suppress) items @@ -1851,6 +1865,7 @@ reportEqErr :: SolverReportErrCtxt -> TcM TcSolverReportMsg reportEqErr ctxt item ty1 ty2 = do + mismatch <- misMatchOrCND ctxt item ty1 ty2 mb_coercible_info <- if errorItemEqRel item == ReprEq then coercible_msg ty1 ty2 else return Nothing @@ -1862,7 +1877,6 @@ reportEqErr ctxt item ty1 ty2 , mismatchAmbiguityInfo = eqInfos , mismatchCoercibleInfo = mb_coercible_info } where - mismatch = misMatchOrCND ctxt item ty1 ty2 eqInfos = eqInfoMsgs ty1 ty2 coercible_msg :: TcType -> TcType -> TcM (Maybe CoercibleMsg) @@ -1894,6 +1908,7 @@ mkTyVarEqErr' ctxt item tv1 ty2 -- try it before anything more complicated. | check_eq_result `cterHasProblem` cteImpredicative = do + headline_msg <- misMatchOrCND ctxt item ty1 ty2 tyvar_eq_info <- extraTyVarEqInfo (tv1, Nothing) ty2 let poly_msg = CannotUnifyWithPolytype item tv1 ty2 mb_tv_info @@ -1917,6 +1932,7 @@ mkTyVarEqErr' ctxt item tv1 ty2 || errorItemEqRel item == ReprEq -- The cases below don't really apply to ReprEq (except occurs check) = do + headline_msg <- misMatchOrCND ctxt item ty1 ty2 tv_extra <- extraTyVarEqInfo (tv1, Nothing) ty2 reason <- if errorItemEqRel item == ReprEq then RepresentationalEq tv_extra <$> coercible_msg ty1 ty2 @@ -1933,23 +1949,24 @@ mkTyVarEqErr' ctxt item tv1 ty2 -- -- Use tyCoVarsOfType because it might have begun as the canonical -- constraint (Dual (Dual a)) ~ a, and been swizzled by mkEqnErr_help - = let ambiguity_infos = eqInfoMsgs ty1 ty2 + = do headline_msg <- misMatchOrCND ctxt item ty1 ty2 + let ambiguity_infos = eqInfoMsgs ty1 ty2 - interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $ - filter isTyVar $ - fvVarList $ - tyCoFVsOfType ty1 `unionFV` tyCoFVsOfType ty2 + interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $ + filter isTyVar $ + fvVarList $ + tyCoFVsOfType ty1 `unionFV` tyCoFVsOfType ty2 - occurs_err = - OccursCheck - { occursCheckInterestingTyVars = interesting_tyvars - , occursCheckAmbiguityInfos = ambiguity_infos } - main_msg = - CannotUnifyVariable - { mismatchMsg = headline_msg - , cannotUnifyReason = occurs_err } + occurs_err = + OccursCheck + { occursCheckInterestingTyVars = interesting_tyvars + , occursCheckAmbiguityInfos = ambiguity_infos } + main_msg = + CannotUnifyVariable + { mismatchMsg = headline_msg + , cannotUnifyReason = occurs_err } - in return main_msg + return main_msg -- If the immediately-enclosing implication has 'tv' a skolem, and -- we know by now its an InferSkol kind of skolem, then presumably @@ -2005,7 +2022,6 @@ mkTyVarEqErr' ctxt item tv1 ty2 -- Consider an ambiguous top-level constraint (a ~ F a) -- Not an occurs check, because F is a type function. where - headline_msg = misMatchOrCND ctxt item ty1 ty2 mismatch_msg = mkMismatchMsg item ty1 ty2 -- The following doesn't use the cterHasProblem mechanism because @@ -2073,7 +2089,7 @@ eqInfoMsgs ty1 ty2 = Nothing misMatchOrCND :: SolverReportErrCtxt -> ErrorItem - -> TcType -> TcType -> MismatchMsg + -> TcType -> TcType -> TcM MismatchMsg -- If oriented then ty1 is actual, ty2 is expected misMatchOrCND ctxt item ty1 ty2 | insoluble_item -- See Note [Insoluble mis-match] @@ -2082,10 +2098,10 @@ misMatchOrCND ctxt item ty1 ty2 || null givens = -- If the equality is unconditionally insoluble -- or there is no context, don't report the context - mkMismatchMsg item ty1 ty2 + return $ mkMismatchMsg item ty1 ty2 | otherwise - = CouldNotDeduce givens (item :| []) (Just $ CND_Extra level ty1 ty2) + = mkCouldNotDeduceErr givens (item :| []) (Just $ CND_ExpectedActual level ty1 ty2) where insoluble_item = case ei_m_reason item of @@ -2275,9 +2291,8 @@ mkQCErr :: HasDebugCallStack => SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM mkQCErr ctxt items | item1 :| _ <- tryFilter (not . ei_suppress) items -- Ignore multiple qc-errors on the same line - = do { let msg = mkPlainMismatchMsg $ - CouldNotDeduce (getUserGivens ctxt) (item1 :| []) Nothing - ; return $ important ctxt msg } + = do { couldNotDeduceErr <- mkCouldNotDeduceErr (getUserGivens ctxt) (item1 :| []) Nothing + ; return $ important ctxt $ mkPlainMismatchMsg couldNotDeduceErr } mkDictErr :: HasDebugCallStack => SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport @@ -2292,16 +2307,9 @@ mkDictErr ctxt orig_items -- But we report only one of them (hence 'head') because they all -- have the same source-location origin, to try avoid a cascade -- of error from one location - ; ( err, (imp_errs, hints) ) <- - mk_dict_err ctxt (head (no_inst_items ++ overlap_items)) - ; return $ - SolverReport - { sr_important_msg = SolverReportWithCtxt ctxt err - , sr_supplementary = [ SupplementaryImportErrors imps - | imps <- maybeToList (NE.nonEmpty imp_errs) ] - , sr_hints = hints - } - } + ; err <- mk_dict_err ctxt (head (no_inst_items ++ overlap_items)) + ; return $ important ctxt err + } where items = tryFilter (not . ei_suppress) orig_items @@ -2335,28 +2343,29 @@ mkDictErr ctxt orig_items -- matching and unifying instances, and say "The choice depends on the instantion of ..., -- and the result of evaluating ...". mk_dict_err :: HasCallStack => SolverReportErrCtxt -> (ErrorItem, ClsInstLookupResult) - -> TcM ( TcSolverReportMsg, ([ImportError], [GhcHint]) ) + -> TcM TcSolverReportMsg mk_dict_err ctxt (item, (matches, pot_unifiers, unsafe_overlapped)) = case (NE.nonEmpty matches, NE.nonEmpty unsafe_overlapped) of (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions item - ; return (CannotResolveInstance item unifiers candidate_insts rel_binds, (imp_errs, field_suggestions)) } + ; mb_noBuiltinInst_msg <- getNoBuiltinInstMsg item + ; return $ + CannotResolveInstance item unifiers candidate_insts rel_binds mb_noBuiltinInst_msg + } -- Some matches => overlap errors (Just matchesNE, Nothing) -> return $ - ( OverlappingInstances item (NE.map fst matchesNE) unifiers, ([], [])) + OverlappingInstances item (NE.map fst matchesNE) unifiers (Just (match :| []), Just unsafe_overlappedNE) -> return $ - ( UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE), ([], [])) + UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE) (Just matches@(_ :| _), Just overlaps) -> pprPanic "mk_dict_err: multiple matches with overlap" $ vcat [ text "matches:" <+> ppr matches , text "overlaps:" <+> ppr overlaps ] where - orig = errorItemOrigin item pred = errorItemPred item (clas, tys) = getClassPredTys pred unifiers = getCoherentUnifiers pot_unifiers @@ -2381,43 +2390,6 @@ mk_dict_err ctxt (item, (matches, pot_unifiers, unsafe_overlapped)) in different_names && same_occ_names | otherwise = False - -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) - record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> - do { glb_env <- getGlobalRdrEnv - ; lcl_env <- getLocalRdrEnv - ; let field_name_hints = report_no_fieldnames item - ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) - ; pure (errs, hints ++ field_name_hints) - } - - -- get type names from instance - -- resolve the type - if it's in scope is it a record? - -- if it's a record, report an error - the record name + the field that could not be found - report_no_fieldnames :: ErrorItem -> [GhcHint] - report_no_fieldnames item - | Just (EvVarDest evvar) <- ei_evdest item - -- we can assume that here we have a `HasField @Symbol x r a` instance - -- because of GetFieldOrigin in record_field - , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) - , Just (r_tycon, _) <- tcSplitTyConApp_maybe r - , Just x_name <- isStrLitTy x - -- we check that this is a record type by checking whether it has any - -- fields (in scope) - , not . null $ tyConFieldLabels r_tycon - = [RemindRecordMissingField x_name r a] - | otherwise = [] - - occ_name_in_scope glb_env lcl_env occ_name = not $ - null (lookupGRE glb_env (LookupOccName occ_name (RelevantGREsFOS WantNormal))) && - isNothing (lookupLocalRdrOcc lcl_env occ_name) - - record_field = case orig of - GetFieldOrigin name -> Just (mkVarOccFS name) - _ -> Nothing - {- Note [Report candidate instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we have an unsolved (Num Int), where `Int` is not the Prelude Int, @@ -2475,6 +2447,245 @@ results in in the import of ‘Data.Monoid’ -} +mkCouldNotDeduceErr + :: [UserGiven] + -> NonEmpty ErrorItem + -> Maybe CND_ExpectedActual + -> TcM MismatchMsg +mkCouldNotDeduceErr user_givens items@(item :| _) mb_ea + = do { mb_noBuiltinInst_info <- getNoBuiltinInstMsg item + ; return $ CouldNotDeduce user_givens items mb_ea mb_noBuiltinInst_info } + +getNoBuiltinInstMsg :: ErrorItem -> TcM (Maybe NoBuiltinInstanceMsg) +getNoBuiltinInstMsg item = + do { rdr_env <- getGlobalRdrEnv + ; fam_envs <- tcGetFamInstEnvs + ; mbNoHasFieldMsg <- hasFieldInfo_maybe rdr_env fam_envs item + ; return $ fmap NoBuiltinHasFieldMsg mbNoHasFieldMsg + } + +{- Note [Error messages for unsolved HasField constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The HasField type-class has special instance solving logic, implemented in +'GHC.Tc.Instance.Class.{matchHasField,lookupHasFieldLabel}'. This logic is a +bit complex, so it's useful to explain to the user why GHC might have failed to +solve a 'HasField' constraint. GHC will emit the following error messages for +an unsolved constraint of the form 'HasField fld_name rec_ty fld_ty'. +These come in two flavours + + HF1. + Actionable hints: suggest similarly named fields (in case of mis-spelling) + or provide import suggestions (e.g. out of scope field). + See 'GHC.Tc.Errors.Ppr.hasFieldMsgHints' which takes the returned + 'HasFieldMsg' and produces the hints we display to the user. + + This depends on whether 'rec_ty' is a known fixed TyCon or not. + + HF1a. If 'rec_ty' is a known record TyCon: + - If 'fld_name' is a record field of that TyCon, but it's not in scope, + then suggest importing it. + - Otherwise, we suggest similarly named fields, prioritising similar + name suggestions for record fields from that same TyCon. + + HF1b. If 'rec_ty' is not a fixed TyCon (e.g. it's a metavariable): + - If 'fld_name' is an in-scope record field, don't suggest anything. + - Otherwise, suggest similar names. + + HF2. Observations. GHC points out a fact to the user which might help them + understand the problem: + + HF2a. 'fld_name' is not a string literal. + This is useful when the user has forgotten the quotes, e.g. they + have written 'getField @myFieldName' instead of 'getField @"myFieldName"'. + + HF2b. 'rec_ty' is a TyCon without any fields, e.g. 'Int' or 'Bool'. + + HF2c. The record field type 'fld_ty' contains existentials variables + or foralls. In the former case GHC doesn't generate a field selector + at all (it's a naughty record selector), while in the latter GHC + doesn't solve the constraint, because class instance arguments + can't contain foralls. + + HF2d. The record field is a pattern synonym record field. + GHC does not generate 'HasField' instances for pattern synonym fields. + + HF2e. The user is using -XRebindableSyntax, and this is not actually the + built-in HasField which GHC has special solving logic for. + + This can happen rather easily, because the current usage of + -XOverloadedRecordUpdate requires enabling -XRebindableSyntax and + defining a custom 'setField' function. +-} + +-- | Try to produce an explanatory message for why GHC was not able to use +-- a built-in instance to solve a 'HasField' constraint. +-- +-- See Note [Error messages for unsolved HasField constraints] +hasFieldInfo_maybe :: GlobalRdrEnv -> FamInstEnvs -> ErrorItem -> TcM (Maybe HasFieldMsg) +hasFieldInfo_maybe rdr_env fam_inst_envs item + | Just (x_ty, rec_ty, _wanted_field_ty) <- hasField_maybe (errorItemPred item) + + -- This function largely replicates the logic + -- of 'GHC.Tc.Instance.Class.{matchHasField,lookupHasFieldLabel}'. + -- + -- When that function fails to return a built-in HasField instance, + -- this function should generate an appropriate message which can be + -- displayed to the user as a hint. + + = case isStrLitTy x_ty of + { Nothing -> + -- (HF2a) Field label is not a literal string. + return $ Just $ NotALiteralFieldName x_ty + ; Just x -> + do { dflags <- getDynFlags + ; let x_fl = FieldLabelString x + looking_for_field = LF WL_RecField WL_Global + fld_var_occ = mkVarOccFS x + lkup_fld_occ = LookupOccName fld_var_occ (RelevantGREsFOS WantField) + similar_names = + similarNameSuggestions looking_for_field + dflags rdr_env emptyLocalRdrEnv (mkRdrUnqual fld_var_occ) + ; (patsyns, suggs) <- partitionEithers <$> mapMaybeM with_parent similar_names + ; imp_suggs <- anyQualImportSuggestions looking_for_field lkup_fld_occ + ; case splitTyConApp_maybe rec_ty of + { Nothing -> do + -- (HF1b) Similar name and import suggestions with unknown TyCon. + -- + -- Don't say 'rec is not a record type' if 'rec' is e.g. a type variable. + -- That's not really helpful, especially if 'rec' is a metavariable, + -- in which case this is most likely an ambiguity issue. + let gres = lookupGRE rdr_env lkup_fld_occ + case gres of + _:_ -> + -- If the name was in scope, don't give "similar name" suggestions. + return Nothing + [] -> do + return $ Just $ + SuggestSimilarFields Nothing x_fl suggs patsyns imp_suggs + ; Just (rec_tc, rec_args) + | let rec_rep_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs rec_tc rec_args) + -> + if null $ tyConFieldLabels rec_rep_tc + then + -- (HF2b) Not a record TyCon + return $ Just $ NotARecordType rec_ty + else + case lookupTyConFieldLabel x_fl rec_rep_tc of + { Nothing -> do + -- (HF1a) Similar name and import suggestions with known TyCon. + return $ Just $ + SuggestSimilarFields (Just (rec_tc, rec_rep_tc)) x_fl suggs patsyns imp_suggs + ; Just fl -> + -- The TyCon does have the field, so the issue might be that + -- it's not in scope or that the field is existential or higher-rank. + case lookupGRE_FieldLabel rdr_env fl of + { Nothing -> do + -- (HF1a) Not in scope. Try to suggest importing the field. + let lookup_gre = + LookupExactName + { lookupExactName = flSelector fl + , lookInAllNameSpaces = False } + imp_suggs <- anyQualImportSuggestions looking_for_field lookup_gre + return $ Just $ OutOfScopeField rec_tc fl imp_suggs + ; Just gre -> + let con1_nm = + case nonDetEltsUniqSet $ recFieldCons $ fieldGREInfo gre of + n : _ -> n + [] -> pprPanic "record field with no constructors" (ppr fl) + in case con1_nm of + { PatSynName {} -> + -- 'lookupTyConFieldLabel' always returns a DataCon field + pprPanic "hasFieldInfo_maybe: PatSyn" $ + vcat [ text "tc:" <+> ppr rec_tc + , text "rep_tc:" <+> ppr rec_rep_tc + , text "con1_nm:" <+> ppr con1_nm + ] + ; DataConName dc1_nm -> do + dc1 <- tcLookupDataCon dc1_nm + let orig_field_ty = dataConFieldType dc1 (flLabel fl) + return $ + -- (HF2c) Existential or higher-rank field. + -- See 'GHC.Tc.Instance.Class.matchHasField', which + -- has these same two conditions. + if | isExistentialRecordField orig_field_ty (RealDataCon dc1) + -- NB: use 'orig_field_ty' and not 'idType sel_id', + -- because the latter is 'unitTy' when there are existentials. + -> Just $ FieldTooFancy rec_tc x_fl FieldHasExistential + | not $ isTauTy orig_field_ty + -> Just $ FieldTooFancy rec_tc x_fl FieldHasForAlls + | otherwise + -> Nothing + -- Not sure what went wrong. Usually not a type error + -- in the field type, because the functional dependency + -- would cause a genuine equality error. + }}}}}} + + -- (HF2e) It's a custom HasField constraint, not the one from GHC.Records. + | Just (tc, _) <- splitTyConApp_maybe (errorItemPred item) + , getOccString tc == "HasField" + , isHasFieldOrigin (errorItemOrigin item) + = return $ Just $ CustomHasField tc + + | otherwise + = return Nothing + + where + + get_parent_nm :: Name -> TcM (Maybe (Either PatSyn TyCon)) + get_parent_nm nm = + do { fld_id <- tcLookupId nm + ; return $ + case idDetails fld_id of + RecSelId { sel_tycon = parent } -> + case parent of + RecSelData tc -> + Just $ Right tc + RecSelPatSyn ps -> + -- (HF2d) PatSyn record fields don't contribute 'HasField' + -- instances, so tell the user about that. + Just $ Left ps + _ -> Nothing + } + + get_parent :: SimilarName -> TcM (Maybe (Either PatSyn TyCon)) + get_parent (SimilarName nm) = get_parent_nm nm + get_parent (SimilarRdrName _ mb_gre _) = + case mb_gre of + Nothing -> return Nothing + Just gre -> get_parent_nm $ greName gre + + with_parent :: SimilarName + -> TcM (Maybe (Either (PatSyn, SimilarName) (TyCon, SimilarName))) + with_parent n = fmap (bimap (,n) (,n)) <$> get_parent n + +-- | Is this constraint definitely 'HasField'? +hasField_maybe :: PredType -> Maybe (Type, Type, Type) +hasField_maybe pred = + case classifyPredType pred of + ClassPred cls tys + | className cls == hasFieldClassName + , [ _k, _rec_rep, _fld_rep, x_ty, rec_ty, fld_ty ] <- tys + -> Just (x_ty, rec_ty, fld_ty) + _ -> Nothing + -- NB: we deliberately don't handle rebound 'HasField' (with -XRebindableSyntax), + -- as GHC only has built-in instances for the built-in 'HasField' class. + +-- | Does this constraint arise from GHC internal mechanisms that desugar to +-- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)? +-- +-- Just used heuristically to decide whether to print an informative message to +-- the user (see (H2e) in Note [Error messages for unsolved HasField constraints]). +isHasFieldOrigin :: CtOrigin -> Bool +isHasFieldOrigin = \case + OccurrenceOf n -> + -- A heuristic... + getOccString n `elem` ["getField", "setField"] + OccurrenceOfRecSel {} -> True + RecordUpdOrigin {} -> True + RecordFieldProjectionOrigin {} -> True + GetFieldOrigin {} -> True + _ -> False + ----------------------- -- relevantBindings looks at the value environment and finds values whose -- types mention any of the offending type variables. It has to be ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -63,7 +63,7 @@ import GHC.Core.InstEnv import GHC.Core.TyCo.Rep (Type(..)) import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon, pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll) -import GHC.Core.PatSyn ( patSynName, pprPatSynType ) +import GHC.Core.PatSyn ( patSynName, pprPatSynType, PatSyn ) import GHC.Core.TyCo.Tidy import GHC.Core.Predicate import GHC.Core.Type @@ -90,7 +90,7 @@ import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenanc import GHC.Types.Error import GHC.Types.Error.Codes import GHC.Types.Hint -import GHC.Types.Hint.Ppr ( pprSigLike ) -- & Outputable GhcHint +import GHC.Types.Hint.Ppr ( pprSigLike ) import GHC.Types.Basic import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) @@ -129,6 +129,9 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.BooleanFormula (pprBooleanFormulaNice) +import Language.Haskell.Syntax.Basic (field_label, FieldLabelString (..)) + +import Control.Monad (guard) import qualified Data.Semigroup as S import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE @@ -4114,7 +4117,13 @@ pprTcSolverReportMsg ctxt (UnboundImplicitParams (item :| items)) = sep [ text "Unbound implicit parameter" <> plural preds , nest 2 (pprParendTheta preds) ] else - let mismatch = CouldNotDeduce givens (item :| items) Nothing + let mismatch = + CouldNotDeduce + { cnd_user_givens = givens + , cnd_wanted = item :| items + , cnd_ea = Nothing + , cnd_noBuiltin_msg = Nothing + } invis_bits = mismatchInvisibleBits mismatch ppr_msg = pprMismatchMsg ctxt mismatch in @@ -4127,7 +4136,7 @@ pprTcSolverReportMsg _ (AmbiguityPreventsSolvingCt item ambigs) = text "prevents the constraint" <+> quotes (pprParendType $ errorItemPred item) <+> text "from being solved." pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) - (CannotResolveInstance item unifiers candidates rel_binds) + (CannotResolveInstance item unifiers candidates rel_binds mb_HasField_msg) = pprWithInvisibleBits invis_bits $ vcat [ no_inst_msg @@ -4171,10 +4180,10 @@ pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) | lead_with_ambig = (Set.empty, pprTcSolverReportMsg ctxt $ AmbiguityPreventsSolvingCt item (ambig_kvs, ambig_tvs)) | otherwise - = let mismatch = CouldNotDeduce useful_givens (item :| []) Nothing + = let mismatch = CouldNotDeduce useful_givens (item :| []) Nothing mb_HasField_msg in ( mismatchInvisibleBits mismatch - , pprMismatchMsg ctxt $ CouldNotDeduce useful_givens (item :| []) Nothing + , pprMismatchMsg ctxt mismatch ) -- Report "potential instances" only when the constraint arises @@ -4202,6 +4211,9 @@ pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) | otherwise = Nothing extra_note + | Just {} <- mb_HasField_msg + = empty + -- Flag up partially applied uses of (->) | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys) = text "(maybe you haven't applied a function to enough arguments?)" @@ -4417,10 +4429,10 @@ mismatchInvisibleBits , teq_mismatch_ty1 = ty1 , teq_mismatch_ty2 = ty2 }) = shouldPprWithInvisibleBits ty1 ty2 (errorItemOrigin item) -mismatchInvisibleBits (CouldNotDeduce { cnd_extra = mb_extra }) - = case mb_extra of +mismatchInvisibleBits (CouldNotDeduce { cnd_ea = mb_ea }) + = case mb_ea of Nothing -> Set.empty - Just (CND_Extra _ ty1 ty2) -> + Just (CND_ExpectedActual _ ty1 ty2) -> mayLookIdentical ty1 ty2 -- | Turn a 'MismatchMsg' into an 'SDoc'. @@ -4612,9 +4624,14 @@ pprMismatchMsg ctxt starts_with_vowel (c:_) = c `elem` ("AEIOU" :: String) starts_with_vowel [] = False - -pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) +pprMismatchMsg ctxt + (CouldNotDeduce { cnd_user_givens = useful_givens + , cnd_wanted = item :| others + , cnd_ea = mb_ea + , cnd_noBuiltin_msg = mb_NoBuiltin_msg + }) = vcat [ main_msg + , maybe empty pprNoBuiltinInstanceMsg mb_NoBuiltin_msg , pprQCOriginExtra item , ea_supplementary ] where @@ -4623,9 +4640,10 @@ pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) | otherwise = vcat ( addArising ct_loc no_deduce_msg : pp_from_givens useful_givens) - ea_supplementary = case mb_extra of - Nothing -> empty - Just (CND_Extra level ty1 ty2) -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig + ea_supplementary = case mb_ea of + Nothing -> empty + Just (CND_ExpectedActual level ty1 ty2) -> + mk_supplementary_ea_msg ctxt level ty1 ty2 orig ct_loc = errorItemCtLoc item orig = ctLocOrigin ct_loc @@ -5022,6 +5040,87 @@ pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) = 2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc) , text "is not in scope" ]) +pprNoBuiltinInstanceMsg :: NoBuiltinInstanceMsg -> SDoc +pprNoBuiltinInstanceMsg = \case + NoBuiltinHasFieldMsg msg -> pprHasFieldMsg msg + +pprHasFieldMsg :: HasFieldMsg -> SDoc +pprHasFieldMsg = \case + NotALiteralFieldName ty -> + text "NB:" <+> quotes (ppr ty) <+> what + where + what + | Just {} <- getCastedTyVar_maybe ty + = text "is a type variable, not a string literal." + | otherwise + = text "is not a string literal." + NotARecordType ty -> + text "NB:" <+> quotes (ppr ty) <+> text "is not a record type." + OutOfScopeField tc fld _import_suggs -> + text "NB: the record field" <+> quotes (ppr fld) <+> text "of" <+> quotes (ppr tc) <+> text "is out of scope." + FieldTooFancy tc fld rea -> + case rea of + FieldHasExistential -> + text "NB: the record field" <+> quotes (ppr fld) <+> text "of" <+> quotes (ppr tc) <+> text "contains existential variables." + FieldHasForAlls -> + text "NB: the field type of the record field" <+> quotes (ppr fld) <+> text "of" <+> quotes (ppr tc) <+> text "is not a mono-type." + CustomHasField custom_hasField -> + text "NB:" <+> quotes (ppr custom_hasField) <+> text "is not the built-in" + <+> quotes (ppr hasFieldClassName) <+> text "class." + SuggestSimilarFields (Just (tc, rep_tc)) fld suggs pat_syns _imp_suggs -> + vcat + [ text "NB:" <+> quotes (ppr tc) + <+> text "does not have a record field named" + <+> quotes (ppr fld) <> dot + , pprHasFieldPatSynMsg fld pat_syns + , pprSameNameOtherTyCons (mapMaybe same_name_diff_tc suggs) + -- NB: The actual suggestions are dealt with by + -- GHC.Tc.Errors.hasFieldMsgHints. The logic here just covers + -- information for which there is no actionable hint. + ] + where + same_name_diff_tc (rep_tc', fld') = do + let occ = case fld' of + SimilarName n -> getOccFS n + SimilarRdrName n _ _ -> occNameFS $ rdrNameOcc n + guard $ + rep_tc' /= rep_tc + && + (fld == FieldLabelString occ) + return rep_tc' + SuggestSimilarFields Nothing fld _suggs pat_syns _imp_suggs -> + pprHasFieldPatSynMsg fld pat_syns + -- Most of the error message only makes sense when we know the TyCon. + -- In this "unknown TyCon" case, we only have: + -- - the "PatSyns don't give HasField instances" message + -- - the hints, which are handled separately (see 'hasFieldMsgHints'). + +pprSameNameOtherTyCons :: [TyCon] -> SDoc +pprSameNameOtherTyCons [] = empty +pprSameNameOtherTyCons tcs = + other_types_have <+> text "a field of this name:" + <+> pprWithCommas (quotes . ppr) tcs <> dot + where + other_types_have :: SDoc + other_types_have = case tcs of + _:_:_ -> "Other types have" + _ -> "Another type has" + +pprHasFieldPatSynMsg :: FieldLabelString -> [(PatSyn, SimilarName)] -> SDoc +pprHasFieldPatSynMsg fld pat_syns = + if any same_name pat_syns + then + text "Pattern synonym record fields do not contribute" + <+> quotes (ppr hasFieldClassName) <+> text "instances." + else empty + where + same_name (_,nm) = + let occ = case nm of + SimilarName n -> getOccFS n + SimilarRdrName n _ _ -> occNameFS $ rdrNameOcc n + in + occ == field_label fld + pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions -> @@ -5247,8 +5346,8 @@ tcSolverReportMsgHints ctxt = \case -> noHints AmbiguityPreventsSolvingCt {} -> noHints - CannotResolveInstance {} - -> noHints + CannotResolveInstance { cannotResolve_noBuiltinMsg = mb_noBuiltin } + -> maybe noHints noBuiltinInstanceHints mb_noBuiltin OverlappingInstances {} -> noHints UnsafeOverlap {} @@ -5256,22 +5355,66 @@ tcSolverReportMsgHints ctxt = \case MultiplicityCoercionsNotSupported {} -> noHints +noBuiltinInstanceHints :: NoBuiltinInstanceMsg -> [GhcHint] +noBuiltinInstanceHints = \case + NoBuiltinHasFieldMsg noHasFieldMsg -> hasFieldMsgHints noHasFieldMsg + +hasFieldMsgHints :: HasFieldMsg -> [GhcHint] +hasFieldMsgHints = \case + NotALiteralFieldName {} -> noHints + NotARecordType {} -> noHints + FieldTooFancy {} -> noHints + SuggestSimilarFields mb_orig_tc orig_fld suggs _patsyns imp_suggs -> + map (ImportSuggestion fld_occ) imp_suggs ++ similar_suggs + where + fld_occ = mkVarOccFS $ field_label orig_fld + similar_suggs = + case NE.nonEmpty $ filter different_name suggs of + Nothing -> noHints + Just neSuggs -> + case mb_orig_tc of + Just (orig_tc, orig_rep_tc) -> + -- We know the parent TyCon + [SuggestSimilarSelectors orig_tc orig_rep_tc orig_fld neSuggs] + Nothing -> + -- We don't know the parent TyCon + [ SuggestSimilarNames + (mkRdrUnqual fld_occ) + (fmap snd neSuggs) + ] + different_name ( _, nm ) = + let occ = case nm of + SimilarName n -> getOccFS n + SimilarRdrName n _ _ -> occNameFS $ rdrNameOcc n + in + orig_fld /= FieldLabelString occ + OutOfScopeField _tc fld import_suggs -> + map (ImportSuggestion (nameOccName $ flSelector fld)) import_suggs + CustomHasField {} -> noHints + mismatchMsgHints :: SolverReportErrCtxt -> MismatchMsg -> [GhcHint] mismatchMsgHints ctxt msg = + mismatchMsgHasFieldHints msg ++ maybeToList [ hint | (exp,act) <- mismatchMsg_ExpectedActuals msg , hint <- suggestAddSig ctxt exp act ] +mismatchMsgHasFieldHints :: MismatchMsg -> [GhcHint] +mismatchMsgHasFieldHints + (CouldNotDeduce { cnd_noBuiltin_msg = mb_noBuiltin }) = + maybe noHints noBuiltinInstanceHints mb_noBuiltin +mismatchMsgHasFieldHints (BasicMismatch{}) = [] +mismatchMsgHasFieldHints (TypeEqMismatch{}) = [] + mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type) mismatchMsg_ExpectedActuals = \case BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } -> Just (exp, act) TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } -> Just (exp,act) - CouldNotDeduce { cnd_extra = cnd_extra } - | Just (CND_Extra _ exp act) <- cnd_extra - -> Just (exp, act) - | otherwise - -> Nothing + CouldNotDeduce { cnd_ea = mb_ea } -> + case mb_ea of + Just (CND_ExpectedActual _ exp act) -> Just (exp, act) + Nothing -> Nothing cannotUnifyVariableHints :: CannotUnifyVariableReason -> [GhcHint] cannotUnifyVariableHints = \case ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -72,7 +72,7 @@ module GHC.Tc.Errors.Types ( , ExpectedActualInfo(..) , TyVarInfo(..), SameOccInfo(..) , AmbiguityInfo(..) - , CND_Extra(..) + , CND_ExpectedActual(..) , FitsMbSuppressed(..) , ValidHoleFits(..), noValidHoleFits , HoleFitDispConfig(..) @@ -86,6 +86,9 @@ module GHC.Tc.Errors.Types ( , lookingForSubordinate , HoleError(..) , CoercibleMsg(..) + , NoBuiltinInstanceMsg(..) + , HasFieldMsg(..) + , TooFancyField(..) , PotentialInstances(..) , UnsupportedCallConvention(..) , ExpectedBackends @@ -200,7 +203,7 @@ import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType, import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Avail -import GHC.Types.Hint (UntickedPromotedThing(..), AssumedDerivingStrategy(..), SigLike) +import GHC.Types.Hint import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name (NamedThing(..), Name, OccName, getSrcLoc, getSrcSpan) @@ -5615,6 +5618,7 @@ data TcSolverReportMsg , cannotResolve_unifiers :: [ClsInst] , cannotResolve_candidates :: [ClsInst] , cannotResolve_relBinds :: RelevantBindings + , cannotResolve_noBuiltinMsg :: Maybe NoBuiltinInstanceMsg } -- | Could not solve a constraint using available instances @@ -5675,15 +5679,20 @@ data MismatchMsg -- Used for messages such as @"No instance for ..."@ and -- @"Could not deduce ... from"@. | CouldNotDeduce - { cnd_user_givens :: [Implication] + { cnd_user_givens :: [Implication] -- | The Wanted constraints we couldn't solve. -- -- N.B.: the 'ErrorItem' at the head of the list has been tidied, -- perhaps not the others. - , cnd_wanted :: NE.NonEmpty ErrorItem + , cnd_wanted :: NE.NonEmpty ErrorItem - -- | Some additional info consumed by 'mk_supplementary_ea_msg'. - , cnd_extra :: Maybe CND_Extra + -- | Additional "expected/actual" information + -- consumed by 'mk_supplementary_ea_msg'. + , cnd_ea :: Maybe CND_ExpectedActual + + -- | Additional message relating to unsolved constraints for + -- typeclasses which have built-in instances. + , cnd_noBuiltin_msg :: Maybe NoBuiltinInstanceMsg } deriving Generic @@ -5753,7 +5762,7 @@ mkPlainMismatchMsg msg -- | Additional information to be given in a 'CouldNotDeduce' message, -- which is then passed on to 'mk_supplementary_ea_msg'. -data CND_Extra = CND_Extra TypeOrKind Type Type +data CND_ExpectedActual = CND_ExpectedActual TypeOrKind Type Type -- | A cue to print out information about type variables, -- e.g. where they were bound, when there is a mismatch @tv1 ~ ty2@. @@ -5967,6 +5976,48 @@ data CoercibleMsg -- Test cases: TcCoercibleFail. | OutOfScopeNewtypeConstructor TyCon DataCon +-- | Explains why GHC wasn't able to provide a built-in instance for +-- a particular class. +data NoBuiltinInstanceMsg + = NoBuiltinHasFieldMsg HasFieldMsg + + -- Other useful constructors might be: + -- NoBuiltinTypeableMsg -- explains polykinded Typeable restrictions + -- NoBuiltinDataToTagMsg -- see conditions in Note [DataToTag overview] + -- NoBuiltinWithDictMsg -- see Note [withDict] + +-- | Explains why GHC wasn't able to provide a built-in 'HasField' instance +-- for the given types. +data HasFieldMsg + -- | The field is not a literal field name, e.g. @HasField x u v@ where @x@ + -- is a type variable. + = NotALiteralFieldName Type + -- | The type we are selecting from is not a record type, + -- e.g. @HasField "fld" Int fld@. + | NotARecordType Type + -- | The field is out of scope. + | OutOfScopeField TyCon FieldLabel [ImportSuggestion] + -- | The field has a type which means that GHC cannot solve + -- a 'HasField' constraint for it. + | FieldTooFancy TyCon FieldLabelString TooFancyField + -- | No such field, but the field is perhaps mis-spelled; + -- here are some suggestions. + | SuggestSimilarFields + (Maybe (TyCon, TyCon)) -- ^ (optional) desired parent (tc and rep_tc) + FieldLabelString -- ^ field name + [(TyCon, SimilarName)] -- ^ suggestions (for this 'TyCon' or other 'TyCon's) + [(PatSyn, SimilarName)] -- ^ pattern synonyms with similarly named fields + [ImportSuggestion] -- ^ import suggestions + + -- | Using -XRebindableSyntax and a different 'HasField'. + | CustomHasField TyCon -- ^ the custom HasField TyCon + +-- | Why is a record field "too fancy" for GHC to be able to properly +-- solve a 'HasField' constraint? +data TooFancyField + = FieldHasExistential + | FieldHasForAlls + -- | Explain a problem with an import. data ImportError -- | Couldn't find a module with the requested name. ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -1247,6 +1247,11 @@ matchHasField dflags short_cut clas tys mb_ct_loc -- The selector must not be "naughty" (i.e. the field -- cannot have an existentially quantified type), -- and it must not be higher-rank. + -- + -- See also 'GHC.Tc.Errors.hasFieldInfo_maybe', which is + -- responsible for the error messages in cases of unsolved + -- HasField constraints when the field type runs afoul + -- of these conditions. ; if (isNaughtyRecordSelector sel_id) || not (isTauTy sel_ty) then try_user_instances else @@ -1306,6 +1311,11 @@ lookupHasFieldLabel -- A complication is that `T` might be a data family, so we need to -- look it up in the `fam_envs` to find its representation tycon. lookupHasFieldLabel fam_inst_envs rdr_env arg_tys + + -- NB: if you edit this function, you might also want to update + -- GHC.Tc.Errors.hasfieldInfo_maybe which is responsible for error messages + -- when GHC /does not/ solve a 'HasField' constraint. + | -- We are matching HasField {k} {r_rep} {a_rep} x r a... (_k : _rec_rep : _fld_rep : x_ty : rec_ty : fld_ty : _) <- arg_tys -- x should be a literal string ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -136,7 +136,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details ; let (arg_names, is_infix) = collectPatSynArgInfo details ; (tclvl, wanted, ((lpat', args), pat_ty)) <- pushLevelAndCaptureConstraints $ - tcInferPat FRRPatSynArg PatSyn lpat $ + tcInferPat FRRPatSynArg PatSynCtx lpat $ mapM tcLookupId arg_names ; let (ex_tvs, prov_dicts) = tcCollectEx lpat' @@ -421,7 +421,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details assertPpr (equalLength arg_names arg_tys) (ppr name $$ ppr arg_names $$ ppr arg_tys) $ pushLevelAndCaptureConstraints $ tcExtendNameTyVarEnv univ_tv_prs $ - tcCheckPat PatSyn lpat (unrestricted skol_pat_ty) $ + tcCheckPat PatSynCtx lpat (unrestricted skol_pat_ty) $ do { let in_scope = mkInScopeSetList skol_univ_tvs empty_subst = mkEmptySubst in_scope ; (inst_subst, ex_tvs') <- mapAccumLM newMetaTyVarX empty_subst skol_ex_tvs @@ -843,7 +843,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn gen = Generated OtherExpansion SkipPmc body = mkLHsWrap (mkWpLet req_ev_binds) $ L (getLoc lpat) $ - HsCase PatSyn (nlHsVar scrutinee) $ + HsCase PatSynCtx (nlHsVar scrutinee) $ MG{ mg_alts = L (l2l $ getLoc lpat) cases , mg_ext = MatchGroupTc [unrestricted pat_ty] res_ty gen } ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.TyCl.Utils( addTyConsToGblEnv, mkDefaultMethodType, -- * Record selectors - tcRecSelBinds, mkRecSelBinds, mkOneRecordSelector + tcRecSelBinds, mkRecSelBinds, mkOneRecordSelector, ) where import GHC.Prelude @@ -899,7 +899,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- Selector type; Note [Polymorphic selectors] - (univ_tvs, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 + (_, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 field_ty = conLikeFieldType con1 lbl field_ty_tvs = tyCoVarsOfType field_ty @@ -909,17 +909,13 @@ mkOneRecordSelector all_cons idDetails fl has_sel conLikeUserTyVarBinders con1 -- is_naughty: see Note [Naughty record selectors] - is_naughty = not ok_scoping || no_selectors - ok_scoping = case con1 of - RealDataCon {} -> field_ty_tvs `subVarSet` data_ty_tvs - PatSynCon {} -> field_ty_tvs `subVarSet` mkVarSet univ_tvs - -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but - -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in - -- GHC.Core.PatSyn, so no need to check them. - - no_selectors = has_sel == NoFieldSelectors -- No field selectors => all are naughty - -- thus suppressing making a binding - -- A slight hack! + is_naughty = isExistentialRecordField field_ty con1 || no_selectors + + no_selectors = has_sel == NoFieldSelectors + -- For PatternSynonyms with -XNoFieldSelectors, pretend the fields + -- are naughty record selectors to suppress making a binding. + -- + -- See Note [NoFieldSelectors and naughty record selectors] sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] | otherwise = mkForAllTys sel_tvbs $ ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -524,7 +524,7 @@ data CtOrigin ----------- Below here, all are Origins for Wanted constraints ------------ | OccurrenceOf Name -- ^ Occurrence of an overloaded identifier - | OccurrenceOfRecSel RdrName -- ^ Occurrence of a record selector + | OccurrenceOfRecSel (LocatedN RdrName) -- ^ Occurrence of a record selector | AppOrigin -- ^ An application of some kind | SpecPragOrigin UserTypeCtxt -- ^ Specialisation pragma for @@ -558,7 +558,10 @@ data CtOrigin -- IMPORTANT: These constraints will never cause errors; -- See Note [Constraints to ignore] in GHC.Tc.Errors | SectionOrigin - | GetFieldOrigin FastString + | GetFieldOrigin (LocatedN FastString) + + -- | A overloaded record field projection like @.fld@ or @.fld1.fld2.fld@. + | RecordFieldProjectionOrigin (FieldLabelStrings GhcRn) | TupleOrigin -- (..,..) | ExprSigOrigin -- e :: ty | PatSigOrigin -- p :: ty @@ -566,7 +569,7 @@ data CtOrigin | ProvCtxtOrigin -- The "provided" context of a pattern synonym signature (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in -- particular the name and the right-hand side - | RecordUpdOrigin + | RecordUpdOrigin (LHsRecUpdFields GhcRn) | ViewPatOrigin -- | 'ScOrigin' is used only for the Wanted constraints for the @@ -737,7 +740,7 @@ lexprCtOrigin (L _ e) = exprCtOrigin e exprCtOrigin :: HsExpr GhcRn -> CtOrigin exprCtOrigin (HsVar _ (L _ (WithUserRdr _ name))) = OccurrenceOf name -exprCtOrigin (HsGetField _ _ (L _ f)) = GetFieldOrigin (field_label $ unLoc $ dfoLabel f) +exprCtOrigin (HsGetField _ _ (L _ f)) = GetFieldOrigin (fmap field_label $ dfoLabel f) exprCtOrigin (HsOverLabel _ l) = OverLabelOrigin l exprCtOrigin (ExplicitList {}) = ListOrigin exprCtOrigin (HsIPVar _ ip) = IPOccOrigin ip @@ -749,9 +752,9 @@ exprCtOrigin (HsAppType _ e1 _) = lexprCtOrigin e1 exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op exprCtOrigin (NegApp _ e _) = lexprCtOrigin e exprCtOrigin (HsPar _ e) = lexprCtOrigin e -exprCtOrigin (HsProjection _ _) = SectionOrigin -exprCtOrigin (SectionL _ _ _) = SectionOrigin -exprCtOrigin (SectionR _ _ _) = SectionOrigin +exprCtOrigin (HsProjection _ p) = RecordFieldProjectionOrigin (FieldLabelStrings $ fmap noLocA p) +exprCtOrigin (SectionL {}) = SectionOrigin +exprCtOrigin (SectionR {}) = SectionOrigin exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple" exprCtOrigin ExplicitSum{} = Shouldn'tHappenOrigin "explicit sum" exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches @@ -760,7 +763,7 @@ exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e exprCtOrigin (HsDo {}) = DoOrigin exprCtOrigin (RecordCon {}) = Shouldn'tHappenOrigin "record construction" -exprCtOrigin (RecordUpd {}) = RecordUpdOrigin +exprCtOrigin (RecordUpd _ _ flds)= RecordUpdOrigin flds exprCtOrigin (ExprWithTySig {}) = ExprSigOrigin exprCtOrigin (ArithSeq {}) = Shouldn'tHappenOrigin "arithmetic sequence" exprCtOrigin (HsPragE _ _ e) = lexprCtOrigin e @@ -779,7 +782,7 @@ exprCtOrigin (XExpr (ExpandedThingRn thing _)) | OrigExpr a <- thing = exprCtOri | OrigStmt _ <- thing = DoOrigin | OrigPat p <- thing = DoPatOrigin p exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt" -exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel (foExt f) +exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f) -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin @@ -937,7 +940,7 @@ ppr_br AppOrigin = text "an application" ppr_br (IPOccOrigin name) = hsep [text "a use of implicit parameter", quotes (ppr name)] ppr_br (OverLabelOrigin l) = hsep [text "the overloaded label" ,quotes (char '#' <> ppr l)] -ppr_br RecordUpdOrigin = text "a record update" +ppr_br (RecordUpdOrigin {}) = text "a record update" ppr_br ExprSigOrigin = text "an expression type signature" ppr_br PatSigOrigin = text "a pattern type signature" ppr_br PatOrigin = text "a pattern" @@ -945,6 +948,7 @@ ppr_br ViewPatOrigin = text "a view pattern" ppr_br (LiteralOrigin lit) = hsep [text "the literal", quotes (ppr lit)] ppr_br (ArithSeqOrigin seq) = hsep [text "the arithmetic sequence", quotes (ppr seq)] ppr_br SectionOrigin = text "an operator section" +ppr_br (RecordFieldProjectionOrigin p) = text "the record selector" <+> quotes (ppr p) ppr_br (GetFieldOrigin f) = hsep [text "selecting the field", quotes (ppr f)] ppr_br AssocFamPatOrigin = text "the LHS of a family instance" ppr_br TupleOrigin = text "a tuple" ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -42,12 +42,14 @@ import GHC.Core.TyCon (TyCon) import GHC.Core.Type (Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) -import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) +import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec, GlobalRdrElt) import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit, FastString) +import GHC.Data.FastString (fsLit) + +import Language.Haskell.Syntax.Basic (FieldLabelString) import Data.Typeable ( Typeable ) import Data.Map.Strict (Map) @@ -394,6 +396,12 @@ data GhcHint -} | SuggestSimilarNames RdrName (NE.NonEmpty SimilarName) + {-| Suggest a similar record selector that the user might have meant. + + Test case: T26480b. + -} + | SuggestSimilarSelectors TyCon TyCon FieldLabelString (NE.NonEmpty (TyCon, SimilarName)) + {-| Remind the user that the field selector has been suppressed because of -XNoFieldSelectors. @@ -464,9 +472,6 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon - {-| Remind the user that there is no field of a type and name in the record, - constructors are in the usual order $x$, $r$, $a$ -} - | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName @@ -579,7 +584,7 @@ data HowInScope data SimilarName = SimilarName Name - | SimilarRdrName RdrName (Maybe HowInScope) + | SimilarRdrName RdrName (Maybe GlobalRdrElt) (Maybe HowInScope) -- | Some kind of signature, such as a fixity signature, standalone -- kind signature, COMPLETE pragma, role annotation, etc. ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon -import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) +import GHC.Hs.Binds (hsSigDoc) import GHC.Hs.Expr () -- instance Outputable import GHC.Types.Id import GHC.Types.Name @@ -25,14 +25,16 @@ import GHC.Unit.Module.Imported (ImportedModsVal(..)) import GHC.Unit.Types import GHC.Utils.Outputable +import qualified GHC.LanguageExtensions as LangExt + import GHC.Driver.Flags +import Language.Haskell.Syntax.Basic (FieldLabelString) + +import Data.List (partition) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map -import qualified GHC.LanguageExtensions as LangExt -import GHC.Hs.Binds (hsSigDoc) - instance Outputable GhcHint where ppr = \case UnknownHint m @@ -198,7 +200,9 @@ instance Outputable GhcHint where , nest 2 (pprWithCommas pp_item $ NE.toList similar_names) ] where tried_ns = occNameSpace $ rdrNameOcc tried_rdr_name - pp_item = pprSimilarName tried_ns + pp_item = pprSimilarName (Just tried_ns) + SuggestSimilarSelectors tc rep_tc fld suggs -> + pprSimilarFields tc rep_tc fld (NE.toList suggs) RemindFieldSelectorSuppressed rdr_name parents -> text "Notice that" <+> quotes (ppr rdr_name) <+> text "is a field selector" <+> whose @@ -255,12 +259,6 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) - RemindRecordMissingField x r a -> - text "NB: There is no field selector" <+> ppr_sel - <+> text "in scope for record type" <+> ppr_r - where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) - ppr_arr_r_a = ppr $ mkVisFunTyMany r a - ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" SuggestAnonymousWildcard @@ -405,10 +403,10 @@ pprImportSuggestion dc_occ (ImportDataCon { ies_suggest_import_from = Just mod parens_sp d = parens (space <> d <> space) -- | Pretty-print a 'SimilarName'. -pprSimilarName :: NameSpace -> SimilarName -> SDoc +pprSimilarName :: Maybe NameSpace -> SimilarName -> SDoc pprSimilarName _ (SimilarName name) = quotes (ppr name) <+> parens (pprDefinedAt name) -pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) +pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope) = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc where loc = case how_in_scope of @@ -421,8 +419,12 @@ pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) ImportedBy is -> parens (text "imported from" <+> ppr (moduleName $ is_mod is)) pp_ns :: RdrName -> SDoc - pp_ns rdr | ns /= tried_ns = pprNameSpace ns - | otherwise = empty + pp_ns rdr + | Just tried_ns <- mb_tried_ns + , ns /= tried_ns + = pprNameSpace ns + | otherwise + = empty where ns = rdrNameSpace rdr pprImpliedExtensions :: LangExt.Extension -> SDoc @@ -437,6 +439,34 @@ pprPrefixUnqual :: Name -> SDoc pprPrefixUnqual name = pprPrefixOcc (getOccName name) +pprSimilarFields :: TyCon -> TyCon -> FieldLabelString -> [(TyCon, SimilarName)] -> SDoc +pprSimilarFields _tc rep_tc _fld suggs + | null suggs + = empty + -- There are similarly named fields for the right TyCon: report those first. + | same_tc_sugg1 : same_tc_rest <- same_tc + = case same_tc_rest of + [] -> + text "Perhaps use" <+> ppr_same_tc same_tc_sugg1 <> dot + _ -> + vcat [ text "Perhaps use one of" + , nest 2 $ pprWithCommas ppr_same_tc same_tc + ] + -- Otherwise, report the similarly named fields for other TyCons. + | otherwise + = vcat [ text "Perhaps use" <+> similar_field <+> text "of another type" <> colon + , nest 2 $ pprWithCommas ppr_other_tc others + ] + where + (same_tc, others) = partition ((== rep_tc) . fst) suggs + similar_field = + case others of + _:_:_ -> "one of the similarly named fields" + _ -> "the similarly named field" + ppr_same_tc (_, nm) = pprSimilarName Nothing nm + ppr_other_tc (other_tc, nm) = + quotes (ppr other_tc) <> colon <+> pprSimilarName Nothing nm + pprSigLike :: SigLike -> SDoc pprSigLike = \case SigLikeSig sig -> ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -1403,7 +1403,7 @@ data HsMatchContext fn | ThPatSplice -- ^A Template Haskell pattern splice | ThPatQuote -- ^A Template Haskell pattern quotation [p| (a,b) |] - | PatSyn -- ^A pattern synonym declaration + | PatSynCtx -- ^A pattern synonym declaration | LazyPatCtx -- ^An irrefutable pattern {- Note [mc_fun field of FunRhs] @@ -1467,8 +1467,8 @@ qualifiedDoModuleName_maybe ctxt = case ctxt of isPatSynCtxt :: HsMatchContext fn -> Bool isPatSynCtxt ctxt = case ctxt of - PatSyn -> True - _ -> False + PatSynCtx -> True + _ -> False isComprehensionContext :: HsStmtContext fn -> Bool -- Uses comprehension syntax [ e | quals ] ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480.hs ===================================== @@ -0,0 +1,65 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PatternSynonyms #-} + +module T26480 where + +import Data.Proxy +import GHC.TypeLits +import GHC.Records + +import T26480_aux1 (R1) +import qualified T26480_aux2 as XXX (R2) + +data S = MkS { fld_s :: Int } + +data E where + MkE :: { fld_e :: e } -> E + +data Q = MkQ { fld_q :: forall a. a -> a } + +data T = MkT { specificFieldName :: Int } + +data G = MkG { xyzzywyzzydyzzy :: Int } + +pattern P :: Int -> S +pattern P { patSynField } = MkS patSynField + +-- Not a literal string +test1 :: forall (fld_s :: Symbol). Proxy fld_s -> S -> Int +test1 _ = getField @fld_s + +-- Not a record type +test2 :: Int -> Int +test2 = getField @"int_fld" + +-- Field out of scope: unqualified import +test3a :: R1 -> Int +test3a = getField @"f1" + +-- Field out of scope: qualified import +test3b :: XXX.R2 -> Int +test3b = getField @"f2" + +-- Existential record field +test4 :: E -> Int +test4 = getField @"fld_e" + +-- Record field contains forall +test5 :: Q -> Bool -> Bool +test5 = getField @"fld_q" + +-- Record field is misspelled +test6 :: T -> Int +test6 = getField @"specificFieldTame" + +-- Record field is for a different type +test7 :: T -> Int +test7 = getField @"xyzzywyzzydyzzy" + +-- Record field is misspelled and is for a different type +test8 :: T -> Int +test8 = getField @"xyzzywyzzyzyzzy" + +-- Pattern synonym field +test9 :: S -> Int +test9 = getField @"patSynField" ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480.stderr ===================================== @@ -0,0 +1,82 @@ +T26480.hs:29:11: error: [GHC-39999] + • No instance for ‘HasField fld_s S Int’ + arising from a use of ‘getField’ + NB: ‘fld_s’ is a type variable, not a string literal. + • In the expression: getField @fld_s + In an equation for ‘test1’: test1 _ = getField @fld_s + +T26480.hs:33:9: error: [GHC-39999] + • No instance for ‘HasField "int_fld" Int Int’ + arising from a use of ‘getField’ + NB: ‘Int’ is not a record type. + • In the expression: getField @"int_fld" + In an equation for ‘test2’: test2 = getField @"int_fld" + +T26480.hs:37:10: error: [GHC-39999] + • No instance for ‘HasField "f1" R1 Int’ + arising from a use of ‘getField’ + NB: the record field ‘f1’ of ‘R1’ is out of scope. + • In the expression: getField @"f1" + In an equation for ‘test3a’: test3a = getField @"f1" + Suggested fix: + Add ‘f1’ to the import list in the import of ‘T26480_aux1’ + (at T26480.hs:10:1-23). + +T26480.hs:41:10: error: [GHC-39999] + • No instance for ‘HasField "f2" XXX.R2 Int’ + arising from a use of ‘getField’ + NB: the record field ‘f2’ of ‘XXX.R2’ is out of scope. + • In the expression: getField @"f2" + In an equation for ‘test3b’: test3b = getField @"f2" + Suggested fix: + Add ‘f2’ to the import list in the import of ‘T26480_aux2’ + (at T26480.hs:11:1-40). + +T26480.hs:45:9: error: [GHC-39999] + • No instance for ‘HasField "fld_e" E Int’ + arising from a use of ‘getField’ + NB: the record field ‘fld_e’ of ‘E’ contains existential variables. + • In the expression: getField @"fld_e" + In an equation for ‘test4’: test4 = getField @"fld_e" + +T26480.hs:49:9: error: [GHC-39999] + • No instance for ‘HasField "fld_q" Q (Bool -> Bool)’ + arising from a use of ‘getField’ + NB: the field type of the record field ‘fld_q’ of ‘Q’ is not a mono-type. + • In the expression: getField @"fld_q" + In an equation for ‘test5’: test5 = getField @"fld_q" + +T26480.hs:53:9: error: [GHC-39999] + • No instance for ‘HasField "specificFieldTame" T Int’ + arising from a use of ‘getField’ + NB: ‘T’ does not have a record field named ‘specificFieldTame’. + • In the expression: getField @"specificFieldTame" + In an equation for ‘test6’: test6 = getField @"specificFieldTame" + Suggested fix: Perhaps use ‘specificFieldName’ (line 20). + +T26480.hs:57:9: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzy" T Int’ + arising from a use of ‘getField’ + NB: ‘T’ does not have a record field named ‘xyzzywyzzydyzzy’. + Another type has a field of this name: ‘G’. + • In the expression: getField @"xyzzywyzzydyzzy" + In an equation for ‘test7’: test7 = getField @"xyzzywyzzydyzzy" + +T26480.hs:61:9: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzyzyzzy" T Int’ + arising from a use of ‘getField’ + NB: ‘T’ does not have a record field named ‘xyzzywyzzyzyzzy’. + • In the expression: getField @"xyzzywyzzyzyzzy" + In an equation for ‘test8’: test8 = getField @"xyzzywyzzyzyzzy" + Suggested fix: + Perhaps use the similarly named field of another type: + ‘G’: ‘xyzzywyzzydyzzy’ (line 22) + +T26480.hs:65:9: error: [GHC-39999] + • No instance for ‘HasField "patSynField" S Int’ + arising from a use of ‘getField’ + NB: ‘S’ does not have a record field named ‘patSynField’. + Pattern synonym record fields do not contribute ‘HasField’ instances. + • In the expression: getField @"patSynField" + In an equation for ‘test9’: test9 = getField @"patSynField" + ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480_aux1.hs ===================================== @@ -0,0 +1,4 @@ +module T26480_aux1 where + +data R1 = MkR1 { f1 :: Int } +data R2 = MkR2 { f2 :: Int } ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480_aux2.hs ===================================== @@ -0,0 +1,3 @@ +module T26480_aux2 where + +data R2 = MkR2 { f2 :: Int } ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480b.hs ===================================== @@ -0,0 +1,57 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedRecordUpdate #-} + +module T26480b where + +import Prelude +import Data.Proxy +import GHC.TypeLits +import GHC.Records + + +setField + :: forall (fld :: Symbol) rec ty + . HasField fld rec ty => ty -> rec -> rec +setField _ r = r + +data N = N { no :: H } + +data D = MkD{ field1 :: G } + +data G = MkG { xyzzywyzzydyzzy :: H } + +data H = MkH { field2 :: Int } + +-- Direct usage of 'getField' +test1 :: G -> H +test1 = getField @"xyzzywyzzydyzza" + +test1' :: N -> H +test1' = getField @"xyzzywyzzydyzzy" + +test1'' :: N -> H +test1'' = getField @"ayzzywyzzydyzzy" + +-- Record dot, applied +test2a :: G -> H +test2a g = g.xyzzywyzzydyzzb + +test2b :: D -> H +test2b g = g.field1.xyzzywyzzydyzzc + +-- Record dot, bare selector +test3a :: G -> H +test3a = (.xyzzywyzzydyzzd) + +test3b :: D ->H +test3b = (.field1.xyzzywyzzydyzze) + +-- Overloaded record update +test4a :: G -> G +test4a d = d { xyzzywyzzydyzzf = MkG ( MkH 3 ) } + +test4b :: D -> D +test4b d = d { field1.xyzzywyzzydyzzg = MkH 3 } ===================================== testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr ===================================== @@ -0,0 +1,74 @@ +T26480b.hs:30:9: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzza" G H’ + arising from a use of ‘getField’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzza’. + • In the expression: getField @"xyzzywyzzydyzza" + In an equation for ‘test1’: test1 = getField @"xyzzywyzzydyzza" + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:33:10: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzy" N H’ + arising from a use of ‘getField’ + NB: ‘N’ does not have a record field named ‘xyzzywyzzydyzzy’. + Another type has a field of this name: ‘G’. + • In the expression: getField @"xyzzywyzzydyzzy" + In an equation for ‘test1'’: test1' = getField @"xyzzywyzzydyzzy" + +T26480b.hs:36:11: error: [GHC-39999] + • No instance for ‘HasField "ayzzywyzzydyzzy" N H’ + arising from a use of ‘getField’ + NB: ‘N’ does not have a record field named ‘ayzzywyzzydyzzy’. + • In the expression: getField @"ayzzywyzzydyzzy" + In an equation for ‘test1''’: test1'' = getField @"ayzzywyzzydyzzy" + Suggested fix: + Perhaps use the similarly named field of another type: + ‘G’: ‘xyzzywyzzydyzzy’ (line 24) + +T26480b.hs:40:12: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzb" G H’ + arising from selecting the field ‘xyzzywyzzydyzzb’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzzb’. + • In the expression: g.xyzzywyzzydyzzb + In an equation for ‘test2a’: test2a g = g.xyzzywyzzydyzzb + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:43:12: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzc" G H’ + arising from selecting the field ‘xyzzywyzzydyzzc’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzzc’. + • In the expression: g.field1.xyzzywyzzydyzzc + In an equation for ‘test2b’: test2b g = g.field1.xyzzywyzzydyzzc + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:47:10: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzd" G H’ + arising from the record selector ‘xyzzywyzzydyzzd’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzzd’. + • In the expression: (.xyzzywyzzydyzzd) + In an equation for ‘test3a’: test3a = (.xyzzywyzzydyzzd) + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:50:10: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzze" G H’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzze’. + • In the expression: (.field1.xyzzywyzzydyzze) + In an equation for ‘test3b’: test3b = (.field1.xyzzywyzzydyzze) + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:54:12: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzf" G G’ + arising from a record update + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzzf’. + • In the expression: d {xyzzywyzzydyzzf = MkG (MkH 3)} + In an equation for ‘test4a’: + test4a d = d {xyzzywyzzydyzzf = MkG (MkH 3)} + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + +T26480b.hs:57:12: error: [GHC-39999] + • No instance for ‘HasField "xyzzywyzzydyzzg" G H’ + NB: ‘G’ does not have a record field named ‘xyzzywyzzydyzzg’. + • In the expression: d {field1.xyzzywyzzydyzzg = MkH 3} + In an equation for ‘test4b’: + test4b d = d {field1.xyzzywyzzydyzzg = MkH 3} + Suggested fix: Perhaps use ‘xyzzywyzzydyzzy’ (line 24). + ===================================== testsuite/tests/overloadedrecflds/should_fail/all.T ===================================== @@ -33,6 +33,8 @@ test('hasfieldfail03', normal, compile_fail, ['']) test('hasfieldfail04', normal, compile_fail, ['']) test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])], multimod_compile_fail, ['T14953', '']) +test('T26480', extra_files(['T26480_aux1.hs', 'T26480_aux2.hs']), multimod_compile_fail, ['T26480', '-v0']) +test('T26480b', normal, compile_fail, ['']) test('DuplicateExports', normal, compile_fail, ['']) test('T17420', [extra_files(['T17420A.hs'])], multimod_compile_fail, ['T17420', '']) ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr ===================================== @@ -1,11 +1,15 @@ [1 of 3] Compiling HasFieldFail01_A ( HasFieldFail01_A.hs, HasFieldFail01_A.o ) [2 of 3] Compiling Main ( hasfieldfail01.hs, hasfieldfail01.o ) - hasfieldfail01.hs:9:15: error: [GHC-39999] • No instance for ‘HasField "foo" T Int’ arising from a use of ‘getField’ + NB: the record field ‘foo’ of ‘T’ is out of scope. • In the first argument of ‘print’, namely ‘(getField @"foo" (MkT 42) :: Int)’ In the expression: print (getField @"foo" (MkT 42) :: Int) In an equation for ‘main’: main = print (getField @"foo" (MkT 42) :: Int) + Suggested fix: + Add ‘foo’ to the import list in the import of ‘HasFieldFail01_A’ + (at hasfieldfail01.hs:3:1-32). + ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr ===================================== @@ -1,12 +1,14 @@ - hasfieldfail02.hs:11:5: error: [GHC-39999] • No instance for ‘HasField "foo" T a1’ arising from a use of ‘getField’ + NB: the field type of the record field ‘foo’ of ‘T’ is not a mono-type. • In the expression: getField @"foo" (MkT id) In an equation for ‘x’: x = getField @"foo" (MkT id) hasfieldfail02.hs:17:5: error: [GHC-39999] • No instance for ‘HasField "bar" U a0’ arising from a use of ‘getField’ + NB: the record field ‘bar’ of ‘U’ contains existential variables. • In the expression: getField @"bar" (MkU True) In an equation for ‘y’: y = getField @"bar" (MkU True) + ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr ===================================== @@ -16,6 +16,7 @@ RecordDotSyntaxFail11.hs:8:3: error: [GHC-39999] RecordDotSyntaxFail11.hs:8:11: error: [GHC-39999] • No instance for ‘GHC.Internal.Records.HasField "baz" Int a0’ + NB: ‘Int’ is not a record type. • In the second argument of ‘($)’, namely ‘(.foo.bar.baz) a’ In a stmt of a 'do' block: print $ (.foo.bar.baz) a In the expression: ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs ===================================== @@ -28,10 +28,26 @@ data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) --- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux { quux :: Int } deriving (Show, Eq) +-- 'Quux' has 'quux' fields of type 'Wob' +data Quux = Quux { quux1, quux2, quux3 :: Wob } deriving (Show, Eq) -- Forget to write this type's 'HasField' instance +-- 'Wob' has a field of type 'Bool' +data Wob = Wob { wob :: Bool } deriving (Show, Eq) +instance HasField "wob" Wob Bool where + hasField r = (\x -> case r of Wob { .. } -> Wob { wob = x, .. }, wob r) + +myQuux :: Quux +myQuux = Quux w w w + where w = Wob { wob = True } + main = do - let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } - print $ a.foo.bar.baz.quux + let + a = Foo { foo = Bar{ bar = Baz { baz = myQuux } } } + print @Quux $ a.foo.bar.baz.quux1 + + let b = myQuux + print @Quux $ b.quux2 + + let c = Foo { foo = Bar{ bar = Baz { baz = myQuux } } } + print @Bool $ a.foo.bar.baz.quux3.wob ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -1,28 +1,36 @@ -RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] - • Ambiguous type variable ‘a0’ arising from a use of ‘print’ - prevents the constraint ‘(Show a0)’ from being solved. - Probable fix: use a type annotation to specify what ‘a0’ should be. - Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ - instance Show Bar -- Defined at RecordDotSyntaxFail8.hs:22:41 - ...plus 29 others - ...plus 13 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the first argument of ‘($)’, namely ‘print’ - In a stmt of a 'do' block: print $ ....baz.quux +RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999] + • No instance for ‘HasField "quux1" Quux Quux’ + arising from selecting the field ‘quux1’ + NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. + • In the second argument of ‘($)’, namely ‘....bar.baz.quux1’ + In a stmt of a 'do' block: print @Quux $ ....baz.quux1 In the expression: do let a = Foo {foo = ...} - print $ ....quux + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + let c = Foo {foo = ...} + ... -RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] - • No instance for ‘HasField "quux" Quux a0’ - arising from selecting the field ‘quux’ - • In the second argument of ‘($)’, namely ‘....bar.baz.quux’ - In a stmt of a 'do' block: print $ ....baz.quux +RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999] + • No instance for ‘HasField "quux2" Quux Quux’ + arising from selecting the field ‘quux2’ + NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. + • In the second argument of ‘($)’, namely ‘b.quux2’ + In a stmt of a 'do' block: print @Quux $ b.quux2 In the expression: do let a = Foo {foo = ...} - print $ ....quux - Suggested fix: - NB: There is no field selector ‘quux :: Quux - -> a0’ in scope for record type ‘Quux’ + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + let c = Foo {foo = ...} + ... + +RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999] + • No instance for ‘HasField "quux3" Quux r0’ + arising from selecting the field ‘quux3’ + NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. + • In the expression: ....bar.baz.quux3 + In the second argument of ‘($)’, namely ‘....baz.quux3.wob’ + In a stmt of a 'do' block: print @Bool $ ....quux3.wob ===================================== testsuite/tests/rename/should_fail/T19843h.stderr ===================================== @@ -29,7 +29,7 @@ T19843h.hs:24:8: error: [GHC-39999] • In the expression: undefined.getAll In an equation for ‘quur’: quur = undefined.getAll Suggested fixes: - • Perhaps use record field of Alt ‘getAlt’ (imported from Data.Monoid) • Add ‘getAll’ to the import list in the import of ‘Data.Monoid’ - (at T19843h.hs:9:1-28). + (at T19843h.hs:8:1-46). + • Perhaps use record field of Alt ‘getAlt’ (imported from Data.Monoid) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ef22fa0ba7c0a9284176e40fdc313… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ef22fa0ba7c0a9284176e40fdc313… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add SIMD primops for bitwise logical operations
by Marge Bot (＠marge-bot) 27 Oct '25

27 Oct '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6ef22fa0 by IC Rainbow at 2025-10-26T18:23:01-04:00 Add SIMD primops for bitwise logical operations This adds 128-bit wide and/or/xor instructions for X86 NCG, with both SSE and AVX encodings. ``` andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# -- andps / vandps andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# -- andpd / vandpd andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# -- pand / vpand ``` The new primops are available on ARM when using LLVM backend. Tests added: - simd015 (floats and doubles) - simd016 (integers) - simd017 (words) Fixes #26417 - - - - - 26 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - docs/users_guide/9.16.1-notes.rst - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-prim/changelog.md - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/simd015.hs - + testsuite/tests/simd/should_run/simd015.stdout - + testsuite/tests/simd/should_run/simd016.hs - + testsuite/tests/simd/should_run/simd016.stdout - + testsuite/tests/simd/should_run/simd017.hs - + testsuite/tests/simd/should_run/simd017.stdout Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -4391,6 +4391,24 @@ primop VecMaxOp "max#" GenPrimOp with vector = ALL_VECTOR_TYPES +primop VecAndOp "and#" GenPrimOp + VECTOR -> VECTOR -> VECTOR + {Bit-wise AND of two vectors.} + with + vector = ALL_VECTOR_TYPES + +primop VecOrOp "or#" GenPrimOp + VECTOR -> VECTOR -> VECTOR + {Bit-wise OR of two vectors.} + with + vector = ALL_VECTOR_TYPES + +primop VecXorOp "xor#" GenPrimOp + VECTOR -> VECTOR -> VECTOR + {Bit-wise XOR of two vectors.} + with + vector = ALL_VECTOR_TYPES + ------------------------------------------------------------------------ section "Prefetch" ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -196,6 +196,14 @@ data MachOp | MO_VF_Min Length Width | MO_VF_Max Length Width + -- Bitwise vector operations + | MO_V_And Length Width + | MO_V_Or Length Width + | MO_V_Xor Length Width + | MO_VF_And Length Width + | MO_VF_Or Length Width + | MO_VF_Xor Length Width + -- | An atomic read with no memory ordering. Address msut -- be naturally aligned. | MO_RelaxedRead Width @@ -507,6 +515,14 @@ machOpResultType platform mop tys = MO_V_Sub l w -> cmmVec l (cmmBits w) MO_V_Mul l w -> cmmVec l (cmmBits w) + MO_V_And l w -> cmmVec l (cmmBits w) + MO_V_Or l w -> cmmVec l (cmmBits w) + MO_V_Xor l w -> cmmVec l (cmmBits w) + + MO_VF_And l w -> cmmVec l (cmmBits w) + MO_VF_Or l w -> cmmVec l (cmmBits w) + MO_VF_Xor l w -> cmmVec l (cmmBits w) + MO_VS_Neg l w -> cmmVec l (cmmBits w) MO_VS_Min l w -> cmmVec l (cmmBits w) MO_VS_Max l w -> cmmVec l (cmmBits w) @@ -636,6 +652,13 @@ machOpArgReps platform op = MO_VF_Min l w -> [vecwidth l w, vecwidth l w] MO_VF_Max l w -> [vecwidth l w, vecwidth l w] + MO_V_And l w -> [vecwidth l w, vecwidth l w] + MO_V_Or l w -> [vecwidth l w, vecwidth l w] + MO_V_Xor l w -> [vecwidth l w, vecwidth l w] + MO_VF_And l w -> [vecwidth l w, vecwidth l w] + MO_VF_Or l w -> [vecwidth l w, vecwidth l w] + MO_VF_Xor l w -> [vecwidth l w, vecwidth l w] + MO_RelaxedRead _ -> [wordWidth platform] MO_AlignmentCheck _ w -> [w] where ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -832,6 +832,9 @@ getRegister' config plat expr MO_V_Add {} -> notUnary MO_V_Sub {} -> notUnary MO_V_Mul {} -> notUnary + MO_V_And {} -> notUnary + MO_V_Or {} -> notUnary + MO_V_Xor {} -> notUnary MO_VS_Neg {} -> notUnary MO_V_Shuffle {} -> notUnary MO_VF_Shuffle {} -> notUnary @@ -841,6 +844,9 @@ getRegister' config plat expr MO_VF_Sub {} -> notUnary MO_VF_Mul {} -> notUnary MO_VF_Quot {} -> notUnary + MO_VF_And {} -> notUnary + MO_VF_Or {} -> notUnary + MO_VF_Xor {} -> notUnary MO_Add {} -> notUnary MO_Sub {} -> notUnary @@ -1221,6 +1227,12 @@ getRegister' config plat expr MO_V_Add {} -> vectorsNeedLlvm MO_V_Sub {} -> vectorsNeedLlvm MO_V_Mul {} -> vectorsNeedLlvm + MO_V_And {} -> vectorsNeedLlvm + MO_V_Or {} -> vectorsNeedLlvm + MO_V_Xor {} -> vectorsNeedLlvm + MO_VF_And {} -> vectorsNeedLlvm + MO_VF_Or {} -> vectorsNeedLlvm + MO_VF_Xor {} -> vectorsNeedLlvm MO_VS_Neg {} -> vectorsNeedLlvm MO_VF_Extract {} -> vectorsNeedLlvm MO_VF_Add {} -> vectorsNeedLlvm ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1137,6 +1137,13 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps MO_VF_Min {} -> incorrectOperands MO_VF_Max {} -> incorrectOperands + MO_V_And {} -> incorrectOperands + MO_V_Or {} -> incorrectOperands + MO_V_Xor {} -> incorrectOperands + MO_VF_And {} -> incorrectOperands + MO_VF_Or {} -> incorrectOperands + MO_VF_Xor {} -> incorrectOperands + MO_VF_Extract {} -> incorrectOperands MO_VF_Add {} -> incorrectOperands MO_VF_Sub {} -> incorrectOperands @@ -1404,6 +1411,20 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps MO_VF_Max l w | avx -> vector_float_op_avx (VMINMAX Max FloatMinMax) l w x y | otherwise -> vector_float_op_sse (MINMAX Max FloatMinMax) l w x y + MO_V_And l w | avx -> vector_int_op_avx VPAND l w x y + | otherwise -> vector_int_op_sse PAND l w x y + MO_V_Or l w | avx -> vector_int_op_avx VPOR l w x y + | otherwise -> vector_int_op_sse POR l w x y + MO_V_Xor l w | avx -> vector_int_op_avx VPXOR l w x y + | otherwise -> vector_int_op_sse PXOR l w x y + + MO_VF_And l w | avx -> vector_float_op_avx VAND l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> AND fmt op2 . OpReg) l w x y + MO_VF_Or l w | avx -> vector_float_op_avx VOR l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> OR fmt op2 . OpReg) l w x y + MO_VF_Xor l w | avx -> vector_float_op_avx VXOR l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> XOR fmt op2 . OpReg) l w x y + -- SIMD NCG TODO: 256/512-bit integer vector operations MO_V_Shuffle 16 W8 is | not is32Bit -> vector_shuffle_int8x16 sse4_1 x y is MO_V_Shuffle 8 W16 is -> vector_shuffle_int16x8 sse4_1 x y is @@ -1680,6 +1701,21 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps ----------------------- -- Vector operations--- + vector_int_op_avx :: (Format -> Operand -> Reg -> Reg -> Instr) + -> Length + -> Width + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int_op_avx instr l w = vector_op_avx_reg (\fmt -> instr fmt . OpReg) format + where format = case w of + W8 -> VecFormat l FmtInt8 + W16 -> VecFormat l FmtInt16 + W32 -> VecFormat l FmtInt32 + W64 -> VecFormat l FmtInt64 + _ -> pprPanic "Integer AVX vector operation not supported at this width" + (text "width:" <+> ppr w) + vector_float_op_avx :: (Format -> Operand -> Reg -> Reg -> Instr) -> Length -> Width @@ -3157,7 +3193,7 @@ getRegister' platform is32Bit (CmmLit lit) = do | avx = if float_or_floatvec then unitOL (VXOR fmt (OpReg dst) dst dst) - else unitOL (VPXOR fmt dst dst dst) + else unitOL (VPXOR fmt (OpReg dst) dst dst) | otherwise = if float_or_floatvec then unitOL (XOR fmt (OpReg dst) (OpReg dst)) ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -175,11 +175,13 @@ data Instr | AND Format Operand Operand | OR Format Operand Operand | XOR Format Operand Operand - -- | AVX bitwise logical XOR operation - | VXOR Format Operand Reg Reg | NOT Format Operand | NEGI Format Operand -- NEG instruction (name clash with Cond) | BSWAP Format Reg + -- Vector bitwise logical operations + | VAND Format Operand Reg Reg + | VOR Format Operand Reg Reg + | VXOR Format Operand Reg Reg -- Shifts (amount may be immediate or %cl only) | SHL Format Operand{-amount-} Operand @@ -318,10 +320,12 @@ data Instr -- logic operations | PXOR Format Operand Reg - | VPXOR Format Reg Reg Reg + | VPXOR Format Operand Reg Reg | PAND Format Operand Reg | PANDN Format Operand Reg + | VPAND Format Operand Reg Reg | POR Format Operand Reg + | VPOR Format Operand Reg Reg -- Arithmetic | VADD Format Operand Reg Reg @@ -444,8 +448,14 @@ regUsageOfInstr platform instr IDIV fmt op -> mkRU (mk fmt eax:mk fmt edx:use_R fmt op []) [mk fmt eax, mk fmt edx] ADD_CC fmt src dst -> usageRM fmt src dst SUB_CC fmt src dst -> usageRM fmt src dst + AND fmt src dst -> usageRM fmt src dst + VAND fmt src1 src2 dst + -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst] + OR fmt src dst -> usageRM fmt src dst + VOR fmt src1 src2 dst + -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst] XOR fmt (OpReg src) (OpReg dst) | src == dst @@ -500,6 +510,8 @@ regUsageOfInstr platform instr LOCATION{} -> noUsage UNWIND{} -> noUsage DELTA _ -> noUsage + LDATA{} -> noUsage + NEWBLOCK{} -> noUsage POPCNT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst] LZCNT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst] @@ -525,7 +537,7 @@ regUsageOfInstr platform instr VPBROADCAST sFmt vFmt src dst -> mkRU (use_R sFmt src []) [mk vFmt dst] VEXTRACT fmt _off src dst -> usageRW fmt (OpReg src) dst INSERTPS fmt (ImmInt off) src dst - -> mkRU ((use_R fmt src []) ++ [mk fmt dst | not doesNotReadDst]) [mk fmt dst] + -> mkRU (use_R fmt src [mk fmt dst | not doesNotReadDst]) [mk fmt dst] where -- Compute whether the instruction reads the destination register or not. -- Immediate bits: ss_dd_zzzz s = src pos, d = dst pos, z = zeroed components. @@ -534,7 +546,7 @@ regUsageOfInstr platform instr -- are being zeroed. where pos = ( off `shiftR` 4 ) .&. 0b11 INSERTPS fmt _off src dst - -> mkRU ((use_R fmt src []) ++ [mk fmt dst]) [mk fmt dst] + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] VINSERTPS fmt _imm src2 src1 dst -> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst] PINSR sFmt vFmt _off src dst @@ -550,26 +562,30 @@ regUsageOfInstr platform instr VMOVDQU fmt src dst -> usageRW fmt src dst VMOV_MERGE fmt src2 src1 dst -> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst] - PXOR fmt (OpReg src) dst - | src == dst + PXOR fmt src dst + | OpReg src_reg <- src + , src_reg == dst -> mkRU [] [mk fmt dst] | otherwise - -> mkRU [mk fmt src, mk fmt dst] [mk fmt dst] + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] VPXOR fmt s1 s2 dst - | s1 == s2, s1 == dst + | OpReg s1_reg <- s1 + , s1_reg == s2, s1_reg == dst -> mkRU [] [mk fmt dst] | otherwise - -> mkRU [mk fmt s1, mk fmt s2] [mk fmt dst] + -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] PAND fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PANDN fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VPAND fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] POR fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VPOR fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] - VADD fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] - VSUB fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] - VMUL fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] - VDIV fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] + VADD fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] + VSUB fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] + VMUL fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] + VDIV fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] PADD fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PSUB fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PMULL fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] @@ -651,7 +667,6 @@ regUsageOfInstr platform instr -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] VMINMAX _ _ fmt src1 src2 dst -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst] - _other -> panic "regUsage: unrecognised instr" where -- # Definitions @@ -779,6 +794,8 @@ patchRegsOfInstr platform instr env AND fmt src dst -> patch2 (AND fmt) src dst OR fmt src dst -> patch2 (OR fmt) src dst XOR fmt src dst -> patch2 (XOR fmt) src dst + VAND fmt src1 src2 dst -> VAND fmt (patchOp src1) (env src2) (env dst) + VOR fmt src1 src2 dst -> VOR fmt (patchOp src1) (env src2) (env dst) VXOR fmt src1 src2 dst -> VXOR fmt (patchOp src1) (env src2) (env dst) NOT fmt op -> patch1 (NOT fmt) op BSWAP fmt reg -> BSWAP fmt (env reg) @@ -868,11 +885,13 @@ patchRegsOfInstr platform instr env VMOVDQU fmt src dst -> VMOVDQU fmt (patchOp src) (patchOp dst) VMOV_MERGE fmt src2 src1 dst -> VMOV_MERGE fmt (env src2) (env src1) (env dst) - PXOR fmt src dst -> PXOR fmt (patchOp src) (env dst) - VPXOR fmt s1 s2 dst -> VPXOR fmt (env s1) (env s2) (env dst) - PAND fmt src dst -> PAND fmt (patchOp src) (env dst) + PXOR fmt src dst -> PXOR fmt (patchOp src) (env dst) + VPXOR fmt s1 s2 dst -> VPXOR fmt (patchOp s1) (env s2) (env dst) + PAND fmt src dst -> PAND fmt (patchOp src) (env dst) + VPAND fmt s1 s2 dst -> VPAND fmt (patchOp s1) (env s2) (env dst) PANDN fmt src dst -> PANDN fmt (patchOp src) (env dst) - POR fmt src dst -> POR fmt (patchOp src) (env dst) + POR fmt src dst -> POR fmt (patchOp src) (env dst) + VPOR fmt s1 s2 dst -> VPOR fmt (patchOp s1) (env s2) (env dst) VADD fmt s1 s2 dst -> VADD fmt (patchOp s1) (env s2) (env dst) VSUB fmt s1 s2 dst -> VSUB fmt (patchOp s1) (env s2) (env dst) ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -737,9 +737,15 @@ pprInstr platform i = case i of AND format src dst -> pprFormatOpOp (text "and") format src dst + VAND format src1 src2 dst + -> pprFormatOpRegReg (text "vand") format src1 src2 dst + OR format src dst -> pprFormatOpOp (text "or") format src dst + VOR format src1 src2 dst + -> pprFormatOpRegReg (text "vor") format src1 src2 dst + XOR FF32 src dst -> pprOpOp (text "xorps") FF32 src dst @@ -753,7 +759,7 @@ pprInstr platform i = case i of -> pprFormatOpOp (text "xor") format src dst VXOR fmt src1 src2 dst - -> pprVxor fmt src1 src2 dst + -> pprVXor fmt src1 src2 dst POPCNT format src dst -> pprOpOp (text "popcnt") format src (OpReg dst) @@ -1036,13 +1042,17 @@ pprInstr platform i = case i of PXOR format src dst -> pprPXor (text "pxor") format src dst VPXOR format s1 s2 dst - -> pprXor (text "vpxor") format s1 s2 dst + -> pprVXor format s1 s2 dst PAND format src dst -> pprOpReg (text "pand") format src dst + VPAND format s1 s2 dst + -> pprOpRegReg (text "vpand") format s1 s2 dst PANDN format src dst -> pprOpReg (text "pandn") format src dst POR format src dst -> pprOpReg (text "por") format src dst + VPOR format s1 s2 dst + -> pprOpRegReg (text "vpor") format s1 s2 dst VEXTRACT format offset from to -> pprFormatImmRegOp (text "vextract") format offset from to INSERTPS format offset addr dst @@ -1299,6 +1309,16 @@ pprInstr platform i = case i of pprReg platform (archWordFormat (target32Bit platform)) reg ] + pprOpRegReg :: Line doc -> Format -> Operand -> Reg -> Reg -> doc + pprOpRegReg name format op1 reg2 reg3 + = line $ hcat [ + pprMnemonic_ name, + pprOperand platform format op1, + comma, + pprReg platform (archWordFormat (target32Bit platform)) reg2, + comma, + pprReg platform (archWordFormat (target32Bit platform)) reg3 + ] pprFormatOpReg :: Line doc -> Format -> Operand -> Reg -> doc pprFormatOpReg name format op1 reg2 @@ -1397,17 +1417,6 @@ pprInstr platform i = case i of pprReg platform vectorFormat dst ] - pprXor :: Line doc -> Format -> Reg -> Reg -> Reg -> doc - pprXor name format reg1 reg2 reg3 - = line $ hcat [ - pprGenMnemonic name format, - pprReg platform format reg1, - comma, - pprReg platform format reg2, - comma, - pprReg platform format reg3 - ] - pprPXor :: Line doc -> Format -> Operand -> Reg -> doc pprPXor name format src dst = line $ hcat [ @@ -1417,8 +1426,8 @@ pprInstr platform i = case i of pprReg platform format dst ] - pprVxor :: Format -> Operand -> Reg -> Reg -> doc - pprVxor fmt src1 src2 dst + pprVXor :: Format -> Operand -> Reg -> Reg -> doc + pprVXor fmt src1 src2 dst = line $ hcat [ pprGenMnemonic mem fmt, pprOperand platform fmt src1, @@ -1433,7 +1442,8 @@ pprInstr platform i = case i of FF64 -> text "vxorpd" VecFormat _ FmtFloat -> text "vxorps" VecFormat _ FmtDouble -> text "vxorpd" - _ -> pprPanic "GHC.CmmToAsm.X86.Ppr.pprVxor: element type must be Float or Double" + VecFormat _ _ints -> text "vpxor" + _ -> pprPanic "GHC.CmmToAsm.X86.Ppr.pprVXor: unexpected format" (ppr fmt) pprInsert :: Line doc -> Format -> Imm -> Operand -> Reg -> doc ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -873,6 +873,31 @@ pprMachOp_for_C platform mop = case mop of (text "MO_V_Mul") (panic $ "PprC.pprMachOp_for_C: MO_V_Mul" ++ "unsupported by the unregisterised backend") + MO_V_And {} -> pprTrace "offending mop:" + (text "MO_V_And") + (panic $ "PprC.pprMachOp_for_C: MO_V_And" + ++ "unsupported by the unregisterised backend") + MO_V_Or {} -> pprTrace "offending mop:" + (text "MO_V_Or") + (panic $ "PprC.pprMachOp_for_C: MO_V_Or" + ++ "unsupported by the unregisterised backend") + MO_V_Xor {} -> pprTrace "offending mop:" + (text "MO_V_Xor") + (panic $ "PprC.pprMachOp_for_C: MO_V_Xor" + ++ "unsupported by the unregisterised backend") + MO_VF_And {} -> pprTrace "offending mop:" + (text "MO_VF_And") + (panic $ "PprC.pprMachOp_for_C: MO_VF_And" + ++ "unsupported by the unregisterised backend") + MO_VF_Or {} -> pprTrace "offending mop:" + (text "MO_VF_Or") + (panic $ "PprC.pprMachOp_for_C: MO_VF_Or" + ++ "unsupported by the unregisterised backend") + MO_VF_Xor {} -> pprTrace "offending mop:" + (text "MO_VF_Xor") + (panic $ "PprC.pprMachOp_for_C: MO_VF_Xor" + ++ "unsupported by the unregisterised backend") + MO_VS_Neg {} -> pprTrace "offending mop:" (text "MO_VS_Neg") (panic $ "PprC.pprMachOp_for_C: MO_VS_Neg" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -1593,6 +1593,14 @@ genMachOp _ op [x] = case op of MO_VF_Min _ _ -> panicOp MO_VF_Max _ _ -> panicOp + MO_V_And {} -> panicOp + MO_V_Or {} -> panicOp + MO_V_Xor {} -> panicOp + + MO_VF_And {} -> panicOp + MO_VF_Or {} -> panicOp + MO_VF_Xor {} -> panicOp + where negate ty v2 negOp = do (vx, stmts, top) <- exprToVar x @@ -1754,11 +1762,19 @@ genMachOp_slow opt op [x, y] = case op of MO_V_Sub l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Sub MO_V_Mul l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Mul + MO_V_And l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_And + MO_V_Or l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Or + MO_V_Xor l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Xor + MO_VF_Add l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FAdd MO_VF_Sub l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FSub MO_VF_Mul l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FMul MO_VF_Quot l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FDiv + MO_VF_And l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_And + MO_VF_Or l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Or + MO_VF_Xor l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Xor + MO_Not _ -> panicOp MO_S_Neg _ -> panicOp MO_F_Neg _ -> panicOp ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1558,6 +1558,16 @@ emitPrimOp cfg primop = | not allowIntWord64X2MinMax -> opCallish MO_W64X2_Max (VecMaxOp WordVec n w) -> opTranslate (MO_VU_Max n w) + -- Vector bitwise instructions + -- On floats, ANDPS-like + (VecAndOp FloatVec n w) -> opTranslate (MO_VF_And n w) + (VecOrOp FloatVec n w) -> opTranslate (MO_VF_Or n w) + (VecXorOp FloatVec n w) -> opTranslate (MO_VF_Xor n w) + -- On integer, PAND-like + (VecAndOp _ n w) -> opTranslate (MO_V_And n w) + (VecOrOp _ n w) -> opTranslate (MO_V_Or n w) + (VecXorOp _ n w) -> opTranslate (MO_V_Xor n w) + -- Vector FMA instructions VecFMAdd _ n w -> fmaOp FMAdd n w VecFMSub _ n w -> fmaOp FMSub n w ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -1211,6 +1211,9 @@ genPrim prof bound ty op = case op of VecShuffleOp _ _ _ -> unhandledPrimop op VecMinOp {} -> unhandledPrimop op VecMaxOp {} -> unhandledPrimop op + VecAndOp {} -> unhandledPrimop op + VecOrOp {} -> unhandledPrimop op + VecXorOp {} -> unhandledPrimop op PrefetchByteArrayOp3 -> noOp PrefetchMutableByteArrayOp3 -> noOp ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -85,6 +85,8 @@ Cmm ``ghc-experimental`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +- New SIMD primops for bitwise logical operations on 128-wide vectors. + ``template-haskell`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/src/GHC/Base.hs ===================================== @@ -270,6 +270,97 @@ import GHC.Prim hiding , minWord8X16# , minWord8X32# , minWord8X64# + -- Don't re-export vector logical primops + , andDoubleX2# + , andDoubleX4# + , andDoubleX8# + , andFloatX16# + , andFloatX4# + , andFloatX8# + , andInt16X16# + , andInt16X32# + , andInt16X8# + , andInt32X16# + , andInt32X4# + , andInt32X8# + , andInt64X2# + , andInt64X4# + , andInt64X8# + , andInt8X16# + , andInt8X32# + , andInt8X64# + , andWord16X16# + , andWord16X32# + , andWord16X8# + , andWord32X16# + , andWord32X4# + , andWord32X8# + , andWord64X2# + , andWord64X4# + , andWord64X8# + , andWord8X16# + , andWord8X32# + , andWord8X64# + , orDoubleX2# + , orDoubleX4# + , orDoubleX8# + , orFloatX16# + , orFloatX4# + , orFloatX8# + , orInt16X16# + , orInt16X32# + , orInt16X8# + , orInt32X16# + , orInt32X4# + , orInt32X8# + , orInt64X2# + , orInt64X4# + , orInt64X8# + , orInt8X16# + , orInt8X32# + , orInt8X64# + , orWord16X16# + , orWord16X32# + , orWord16X8# + , orWord32X16# + , orWord32X4# + , orWord32X8# + , orWord64X2# + , orWord64X4# + , orWord64X8# + , orWord8X16# + , orWord8X32# + , orWord8X64# + , xorDoubleX2# + , xorDoubleX4# + , xorDoubleX8# + , xorFloatX16# + , xorFloatX4# + , xorFloatX8# + , xorInt16X16# + , xorInt16X32# + , xorInt16X8# + , xorInt32X16# + , xorInt32X4# + , xorInt32X8# + , xorInt64X2# + , xorInt64X4# + , xorInt64X8# + , xorInt8X16# + , xorInt8X32# + , xorInt8X64# + , xorWord16X16# + , xorWord16X32# + , xorWord16X8# + , xorWord32X16# + , xorWord32X4# + , xorWord32X8# + , xorWord64X2# + , xorWord64X4# + , xorWord64X8# + , xorWord8X16# + , xorWord8X32# + , xorWord8X64# ) import GHC.Prim.Ext ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -245,6 +245,97 @@ import GHC.Prim hiding , minWord8X16# , minWord8X32# , minWord8X64# + -- Don't re-export vector logical primops + , andDoubleX2# + , andDoubleX4# + , andDoubleX8# + , andFloatX16# + , andFloatX4# + , andFloatX8# + , andInt16X16# + , andInt16X32# + , andInt16X8# + , andInt32X16# + , andInt32X4# + , andInt32X8# + , andInt64X2# + , andInt64X4# + , andInt64X8# + , andInt8X16# + , andInt8X32# + , andInt8X64# + , andWord16X16# + , andWord16X32# + , andWord16X8# + , andWord32X16# + , andWord32X4# + , andWord32X8# + , andWord64X2# + , andWord64X4# + , andWord64X8# + , andWord8X16# + , andWord8X32# + , andWord8X64# + , orDoubleX2# + , orDoubleX4# + , orDoubleX8# + , orFloatX16# + , orFloatX4# + , orFloatX8# + , orInt16X16# + , orInt16X32# + , orInt16X8# + , orInt32X16# + , orInt32X4# + , orInt32X8# + , orInt64X2# + , orInt64X4# + , orInt64X8# + , orInt8X16# + , orInt8X32# + , orInt8X64# + , orWord16X16# + , orWord16X32# + , orWord16X8# + , orWord32X16# + , orWord32X4# + , orWord32X8# + , orWord64X2# + , orWord64X4# + , orWord64X8# + , orWord8X16# + , orWord8X32# + , orWord8X64# + , xorDoubleX2# + , xorDoubleX4# + , xorDoubleX8# + , xorFloatX16# + , xorFloatX4# + , xorFloatX8# + , xorInt16X16# + , xorInt16X32# + , xorInt16X8# + , xorInt32X16# + , xorInt32X4# + , xorInt32X8# + , xorInt64X2# + , xorInt64X4# + , xorInt64X8# + , xorInt8X16# + , xorInt8X32# + , xorInt8X64# + , xorWord16X16# + , xorWord16X32# + , xorWord16X8# + , xorWord32X16# + , xorWord32X4# + , xorWord32X8# + , xorWord64X2# + , xorWord64X4# + , xorWord64X8# + , xorWord8X16# + , xorWord8X32# + , xorWord8X64# ) import GHC.Prim.Ext ===================================== libraries/ghc-experimental/CHANGELOG.md ===================================== @@ -1,5 +1,10 @@ # Revision history for ghc-experimental +## 9.1601.0 + +- New and/or/xor SIMD primops for bitwise logical operations, such as andDoubleX4#, orWord32X4#, xorInt8X16#, etc. + These are supported by the LLVM backend and by the X86_64 NCG backend (for the latter, only for 128-wide vectors). + ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.14.0 + +- Shipped with GHC 9.16.1 + +- New and/or/xor SIMD primops for bitwise logical operations, such as andDoubleX4#, orWord32X4#, xorInt8X16#, etc. + These are supported by the LLVM backend and by the X86_64 NCG backend (for the latter, only for 128-wide vectors). + ## 0.13.1 - Shipped with GHC 9.14.1 ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -4747,10 +4747,40 @@ module GHC.PrimOps where addrToAny# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). Addr# -> (# a #) and# :: Word# -> Word# -> Word# and64# :: Word64# -> Word64# -> Word64# + andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + andDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + andDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + andFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + andFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# andI# :: Int# -> Int# -> Int# + andInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + andInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + andInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + andInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + andInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + andInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + andInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + andInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + andInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + andInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + andInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# andWord16# :: Word16# -> Word16# -> Word16# + andWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + andWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + andWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# andWord32# :: Word32# -> Word32# -> Word32# + andWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + andWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + andWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + andWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + andWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + andWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# andWord8# :: Word8# -> Word8# -> Word8# + andWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + andWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + andWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# annotateStack# :: forall {q :: RuntimeRep} b d (a :: TYPE q). b -> (State# d -> (# State# d, a #)) -> State# d -> (# State# d, a #) anyToAddr# :: forall a. a -> State# RealWorld -> (# State# RealWorld, Addr# #) asinDouble# :: Double# -> Double# @@ -5458,10 +5488,40 @@ module GHC.PrimOps where oneShot :: forall {q :: RuntimeRep} {r :: RuntimeRep} (a :: TYPE q) (b :: TYPE r). (a -> b) -> a -> b or# :: Word# -> Word# -> Word# or64# :: Word64# -> Word64# -> Word64# + orDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + orDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + orDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + orFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + orFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + orFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# orI# :: Int# -> Int# -> Int# + orInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + orInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + orInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + orInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + orInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + orInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + orInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + orInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + orInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + orInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + orInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + orInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# orWord16# :: Word16# -> Word16# -> Word16# + orWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + orWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + orWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# orWord32# :: Word32# -> Word32# -> Word32# + orWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + orWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + orWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + orWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + orWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + orWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# orWord8# :: Word8# -> Word8# -> Word8# + orWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + orWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + orWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# ord# :: Char# -> Int# packDoubleX2# :: (# Double#, Double# #) -> DoubleX2# packDoubleX4# :: (# Double#, Double#, Double#, Double# #) -> DoubleX4# @@ -6271,10 +6331,40 @@ module GHC.PrimOps where writeWordOffAddr# :: forall d. Addr# -> Int# -> Word# -> State# d -> State# d xor# :: Word# -> Word# -> Word# xor64# :: Word64# -> Word64# -> Word64# + xorDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + xorDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + xorDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + xorFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + xorFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + xorFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# xorI# :: Int# -> Int# -> Int# + xorInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + xorInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + xorInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + xorInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + xorInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + xorInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + xorInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + xorInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + xorInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + xorInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + xorInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + xorInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# xorWord16# :: Word16# -> Word16# -> Word16# + xorWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + xorWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + xorWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# xorWord32# :: Word32# -> Word32# -> Word32# + xorWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + xorWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + xorWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + xorWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + xorWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + xorWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# xorWord8# :: Word8# -> Word8# -> Word8# + xorWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + xorWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + xorWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# yield# :: State# RealWorld -> State# RealWorld type (~) :: forall k. k -> k -> Constraint class (a ~ b) => (~) a b ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -4747,10 +4747,40 @@ module GHC.PrimOps where addrToAny# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). Addr# -> (# a #) and# :: Word# -> Word# -> Word# and64# :: Word64# -> Word64# -> Word64# + andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + andDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + andDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + andFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + andFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# andI# :: Int# -> Int# -> Int# + andInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + andInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + andInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + andInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + andInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + andInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + andInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + andInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + andInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + andInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + andInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# andWord16# :: Word16# -> Word16# -> Word16# + andWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + andWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + andWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# andWord32# :: Word32# -> Word32# -> Word32# + andWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + andWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + andWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + andWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + andWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + andWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# andWord8# :: Word8# -> Word8# -> Word8# + andWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + andWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + andWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# annotateStack# :: forall {q :: RuntimeRep} b d (a :: TYPE q). b -> (State# d -> (# State# d, a #)) -> State# d -> (# State# d, a #) anyToAddr# :: forall a. a -> State# RealWorld -> (# State# RealWorld, Addr# #) asinDouble# :: Double# -> Double# @@ -5461,10 +5491,40 @@ module GHC.PrimOps where oneShot :: forall {q :: RuntimeRep} {r :: RuntimeRep} (a :: TYPE q) (b :: TYPE r). (a -> b) -> a -> b or# :: Word# -> Word# -> Word# or64# :: Word64# -> Word64# -> Word64# + orDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + orDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + orDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + orFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + orFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + orFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# orI# :: Int# -> Int# -> Int# + orInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + orInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + orInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + orInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + orInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + orInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + orInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + orInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + orInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + orInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + orInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + orInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# orWord16# :: Word16# -> Word16# -> Word16# + orWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + orWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + orWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# orWord32# :: Word32# -> Word32# -> Word32# + orWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + orWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + orWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + orWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + orWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + orWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# orWord8# :: Word8# -> Word8# -> Word8# + orWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + orWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + orWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# ord# :: Char# -> Int# packDoubleX2# :: (# Double#, Double# #) -> DoubleX2# packDoubleX4# :: (# Double#, Double#, Double#, Double# #) -> DoubleX4# @@ -6274,10 +6334,40 @@ module GHC.PrimOps where writeWordOffAddr# :: forall d. Addr# -> Int# -> Word# -> State# d -> State# d xor# :: Word# -> Word# -> Word# xor64# :: Word64# -> Word64# -> Word64# + xorDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + xorDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + xorDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + xorFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + xorFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + xorFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# xorI# :: Int# -> Int# -> Int# + xorInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + xorInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + xorInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + xorInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + xorInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + xorInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + xorInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + xorInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + xorInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + xorInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + xorInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + xorInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# xorWord16# :: Word16# -> Word16# -> Word16# + xorWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + xorWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + xorWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# xorWord32# :: Word32# -> Word32# -> Word32# + xorWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + xorWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + xorWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + xorWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + xorWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + xorWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# xorWord8# :: Word8# -> Word8# -> Word8# + xorWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + xorWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + xorWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# yield# :: State# RealWorld -> State# RealWorld type (~) :: forall k. k -> k -> Constraint class (a ~ b) => (~) a b ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -1423,10 +1423,40 @@ module GHC.Prim where addrToAny# :: forall {l :: GHC.Internal.Types.Levity} (a :: TYPE (GHC.Internal.Types.BoxedRep l)). Addr# -> (# a #) and# :: Word# -> Word# -> Word# and64# :: Word64# -> Word64# -> Word64# + andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + andDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + andDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + andFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + andFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# andI# :: Int# -> Int# -> Int# + andInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + andInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + andInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + andInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + andInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + andInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + andInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + andInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + andInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + andInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + andInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# andWord16# :: Word16# -> Word16# -> Word16# + andWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + andWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + andWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# andWord32# :: Word32# -> Word32# -> Word32# + andWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + andWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + andWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + andWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + andWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + andWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# andWord8# :: Word8# -> Word8# -> Word8# + andWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + andWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + andWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# annotateStack# :: forall {q :: GHC.Internal.Types.RuntimeRep} b d (a :: TYPE q). b -> (State# d -> (# State# d, a #)) -> State# d -> (# State# d, a #) anyToAddr# :: forall a. a -> State# RealWorld -> (# State# RealWorld, Addr# #) asinDouble# :: Double# -> Double# @@ -2111,10 +2141,40 @@ module GHC.Prim where numSparks# :: forall d. State# d -> (# State# d, Int# #) or# :: Word# -> Word# -> Word# or64# :: Word64# -> Word64# -> Word64# + orDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + orDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + orDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + orFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + orFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + orFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# orI# :: Int# -> Int# -> Int# + orInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + orInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + orInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + orInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + orInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + orInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + orInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + orInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + orInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + orInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + orInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + orInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# orWord16# :: Word16# -> Word16# -> Word16# + orWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + orWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + orWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# orWord32# :: Word32# -> Word32# -> Word32# + orWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + orWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + orWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + orWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + orWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + orWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# orWord8# :: Word8# -> Word8# -> Word8# + orWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + orWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + orWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# ord# :: Char# -> Int# packDoubleX2# :: (# Double#, Double# #) -> DoubleX2# packDoubleX4# :: (# Double#, Double#, Double#, Double# #) -> DoubleX4# @@ -2886,10 +2946,40 @@ module GHC.Prim where writeWordOffAddr# :: forall d. Addr# -> Int# -> Word# -> State# d -> State# d xor# :: Word# -> Word# -> Word# xor64# :: Word64# -> Word64# -> Word64# + xorDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + xorDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + xorDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + xorFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + xorFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + xorFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# xorI# :: Int# -> Int# -> Int# + xorInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + xorInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + xorInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + xorInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + xorInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + xorInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + xorInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + xorInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + xorInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + xorInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + xorInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + xorInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# xorWord16# :: Word16# -> Word16# -> Word16# + xorWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + xorWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + xorWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# xorWord32# :: Word32# -> Word32# -> Word32# + xorWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + xorWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + xorWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + xorWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + xorWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + xorWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# xorWord8# :: Word8# -> Word8# -> Word8# + xorWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + xorWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + xorWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# yield# :: State# RealWorld -> State# RealWorld module GHC.Prim.Exception where ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 ===================================== @@ -1423,10 +1423,40 @@ module GHC.Prim where addrToAny# :: forall {l :: GHC.Internal.Types.Levity} (a :: TYPE (GHC.Internal.Types.BoxedRep l)). Addr# -> (# a #) and# :: Word# -> Word# -> Word# and64# :: Word64# -> Word64# -> Word64# + andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + andDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + andDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + andFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + andFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# andI# :: Int# -> Int# -> Int# + andInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + andInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + andInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + andInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + andInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + andInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + andInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + andInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + andInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + andInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + andInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# andWord16# :: Word16# -> Word16# -> Word16# + andWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + andWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + andWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# andWord32# :: Word32# -> Word32# -> Word32# + andWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + andWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + andWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + andWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + andWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + andWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# andWord8# :: Word8# -> Word8# -> Word8# + andWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + andWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + andWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# annotateStack# :: forall {q :: GHC.Internal.Types.RuntimeRep} b d (a :: TYPE q). b -> (State# d -> (# State# d, a #)) -> State# d -> (# State# d, a #) anyToAddr# :: forall a. a -> State# RealWorld -> (# State# RealWorld, Addr# #) asinDouble# :: Double# -> Double# @@ -2111,10 +2141,40 @@ module GHC.Prim where numSparks# :: forall d. State# d -> (# State# d, Int# #) or# :: Word# -> Word# -> Word# or64# :: Word64# -> Word64# -> Word64# + orDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + orDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + orDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + orFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + orFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + orFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# orI# :: Int# -> Int# -> Int# + orInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + orInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + orInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + orInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + orInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + orInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + orInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + orInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + orInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + orInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + orInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + orInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# orWord16# :: Word16# -> Word16# -> Word16# + orWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + orWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + orWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# orWord32# :: Word32# -> Word32# -> Word32# + orWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + orWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + orWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + orWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + orWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + orWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# orWord8# :: Word8# -> Word8# -> Word8# + orWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + orWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + orWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# ord# :: Char# -> Int# packDoubleX2# :: (# Double#, Double# #) -> DoubleX2# packDoubleX4# :: (# Double#, Double#, Double#, Double# #) -> DoubleX4# @@ -2886,10 +2946,40 @@ module GHC.Prim where writeWordOffAddr# :: forall d. Addr# -> Int# -> Word# -> State# d -> State# d xor# :: Word# -> Word# -> Word# xor64# :: Word64# -> Word64# -> Word64# + xorDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# + xorDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4# + xorDoubleX8# :: DoubleX8# -> DoubleX8# -> DoubleX8# + xorFloatX16# :: FloatX16# -> FloatX16# -> FloatX16# + xorFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# + xorFloatX8# :: FloatX8# -> FloatX8# -> FloatX8# xorI# :: Int# -> Int# -> Int# + xorInt16X16# :: Int16X16# -> Int16X16# -> Int16X16# + xorInt16X32# :: Int16X32# -> Int16X32# -> Int16X32# + xorInt16X8# :: Int16X8# -> Int16X8# -> Int16X8# + xorInt32X16# :: Int32X16# -> Int32X16# -> Int32X16# + xorInt32X4# :: Int32X4# -> Int32X4# -> Int32X4# + xorInt32X8# :: Int32X8# -> Int32X8# -> Int32X8# + xorInt64X2# :: Int64X2# -> Int64X2# -> Int64X2# + xorInt64X4# :: Int64X4# -> Int64X4# -> Int64X4# + xorInt64X8# :: Int64X8# -> Int64X8# -> Int64X8# + xorInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# + xorInt8X32# :: Int8X32# -> Int8X32# -> Int8X32# + xorInt8X64# :: Int8X64# -> Int8X64# -> Int8X64# xorWord16# :: Word16# -> Word16# -> Word16# + xorWord16X16# :: Word16X16# -> Word16X16# -> Word16X16# + xorWord16X32# :: Word16X32# -> Word16X32# -> Word16X32# + xorWord16X8# :: Word16X8# -> Word16X8# -> Word16X8# xorWord32# :: Word32# -> Word32# -> Word32# + xorWord32X16# :: Word32X16# -> Word32X16# -> Word32X16# + xorWord32X4# :: Word32X4# -> Word32X4# -> Word32X4# + xorWord32X8# :: Word32X8# -> Word32X8# -> Word32X8# + xorWord64X2# :: Word64X2# -> Word64X2# -> Word64X2# + xorWord64X4# :: Word64X4# -> Word64X4# -> Word64X4# + xorWord64X8# :: Word64X8# -> Word64X8# -> Word64X8# xorWord8# :: Word8# -> Word8# -> Word8# + xorWord8X16# :: Word8X16# -> Word8X16# -> Word8X16# + xorWord8X32# :: Word8X32# -> Word8X32# -> Word8X32# + xorWord8X64# :: Word8X64# -> Word8X64# -> Word8X64# yield# :: State# RealWorld -> State# RealWorld module GHC.Prim.Exception where ===================================== testsuite/tests/simd/should_run/all.T ===================================== @@ -92,6 +92,15 @@ test('simd014', # of the XMM4 register, which may not be mapped to a real machine # register on non-x86 architectures. compile_and_run, ['simd014Cmm.cmm']) +test('simd015', + [ when(have_llvm(), extra_ways(["optllvm"])) ], + compile_and_run, ['']) +test('simd016', + [ when(have_llvm(), extra_ways(["optllvm"])) ], + compile_and_run, ['']) +test('simd017', + [ when(have_llvm(), extra_ways(["optllvm"])) ], + compile_and_run, ['']) test('simd_insert', [], compile_and_run, ['']) test('simd_insert_array', [], compile_and_run, ['']) ===================================== testsuite/tests/simd/should_run/simd015.hs ===================================== @@ -0,0 +1,45 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ExtendedLiterals #-} + +-- bitwise instructions on floating point vectors + +import GHC.Exts +import GHC.Int +import GHC.Prim + + +main :: IO () +main = do + putStrLn "DoubleX2#" + let + !d1 = packDoubleX2# (# 1.1##, 2.2## #) + !d2 = packDoubleX2# (# 0.0##, 2.2## #) + !d3 = packDoubleX2# (# -5.5##, 32.0## #) + !d4 = packDoubleX2# (# 5.5##, 128.0## #) + + case unpackDoubleX2# (andDoubleX2# d1 d2) of + (# a, b #) -> print (D# a, D# b) + case unpackDoubleX2# (andDoubleX2# d3 d4) of + (# c, d #) -> print (D# c, D# d) + case unpackDoubleX2# (orDoubleX2# d1 d2) of + (# a, b #) -> print (D# a, D# b) + case unpackDoubleX2# (orDoubleX2# d3 d4) of + (# c, d #) -> print (D# c, D# d) + case unpackDoubleX2# (xorDoubleX2# d1 d2) of + (# a, b #) -> print (D# a, D# b) + case unpackDoubleX2# (xorDoubleX2# d3 d4) of + (# c, d #) -> print (D# c, D# d) + + putStrLn "" + putStrLn "FloatX4#" + let + !f1 = packFloatX4# (# 1.1#, 2.2#, -5.5#, 128.0# #) + !f2 = packFloatX4# (# 0.0#, 2.2#, 5.5#, 32.0# #) + + case unpackFloatX4# (andFloatX4# f1 f2) of + (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d) + case unpackFloatX4# (orFloatX4# f1 f2) of + (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d) + case unpackFloatX4# (xorFloatX4# f1 f2) of + (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d) ===================================== testsuite/tests/simd/should_run/simd015.stdout ===================================== @@ -0,0 +1,12 @@ +DoubleX2# +(0.0,2.2) +(5.5,32.0) +(1.1,2.2) +(-5.5,128.0) +(1.1,0.0) +(-0.0,4.450147717014403e-308) + +FloatX4# +(0.0,2.2,5.5,32.0) +(1.1,2.2,-5.5,128.0) +(1.1,0.0,-0.0,2.3509887e-38) ===================================== testsuite/tests/simd/should_run/simd016.hs ===================================== @@ -0,0 +1,115 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ExtendedLiterals #-} + +-- bitwise instructions on signed integer vectors + +import GHC.Exts +import GHC.Int +import GHC.Prim + + +main :: IO () +main = do + putStrLn "Int64X2#" + let + !i64_1 = packInt64X2# (# 1#Int64, 2#Int64 #) + !i64_2 = packInt64X2# (# 0#Int64, 2#Int64 #) + !i64_3 = packInt64X2# (# -5#Int64, 128#Int64 #) + !i64_4 = packInt64X2# (# 5#Int64, 32#Int64 #) + + case unpackInt64X2# (andInt64X2# i64_1 i64_2) of + (# a, b #) -> print (I64# a, I64# b) + case unpackInt64X2# (andInt64X2# i64_3 i64_4) of + (# c, d #) -> print (I64# c, I64# d) + case unpackInt64X2# (orInt64X2# i64_1 i64_2) of + (# a, b #) -> print (I64# a, I64# b) + case unpackInt64X2# (orInt64X2# i64_3 i64_4) of + (# c, d #) -> print (I64# c, I64# d) + case unpackInt64X2# (xorInt64X2# i64_1 i64_2) of + (# a, b #) -> print (I64# a, I64# b) + case unpackInt64X2# (xorInt64X2# i64_3 i64_4) of + (# c, d #) -> print (I64# c, I64# d) + + putStrLn "" + putStrLn "Int32X4#" + let + !i32_1 = packInt32X4# (# 1#Int32, 2#Int32, -5#Int32, 128#Int32 #) + !i32_2 = packInt32X4# (# 0#Int32, 2#Int32, 5#Int32, 32#Int32 #) + + case unpackInt32X4# (andInt32X4# i32_1 i32_2) of + (# a, b, c, d #) -> print (I32# a, I32# b, I32# c, I32# d) + case unpackInt32X4# (orInt32X4# i32_1 i32_2) of + (# a, b, c, d #) -> print (I32# a, I32# b, I32# c, I32# d) + case unpackInt32X4# (xorInt32X4# i32_1 i32_2) of + (# a, b, c, d #) -> print (I32# a, I32# b, I32# c, I32# d) + + putStrLn "" + putStrLn "Int16X8#" + let + !i16_1 = packInt16X8# + (# 1#Int16, 2#Int16, -5#Int16, 128#Int16 + , 1#Int16, 2#Int16, -5#Int16, 128#Int16 + #) + !i16_2 = packInt16X8# + (# 0#Int16, 2#Int16, 5#Int16, 32#Int16 + , 0#Int16, 2#Int16, 5#Int16, 32#Int16 + #) + case unpackInt16X8# (andInt16X8# i16_1 i16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (I16# a, I16# b, I16# c, I16# d) + , (I16# e, I16# f, I16# g, I16# h) + ) + case unpackInt16X8# (orInt16X8# i16_1 i16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (I16# a, I16# b, I16# c, I16# d) + , (I16# e, I16# f, I16# g, I16# h) + ) + case unpackInt16X8# (xorInt16X8# i16_1 i16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (I16# a, I16# b, I16# c, I16# d) + , (I16# e, I16# f, I16# g, I16# h) + ) + + putStrLn "" + putStrLn "Int8X16#" + let + !i8_1 = packInt8X16# + (# 1#Int8, 2#Int8, -5#Int8, 128#Int8 + , 1#Int8, 2#Int8, -5#Int8, 128#Int8 + , 1#Int8, 2#Int8, -5#Int8, 128#Int8 + , 1#Int8, 2#Int8, -5#Int8, 128#Int8 + #) + !i8_2 = packInt8X16# + (# 0#Int8, 2#Int8, 5#Int8, 32#Int8 + , 0#Int8, 2#Int8, 5#Int8, 32#Int8 + , 0#Int8, 2#Int8, 5#Int8, 32#Int8 + , 0#Int8, 2#Int8, 5#Int8, 32#Int8 + #) + case unpackInt8X16# (andInt8X16# i8_1 i8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (I8# a, I8# b, I8# c, I8# d) + , (I8# e, I8# f, I8# g, I8# h) + , (I8# i, I8# j, I8# k, I8# l) + , (I8# m, I8# n, I8# o, I8# p) + ) + case unpackInt8X16# (orInt8X16# i8_1 i8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (I8# a, I8# b, I8# c, I8# d) + , (I8# e, I8# f, I8# g, I8# h) + , (I8# i, I8# j, I8# k, I8# l) + , (I8# m, I8# n, I8# o, I8# p) + ) + case unpackInt8X16# (xorInt8X16# i8_1 i8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (I8# a, I8# b, I8# c, I8# d) + , (I8# e, I8# f, I8# g, I8# h) + , (I8# i, I8# j, I8# k, I8# l) + , (I8# m, I8# n, I8# o, I8# p) + ) ===================================== testsuite/tests/simd/should_run/simd016.stdout ===================================== @@ -0,0 +1,22 @@ +Int64X2# +(0,2) +(1,0) +(1,2) +(-1,160) +(1,0) +(-2,160) + +Int32X4# +(0,2,1,0) +(1,2,-1,160) +(1,0,-2,160) + +Int16X8# +((0,2,1,0),(0,2,1,0)) +((1,2,-1,160),(1,2,-1,160)) +((1,0,-2,160),(1,0,-2,160)) + +Int8X16# +((0,2,1,0),(0,2,1,0),(0,2,1,0),(0,2,1,0)) +((1,2,-1,-96),(1,2,-1,-96),(1,2,-1,-96),(1,2,-1,-96)) +((1,0,-2,-96),(1,0,-2,-96),(1,0,-2,-96),(1,0,-2,-96)) ===================================== testsuite/tests/simd/should_run/simd017.hs ===================================== @@ -0,0 +1,115 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ExtendedLiterals #-} + +-- bitwise instructions on unsigned integer vectors + +import GHC.Exts +import GHC.Word +import GHC.Prim + + +main :: IO () +main = do + putStrLn "Word64X2#" + let + !w64_1 = packWord64X2# (# 1#Word64, 2#Word64 #) + !w64_2 = packWord64X2# (# 0#Word64, 2#Word64 #) + !w64_3 = packWord64X2# (# 18446744073709551615#Word64, 128#Word64 #) + !w64_4 = packWord64X2# (# 5#Word64, 32#Word64 #) + + case unpackWord64X2# (andWord64X2# w64_1 w64_2) of + (# a, b #) -> print (W64# a, W64# b) + case unpackWord64X2# (andWord64X2# w64_3 w64_4) of + (# c, d #) -> print (W64# c, W64# d) + case unpackWord64X2# (orWord64X2# w64_1 w64_2) of + (# a, b #) -> print (W64# a, W64# b) + case unpackWord64X2# (orWord64X2# w64_3 w64_4) of + (# c, d #) -> print (W64# c, W64# d) + case unpackWord64X2# (xorWord64X2# w64_1 w64_2) of + (# a, b #) -> print (W64# a, W64# b) + case unpackWord64X2# (xorWord64X2# w64_3 w64_4) of + (# c, d #) -> print (W64# c, W64# d) + + putStrLn "" + putStrLn "Word32X4#" + let + !w32_1 = packWord32X4# (# 1#Word32, 2#Word32, 4294967295#Word32, 128#Word32 #) + !w32_2 = packWord32X4# (# 0#Word32, 2#Word32, 5#Word32, 32#Word32 #) + + case unpackWord32X4# (andWord32X4# w32_1 w32_2) of + (# a, b, c, d #) -> print (W32# a, W32# b, W32# c, W32# d) + case unpackWord32X4# (orWord32X4# w32_1 w32_2) of + (# a, b, c, d #) -> print (W32# a, W32# b, W32# c, W32# d) + case unpackWord32X4# (xorWord32X4# w32_1 w32_2) of + (# a, b, c, d #) -> print (W32# a, W32# b, W32# c, W32# d) + + putStrLn "" + putStrLn "Word16X8#" + let + !w16_1 = packWord16X8# + (# 1#Word16, 2#Word16, 65535#Word16, 128#Word16 + , 1#Word16, 2#Word16, 65535#Word16, 128#Word16 + #) + !w16_2 = packWord16X8# + (# 0#Word16, 2#Word16, 5#Word16, 32#Word16 + , 0#Word16, 2#Word16, 5#Word16, 32#Word16 + #) + case unpackWord16X8# (andWord16X8# w16_1 w16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (W16# a, W16# b, W16# c, W16# d) + , (W16# e, W16# f, W16# g, W16# h) + ) + case unpackWord16X8# (orWord16X8# w16_1 w16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (W16# a, W16# b, W16# c, W16# d) + , (W16# e, W16# f, W16# g, W16# h) + ) + case unpackWord16X8# (xorWord16X8# w16_1 w16_2) of + (# a, b, c, d, e, f, g, h #) -> + print + ( (W16# a, W16# b, W16# c, W16# d) + , (W16# e, W16# f, W16# g, W16# h) + ) + + putStrLn "" + putStrLn "Word8X16#" + let + !w8_1 = packWord8X16# + (# 1#Word8, 2#Word8, 255#Word8, 128#Word8 + , 1#Word8, 2#Word8, 255#Word8, 128#Word8 + , 1#Word8, 2#Word8, 255#Word8, 128#Word8 + , 1#Word8, 2#Word8, 255#Word8, 128#Word8 + #) + !w8_2 = packWord8X16# + (# 0#Word8, 2#Word8, 5#Word8, 32#Word8 + , 0#Word8, 2#Word8, 5#Word8, 32#Word8 + , 0#Word8, 2#Word8, 5#Word8, 32#Word8 + , 0#Word8, 2#Word8, 5#Word8, 32#Word8 + #) + case unpackWord8X16# (andWord8X16# w8_1 w8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (W8# a, W8# b, W8# c, W8# d) + , (W8# e, W8# f, W8# g, W8# h) + , (W8# i, W8# j, W8# k, W8# l) + , (W8# m, W8# n, W8# o, W8# p) + ) + case unpackWord8X16# (orWord8X16# w8_1 w8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (W8# a, W8# b, W8# c, W8# d) + , (W8# e, W8# f, W8# g, W8# h) + , (W8# i, W8# j, W8# k, W8# l) + , (W8# m, W8# n, W8# o, W8# p) + ) + case unpackWord8X16# (xorWord8X16# w8_1 w8_2) of + (# a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p #) -> + print + ( (W8# a, W8# b, W8# c, W8# d) + , (W8# e, W8# f, W8# g, W8# h) + , (W8# i, W8# j, W8# k, W8# l) + , (W8# m, W8# n, W8# o, W8# p) + ) ===================================== testsuite/tests/simd/should_run/simd017.stdout ===================================== @@ -0,0 +1,22 @@ +Word64X2# +(0,2) +(5,0) +(1,2) +(18446744073709551615,160) +(1,0) +(18446744073709551610,160) + +Word32X4# +(0,2,5,0) +(1,2,4294967295,160) +(1,0,4294967290,160) + +Word16X8# +((0,2,5,0),(0,2,5,0)) +((1,2,65535,160),(1,2,65535,160)) +((1,0,65530,160),(1,0,65530,160)) + +Word8X16# +((0,2,5,0),(0,2,5,0),(0,2,5,0),(0,2,5,0)) +((1,2,255,160),(1,2,255,160),(1,2,255,160),(1,2,255,160)) +((1,0,250,160),(1,0,250,160),(1,0,250,160),(1,0,250,160)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ef22fa0ba7c0a9284176e40fdc3135… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ef22fa0ba7c0a9284176e40fdc3135… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/reexport-ghc-hs-basic] Re-export GHC.Hs.Basic from GHC.Hs
by Vladislav Zavialov (＠int-index) 27 Oct '25

27 Oct '25

Vladislav Zavialov pushed to branch wip/int-index/reexport-ghc-hs-basic at Glasgow Haskell Compiler / GHC Commits: 51223e7c by Vladislav Zavialov at 2025-10-26T22:54:07+03:00 Re-export GHC.Hs.Basic from GHC.Hs Clean up some import sections in GHC by re-exporting GHC.Hs.Basic from GHC.Hs. - - - - - 26 changed files: - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs.hs ===================================== @@ -22,6 +22,7 @@ therefore, is almost nothing but re-exporting. module GHC.Hs ( module Language.Haskell.Syntax, + module GHC.Hs.Basic, module GHC.Hs.Binds, module GHC.Hs.Decls, module GHC.Hs.Expr, @@ -33,7 +34,6 @@ module GHC.Hs ( module GHC.Hs.Doc, module GHC.Hs.Extension, module GHC.Parser.Annotation, - Fixity, HsModule(..), AnnsModule(..), HsParsedModule(..), XModulePs(..) @@ -42,6 +42,7 @@ module GHC.Hs ( -- friends: import GHC.Prelude +import GHC.Hs.Basic import GHC.Hs.Decls import GHC.Hs.Binds import GHC.Hs.Expr @@ -58,7 +59,6 @@ import GHC.Hs.Instances () -- For Data instances -- others: import GHC.Utils.Outputable -import GHC.Types.Fixity ( Fixity ) import GHC.Types.SrcLoc import GHC.Unit.Module.Warnings ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -121,11 +121,11 @@ import GHC.Hs.Doc import GHC.Types.Basic import GHC.Core.Coercion +import GHC.Hs.Basic import GHC.Hs.Extension import GHC.Parser.Annotation import GHC.Types.Name import GHC.Types.Name.Set -import GHC.Types.Fixity -- others: import GHC.Utils.Misc (count) ===================================== compiler/GHC/HsToCore/Foreign/Wasm.hs ===================================== @@ -45,7 +45,6 @@ import GHC.Types.Var import GHC.Unit import GHC.Utils.Outputable import GHC.Utils.Panic -import Language.Haskell.Syntax.Basic data Synchronicity = Sync | Async deriving (Eq) ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -79,7 +79,6 @@ import GHC.Types.ForeignCall import GHC.Types.Var import GHC.Types.Id import GHC.Types.SourceText -import GHC.Types.Fixity import GHC.Types.TyThing import GHC.Types.Name hiding( varName, tcName ) import GHC.Types.Name.Env @@ -89,8 +88,6 @@ import Data.Kind (Constraint) import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Data.ByteString ( unpack ) import Control.Monad import Data.List (sort, sortBy) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -45,8 +45,6 @@ module GHC.HsToCore.Utils ( import GHC.Prelude -import Language.Haskell.Syntax.Basic (Boxity(..)) - import {-# SOURCE #-} GHC.HsToCore.Match ( matchSimply ) import {-# SOURCE #-} GHC.HsToCore.Expr ( dsLExpr, dsSyntaxExpr ) ===================================== compiler/GHC/Parser/Errors/Types.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Parser.Errors.Types where import GHC.Prelude -import GHC.Core.TyCon (Role) import GHC.Data.FastString import GHC.Hs import GHC.Parser.Types ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -134,7 +134,7 @@ import GHC.Hs -- Lots of it import GHC.Core.TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe ) import GHC.Core.DataCon ( DataCon, dataConTyCon, dataConName ) import GHC.Core.ConLike ( ConLike(..) ) -import GHC.Core.Coercion.Axiom ( Role, fsFromRole ) +import GHC.Core.Coercion.Axiom ( fsFromRole ) import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.Basic @@ -170,8 +170,6 @@ import GHC.Unit.Module.Warnings import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad import Text.ParserCombinators.ReadP as ReadP import Data.Char ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -77,8 +77,6 @@ import GHC.Utils.Panic import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad import Data.List ( partition ) import Data.List.NonEmpty ( NonEmpty(..) ) ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -62,8 +62,6 @@ module GHC.Rename.Env ( import GHC.Prelude -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import GHC.Iface.Load import GHC.Iface.Env import GHC.Hs ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -75,8 +75,6 @@ import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad import qualified Data.Foldable as Partial (maximum) import Data.List (unzip4) ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -74,16 +74,13 @@ import GHC.Types.FieldLabel import GHC.Types.Error import GHC.Utils.Misc -import GHC.Types.Fixity ( compareFixity, negateFixity - , Fixity(..), FixityDirection(..), LexicalFixity(..) ) +import GHC.Types.Fixity ( compareFixity, negateFixity ) import GHC.Types.Basic ( TypeOrKind(..) ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Data.List (nubBy, partition) import Control.Monad ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -65,7 +65,6 @@ import GHC.Rename.HsType import GHC.Builtin.Names import GHC.Types.Hint -import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -53,7 +53,6 @@ import GHC.Tc.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Core.DataCon import GHC.Types.SrcLoc as SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceText ( SourceText(..), IntegralLit ) ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -91,8 +91,6 @@ import GHC.Data.Bag import GHC.Data.Maybe ( expectJust ) import GHC.Unit.Module -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Data.List ( find, partition, intersperse ) -- | A declarative description of an auxiliary binding that should be ===================================== compiler/GHC/Tc/Deriv/Generics.hs ===================================== @@ -44,7 +44,6 @@ import GHC.Iface.Env ( newGlobalBinder ) import GHC.Types.Name hiding ( varName ) import GHC.Types.Name.Reader -import GHC.Types.Fixity import GHC.Types.Basic import GHC.Types.SrcLoc import GHC.Types.Var.Env @@ -62,8 +61,6 @@ import GHC.Utils.Misc import GHC.Driver.DynFlags import GHC.Data.FastString -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad (mplus) import Data.List (zip4, partition) import Data.List.NonEmpty (NonEmpty (..), last, nonEmpty) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -231,7 +231,7 @@ import GHC.Core.FamInstEnv (FamInst) import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst, DFunId) import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) -import GHC.Core.TyCon (TyCon, Role, FamTyConFlav, AlgTyConRhs) +import GHC.Core.TyCon (TyCon, FamTyConFlav, AlgTyConRhs) import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag, ForAllTyBinder) import GHC.Driver.Backend (Backend) @@ -245,8 +245,6 @@ import GHC.Data.FastString (FastString) import GHC.Data.Pair import GHC.Exception.Type (SomeException) -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Typeable (Typeable) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -65,7 +65,6 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic( isBoxed ) import Control.Monad import Data.Function ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -27,8 +27,6 @@ module GHC.Tc.Gen.Expr import GHC.Prelude -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import {-# SOURCE #-} GHC.Tc.Gen.Splice ( tcTypedSplice, tcTypedBracket, tcUntypedBracket, getUntypedSpliceBody ) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Core.ConLike import GHC.Builtin.Names -import GHC.Types.Basic hiding (SuccessFlag(..)) import GHC.Driver.DynFlags import GHC.Types.SrcLoc import GHC.Types.Var.Set @@ -73,7 +72,6 @@ import GHC.Data.FastString import qualified Data.List.NonEmpty as NE import GHC.Data.List.SetOps ( getNth ) -import Language.Haskell.Syntax.Basic (FieldLabelString(..), LexicalFixity(..)) import Data.List( partition ) import Control.Monad.Trans.Writer.CPS ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -105,8 +105,6 @@ import GHC.Utils.Panic import GHC.Utils.Constants (debugIsOn) import GHC.Utils.Misc -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad import Data.Foldable ( toList, traverse_ ) import Data.Functor.Identity ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Types.Var as Var import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Basic -import GHC.Types.Fixity import GHC.Types.Id import GHC.Types.SourceFile import GHC.Types.SourceText ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -77,8 +77,6 @@ import GHC.Types.Unique.Set import GHC.Types.TyThing import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad {- ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -85,8 +85,6 @@ import GHC.Utils.Misc( HasDebugCallStack, nTimes ) import GHC.Types.Unique import GHC.Types.Unique.Supply -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import qualified Data.Kind as Hs import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isNothing) ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -81,8 +81,6 @@ import GHC.Utils.Panic import GHC.Data.List.SetOps -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad import Data.Foldable import Data.Function ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -40,7 +40,6 @@ import qualified GHC.Core.Coercion as Coercion ( Role(..) ) import GHC.Builtin.Types import GHC.Builtin.Types.Prim( fUNTyCon ) import GHC.Types.Basic as Hs -import GHC.Types.Fixity as Hs import GHC.Types.ForeignCall import GHC.Types.Unique import GHC.Types.SourceText @@ -53,8 +52,6 @@ import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet import qualified GHC.LanguageExtensions as LangExt -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import qualified Data.ByteString as BS import Control.Monad( unless ) import Data.Bifunctor (first) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -35,13 +35,11 @@ module ExactPrint import GHC import GHC.Base (NonEmpty(..)) -import GHC.Core.Coercion.Axiom (Role(..)) import qualified GHC.Data.BooleanFormula as BF import GHC.Data.FastString import qualified GHC.Data.Strict as Strict import GHC.TypeLits import GHC.Types.Basic hiding (EP) -import GHC.Types.Fixity import GHC.Types.ForeignCall import GHC.Types.Name.Reader import GHC.Types.PkgQual @@ -53,8 +51,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - import Control.Monad (forM, when, unless) import Control.Monad.Identity (Identity(..)) import qualified Control.Monad.Reader as Reader View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51223e7ce07e4d25d7ac02603b275cd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51223e7ce07e4d25d7ac02603b275cd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ani/kill-popErrCtxt] wibbles
by Apoorv Ingle (＠ani) 27 Oct '25

27 Oct '25

Apoorv Ingle pushed to branch wip/ani/kill-popErrCtxt at Glasgow Haskell Compiler / GHC Commits: 436d9f72 by Apoorv Ingle at 2025-10-26T14:00:30-05:00 wibbles - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/LclEnv.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -681,6 +681,7 @@ data SrcCodeOrigin -- Does not presist post renaming phase -- See Part 3. of Note [Expanding HsDo with XXExprGhcRn] -- in `GHC.Tc.Gen.Do` + -- INVARIANT: SHOULD NEVER APPEAR IN A ExpansionCodeCtxt in CodeSrcFlag ErrCtxt on stack data XXExprGhcRn = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Tc.Gen.HsType import GHC.Tc.Utils.Concrete ( unifyConcrete, idConcreteTvs ) import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence -import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..), ErrCtxt (..) ) +import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..), ErrCtxt (..), CodeSrcFlag (..)) import GHC.Tc.Errors.Ppr (pprErrCtxtMsg) import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType @@ -951,28 +951,23 @@ addArgCtxt arg_no fun (L arg_loc arg) thing_inside , text "arg: " <+> ppr (arg, arg_no) , text "arg_loc:" <+> ppr arg_loc , text "fun:" <+> ppr fun - -- , text "err_ctx" <+> vcat (fmap (\ (x, y) -> case x of - -- UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y - -- ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y) - -- (take 4 (zip err_ctx err_ctx_msg))) + , text "err_ctx" <+> vcat (fmap (\ (x, y) -> case x of + MkErrCtxt (ExpansionCodeCtxt{}) _ -> text "<EXPN>" <+> pprErrCtxtMsg y + _ -> text "<USER>" <+> pprErrCtxtMsg y) + (take 4 (zip err_ctx err_ctx_msg))) ]) ; if in_generated_code - then updCtxtForArg (locA arg_loc) arg $ + then updCtxtForArg (L arg_loc arg) $ thing_inside else do setSrcSpanA arg_loc $ addErrCtxt (FunAppCtxt (FunAppCtxtExpr fun arg) arg_no) $ thing_inside } where - updCtxtForArg :: SrcSpan -> HsExpr GhcRn -> TcRn a -> TcRn a - updCtxtForArg l@(RealSrcSpan{}) e thing_inside = -- See 2.iii above - do setSrcSpan l $ - addExprCtxt e $ - thing_inside - -- updCtxtForArg (UnhelpfulSpan UnhelpfulGenerated) _ thing_inside = -- See 2.i above - -- thing_inside - updCtxtForArg (UnhelpfulSpan {}) _ thing_inside = -- See 2.ii above - do -- setInUserCode $ - thing_inside + updCtxtForArg :: LHsExpr GhcRn -> TcRn a -> TcRn a + updCtxtForArg e@(L lspan _) thing_inside + = do setSrcSpan (locA lspan) $ + addLExprCtxt e $ -- addLExpr is no op for non-user located exprs + thing_inside ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -126,7 +126,7 @@ expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) -- e ; stmts ~~> (>>) e stmts' do expand_stmts_expr <- expand_do_stmts doFlavour lstmts let expansion = genHsExpApps then_op -- (>>) - [ e -- Span is set because of statement loc + [ e , expand_stmts_expr ] return $ L loc (mkExpandedStmt stmt doFlavour expansion) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -54,7 +54,6 @@ import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic, hasFixedRuntimeRep import GHC.Tc.Utils.Instantiate import GHC.Tc.Utils.Env import GHC.Tc.Types.Origin -import GHC.Tc.Types.ErrCtxt ( srcCodeOriginErrCtxMsg ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types hiding (HoleError) @@ -125,7 +124,7 @@ tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType tcPolyLExpr (L loc expr) res_ty = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] do { expr' <- tcPolyExpr expr res_ty ; return (L loc expr') } @@ -244,7 +243,7 @@ tcInferRhoNC = tcInferExprNC IIF_DeepRho tcInferExpr, tcInferExprNC :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) tcInferExpr iif (L loc expr) = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] do { (expr', rho) <- runInfer iif IFRR_Any (tcExpr expr) ; return (L loc expr', rho) } @@ -271,7 +270,7 @@ tcMonoLExpr, tcMonoLExprNC tcMonoLExpr (L loc expr) res_ty = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addLExprCtxt (L loc expr) $ -- Note [Error contexts in generated code] do { expr' <- tcExpr expr res_ty ; return (L loc expr') } @@ -757,11 +756,8 @@ tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty) tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcXExpr (ExpandedThingRn o e) res_ty - = addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ - -- e is the expanded expression of o, so we need to set the error ctxt to generated - -- see Note [Error Context Stack] in `GHC.Tc.Type.LclEnv` - mkExpandedTc o <$> -- necessary for hpc ticks - tcExpr e res_ty + = mkExpandedTc o <$> -- necessary for hpc ticks + tcExpr e res_ty -- For record selection, same as HsVar case tcXExpr xe res_ty = tcApp (XExpr xe) res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -26,7 +26,7 @@ module GHC.Tc.Gen.Head , nonBidirectionalErr , pprArgInst - , addExprCtxt, addFunResCtxt ) where + , addExprCtxt, addLExprCtxt, addFunResCtxt ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig ) import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody ) @@ -1108,6 +1108,29 @@ addExprCtxt e thing_inside -- f x = _ -- when we don't want to say "In the expression: _", -- because it is mentioned in the error message itself - XExpr{} -> thing_inside -- the err ctxt management done is done by setInGeneratedCode - HsPar{} -> thing_inside -- the err ctxt management done is done by setInGeneratedCode + HsPar{} -> thing_inside -- We don't want to say 'In the expression (e)', we just want to say 'In the expression, 'e'. which will be handeled by the recursive call in thing_inside + XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) thing_inside _ -> addErrCtxt (ExprCtxt e) thing_inside -- no op in generated code + + +addLExprCtxt :: LHsExpr GhcRn -> TcRn a -> TcRn a +addLExprCtxt (L lspan e) thing_inside + | (RealSrcSpan{}) <- locA lspan + = case e of + HsHole _ + -- The HsHole special case addresses situations like + -- f x = _ + -- when we don't want to say "In the expression: _", + -- because it is mentioned in the error message itself + -> thing_inside + HsPar{} + -- We don't want to say 'In the expression (e)', + -- we just want to say 'In the expression, 'e'. + -- which will be adeed by the recursive call in thing_inside + -> thing_inside + XExpr (ExpandedThingRn o _) + -> addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) thing_inside + _ + -> addErrCtxt (ExprCtxt e) thing_inside -- no op in generated code + | otherwise + = thing_inside ===================================== compiler/GHC/Tc/Types/ErrCtxt.hs ===================================== @@ -63,6 +63,7 @@ data ErrCtxt = MkErrCtxt CodeSrcFlag ErrCtxtMsgM data CodeSrcFlag = VanillaUserSrcCode | LandmarkUserSrcCode | ExpansionCodeCtxt SrcCodeOrigin + -- INVARIANT: SHOULD NEVER APPEAR IN A ExpansionCodeCtxt in CodeSrcFlag ErrCtxt on stack -------------------------------------------------------------------------------- -- Error message contexts ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -196,10 +196,7 @@ setLclEnvErrCtxt :: ErrCtxtStack -> TcLclEnv -> TcLclEnv setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_err_ctxt = ctxt }) addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv -addLclEnvErrCtxt ec@(MkErrCtxt (ExpansionCodeCtxt _) _) = setLclEnvSrcCodeOrigin ec -addLclEnvErrCtxt ec = modifyLclCtxt (\env -> if lclCtxtInGeneratedCode env - then env -- no op if we are in generated code - else env { tcl_err_ctxt = ec : (tcl_err_ctxt env) }) +addLclEnvErrCtxt ec = setLclEnvSrcCodeOrigin ec getLclEnvSrcCodeOrigin :: TcLclEnv -> Maybe SrcCodeOrigin getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_err_ctxt . tcl_lcl_ctxt View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/436d9f72a594aefd81f4be102916777… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/436d9f72a594aefd81f4be102916777… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/wasm-dyld-pie] wasm: support running dyld fully client side in browser
by Cheng Shao (＠TerrorJack) 27 Oct '25

27 Oct '25

Cheng Shao pushed to branch wip/wasm-dyld-pie at Glasgow Haskell Compiler / GHC Commits: 3d7985e3 by Cheng Shao at 2025-10-26T17:53:34+01:00 wasm: support running dyld fully client side in browser - - - - - 1 changed file: - utils/jsffi/dyld.mjs Changes: ===================================== utils/jsffi/dyld.mjs ===================================== @@ -285,7 +285,7 @@ function originFromServerAddress({ address, family, port }) { } // Browser/node portable code stays above this watermark. -const isNode = Boolean(globalThis?.process?.versions?.node); +const isNode = Boolean(globalThis?.process?.versions?.node && !globalThis.Deno); // Too cumbersome to only import at use sites. Too troublesome to // factor out browser-only/node-only logic into different modules. For @@ -307,18 +307,22 @@ if (isNode) { ws = require("ws"); } catch {} } else { - wasi = await import( - "https://cdn.jsdelivr.net/npm/@bjorn3/browser_wasi_shim@0.4.2/dist/index.js" - ); + wasi = await import("https://esm.sh/gh/haskell-wasm/browser_wasi_shim"); } // A subset of dyld logic that can only be run in the host node // process and has full access to local filesystem -class DyLDHost { +export class DyLDHost { // Deduped absolute paths of directories where we lookup .so files #rpaths = new Set(); constructor({ out_fd, in_fd }) { + // When running a non-iserv shared library with node, the DyLDHost + // instance is created without a pair of fds, so skip creation of + // readStream/writeStream, they won't be used anyway + if (!(typeof out_fd === "number" && typeof in_fd === "number")) { + return; + } this.readStream = stream.Readable.toWeb( fs.createReadStream(undefined, { fd: in_fd }) ); @@ -373,6 +377,75 @@ class DyLDHost { } } +// Runs in the browser and uses the in-memory vfs, doesn't do any RPC +// calls +export class DyLDBrowserHost { + // Deduped absolute paths of directories where we lookup .so files + #rpaths = new Set(); + // The PreopenDirectory object of the root filesystem + rootfs; + + // Given canonicalized absolute file path, returns the File object, + // or null if absent + #readFile(p) { + const { ret, entry } = this.rootfs.dir.get_entry_for_path({ + parts: p.split("/").filter((tok) => tok !== ""), + is_dir: false, + }); + return ret === 0 ? entry : null; + } + + constructor({ rootfs }) { + this.rootfs = rootfs; + } + + close() {} + + // p must be canonicalized absolute path + async addLibrarySearchPath(p) { + this.#rpaths.add(p); + return null; + } + + async findSystemLibrary(f) { + if (f.startsWith("/")) { + if (this.#readFile(f)) { + return f; + } + throw new Error(`findSystemLibrary(${f}): not found in /`); + } + + for (const rpath of this.#rpaths) { + const r = `${rpath}/${f}`; + if (this.#readFile(r)) { + return r; + } + } + + throw new Error( + `findSystemLibrary(${f}): not found in ${[...this.#rpaths]}` + ); + } + + async fetchWasm(p) { + const entry = this.#readFile(p); + const r = new Response(entry.data, { + headers: { "Content-Type": "application/wasm" }, + }); + // It's only fetched once, take the chance to prune it in vfs to save memory + entry.data = new Uint8Array(); + return r; + } + + stdout(msg) { + console.info(msg); + } + + stderr(msg) { + console.warn(msg); + } +} + // Fulfill the same functionality as DyLDHost by doing fetch() calls // to respective RPC endpoints of a host http server. Also manages // WebSocket connections back to host. @@ -540,7 +613,7 @@ class DyLDRPCServer { res.end( ` import { DyLDRPC, main } from "./fs${dyldPath}"; -const args = ${JSON.stringify({ libdir, ghciSoPath, args })}; +const args = ${JSON.stringify({ libdirs: [libdir], ghciSoPath, args })}; args.rpc = new DyLDRPC({origin: "${origin}", redirectWasiConsole: ${redirectWasiConsole}}); args.rpc.opened.then(() => main(args)); ` @@ -832,6 +905,10 @@ class DyLD { ], { debug: false } ); + + if (this.#rpc instanceof DyLDBrowserHost) { + this.#wasi.fds[3] = this.#rpc.rootfs; + } } // Both wasi implementations we use provide @@ -1218,15 +1295,39 @@ class DyLD { } } -export async function main({ rpc, libdir, ghciSoPath, args }) { +// The main entry point of dyld that may be run on node/browser, and +// may run either iserv defaultMain from the ghci library or an +// alternative entry point from another shared library +export async function main({ + rpc, // Handle the side effects of DyLD + libdirs, // Initial library search directories + ghciSoPath, // Could also be another shared library that's actually not ghci + args, // WASI argv without the executable name. +RTS etc will be respected + altEntry, // Optional alternative entry point function name + altArgs, // Argument array to pass to the alternative entry point function +}) { try { const dyld = new DyLD({ args: ["dyld.so", ...args], rpc, }); - await dyld.addLibrarySearchPath(libdir); + for (const libdir of libdirs) { + await dyld.addLibrarySearchPath(libdir); + } await dyld.loadDLLs(ghciSoPath); + // At this point, rts/ghc-internal are loaded, perform wasm shared + // library specific RTS startup logic, see Note [JSFFI + // initialization] + dyld.exportFuncs.__ghc_wasm_jsffi_init(); + + // We're not running iserv, just invoke user-specified alternative + // entry point and pass the arguments + if (altEntry) { + return await dyld.exportFuncs[altEntry](...altArgs); + } + + // iserv-specific logic follows const reader = rpc.readStream.getReader(); const writer = rpc.writeStream.getWriter(); @@ -1245,19 +1346,19 @@ export async function main({ rpc, libdir, ghciSoPath, args }) { writer.write(new Uint8Array(buf)); }; - dyld.exportFuncs.__ghc_wasm_jsffi_init(); - await dyld.exportFuncs.defaultServer(cb_sig, cb_recv, cb_send); + return await dyld.exportFuncs.defaultServer(cb_sig, cb_recv, cb_send); } finally { rpc.close(); } } -export async function nodeMain({ libdir, ghciSoPath, out_fd, in_fd, args }) { +// node-specific iserv-specific logic +async function nodeMain({ libdir, ghciSoPath, out_fd, in_fd, args }) { if (!process.env.GHCI_BROWSER) { const rpc = new DyLDHost({ out_fd, in_fd }); await main({ rpc, - libdir, + libdirs: [libdir], ghciSoPath, args, }); @@ -1370,15 +1471,11 @@ export async function nodeMain({ libdir, ghciSoPath, out_fd, in_fd, args }) { ); } -function isNodeMain() { - if (!globalThis?.process?.versions?.node) { - return false; - } - - return import.meta.filename === process.argv[1]; -} +const isNodeMain = isNode && import.meta.filename === process.argv[1]; -if (isNodeMain()) { +// node iserv as invoked by +// GHC.Runtime.Interpreter.Wasm.spawnWasmInterp +if (isNodeMain) { const libdir = process.argv[2]; const ghciSoPath = process.argv[3]; const out_fd = Number.parseInt(process.argv[4]), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d7985e376935e3583370f85a83bbcf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d7985e376935e3583370f85a83bbcf… You're receiving this email because of your account on gitlab.haskell.org.

1 0