ghc-lib 0.20210701 → 0.20210801
raw patch · 76 files changed
+4656/−4831 lines, 76 filesdep ~ghc-lib-parser
Dependency ranges changed: ghc-lib-parser
Files
- compiler/GHC.hs +28/−19
- compiler/GHC/Builtin/Names/TH.hs +5/−3
- compiler/GHC/ByteCode/Asm.hs +11/−11
- compiler/GHC/ByteCode/Instr.hs +5/−5
- compiler/GHC/Cmm/Opt.hs +2/−6
- compiler/GHC/Cmm/Parser.y +2/−2
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs +31/−0
- compiler/GHC/CmmToAsm/PIC.hs +4/−7
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs +42/−3
- compiler/GHC/CmmToAsm/SPARC/CodeGen.hs +40/−2
- compiler/GHC/CmmToAsm/X86/CodeGen.hs +60/−25
- compiler/GHC/CmmToAsm/X86/Instr.hs +5/−1
- compiler/GHC/CmmToC.hs +33/−2
- compiler/GHC/CmmToLlvm/CodeGen.hs +31/−0
- compiler/GHC/Core/Opt/Pipeline.hs +2/−2
- compiler/GHC/Core/Opt/Simplify.hs +214/−92
- compiler/GHC/Core/Opt/Simplify/Env.hs +6/−3
- compiler/GHC/Core/Opt/Simplify/Utils.hs +18/−7
- compiler/GHC/CoreToStg.hs +1/−2
- compiler/GHC/Driver/Backpack.hs +11/−5
- compiler/GHC/Driver/CodeOutput.hs +3/−2
- compiler/GHC/Driver/Main.hs +34/−73
- compiler/GHC/Driver/Make.hs +39/−30
- compiler/GHC/Driver/MakeFile.hs +4/−2
- compiler/GHC/Driver/Pipeline.hs +965/−2247
- compiler/GHC/Driver/Pipeline.hs-boot +13/−0
- compiler/GHC/Driver/Pipeline/Execute.hs +1267/−0
- compiler/GHC/Hs/Syn/Type.hs +1/−1
- compiler/GHC/HsToCore/Expr.hs +28/−9
- compiler/GHC/HsToCore/Foreign/Call.hs +7/−15
- compiler/GHC/HsToCore/Monad.hs +2/−16
- compiler/GHC/HsToCore/Quote.hs +8/−3
- compiler/GHC/HsToCore/Utils.hs +64/−1
- compiler/GHC/Iface/Load.hs +5/−2
- compiler/GHC/Iface/Recomp.hs +12/−4
- compiler/GHC/Iface/Tidy.hs +1/−1
- compiler/GHC/Linker/Dynamic.hs +1/−2
- compiler/GHC/Linker/ExtraObj.hs +2/−2
- compiler/GHC/Linker/Loader.hs +9/−7
- compiler/GHC/Linker/Static.hs +3/−3
- compiler/GHC/Linker/Unit.hs +1/−1
- compiler/GHC/Linker/Windows.hs +2/−2
- compiler/GHC/Rename/Bind.hs +1/−4
- compiler/GHC/Rename/Expr.hs +1/−1
- compiler/GHC/Rename/Module.hs +1/−8
- compiler/GHC/Rename/Names.hs +6/−3
- compiler/GHC/Rename/Pat.hs +14/−60
- compiler/GHC/Rename/Utils.hs +4/−16
- compiler/GHC/Runtime/Loader.hs +3/−1
- compiler/GHC/StgToByteCode.hs +41/−69
- compiler/GHC/StgToCmm.hs +1/−1
- compiler/GHC/StgToCmm/Closure.hs +4/−0
- compiler/GHC/StgToCmm/Prim.hs +69/−26
- compiler/GHC/SysTools/Process.hs +1/−1
- compiler/GHC/Tc/Deriv/Generate.hs +21/−1
- compiler/GHC/Tc/Errors.hs +15/−5
- compiler/GHC/Tc/Gen/Arrow.hs +4/−4
- compiler/GHC/Tc/Gen/Splice.hs +4/−2
- compiler/GHC/Tc/Plugin.hs +3/−1
- compiler/GHC/Tc/Solver.hs +1/−6
- compiler/GHC/Tc/Solver/Canonical.hs +4/−2
- compiler/GHC/Tc/TyCl/Instance.hs +2/−1
- compiler/GHC/Tc/TyCl/PatSyn.hs +7/−3
- compiler/GHC/Tc/Types/EvTerm.hs +2/−3
- compiler/GHC/Tc/Utils/Backpack.hs +6/−2
- compiler/GHC/Tc/Utils/Instantiate.hs +12/−2
- compiler/GHC/Tc/Utils/Monad.hs +35/−23
- compiler/GHC/ThToHs.hs +4/−0
- compiler/GHC/Unit/Finder.hs +0/−625
- ghc-lib.cabal +9/−5
- ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl +0/−9
- ghc-lib/stage0/compiler/build/primop-list.hs-incl +0/−9
- ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +5/−14
- ghc-lib/stage0/compiler/build/primop-tag.hs-incl +1276/−1285
- ghc-lib/stage0/lib/ghcautoconf.h +3/−0
- libraries/ghci/GHCi/InfoTable.hsc +75/−19
compiler/GHC.hs view
@@ -310,6 +310,7 @@ import GHC.Driver.CmdLine import GHC.Driver.Session import GHC.Driver.Backend+import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic@@ -381,7 +382,7 @@ import GHC.Types.Name.Reader import GHC.Types.SourceError import GHC.Types.SafeHaskell-import GHC.Types.Error hiding ( getMessages, getErrorMessages )+import GHC.Types.Error import GHC.Types.Fixity import GHC.Types.Target import GHC.Types.Basic@@ -404,7 +405,6 @@ import Data.Foldable import qualified Data.Map.Strict as Map import Data.Set (Set)-import qualified Data.Set as S import qualified Data.Sequence as Seq import Data.Maybe import Data.Typeable ( Typeable )@@ -420,7 +420,7 @@ import GHC.Data.Maybe import System.IO.Error ( isDoesNotExistError )-import System.Environment ( getEnv )+import System.Environment ( getEnv, getProgName ) import System.Directory import Data.List (isPrefixOf) @@ -465,9 +465,13 @@ (\ge -> liftIO $ do flushOut case ge of- Signal _ -> exitWith (ExitFailure 1)- _ -> do fm (show ge)- exitWith (ExitFailure 1)+ Signal _ -> return ()+ ProgramError _ -> fm (show ge)+ CmdLineError _ -> fm ("<command line>: " ++ show ge)+ _ -> do+ progName <- getProgName+ fm (progName ++ ": " ++ show ge)+ exitWith (ExitFailure 1) ) $ inner @@ -530,8 +534,9 @@ let logger = hsc_logger hsc_env let tmpfs = hsc_tmpfs hsc_env liftIO $ do- cleanTempFiles logger tmpfs dflags- cleanTempDirs logger tmpfs dflags+ unless (gopt Opt_KeepTmpFiles dflags) $ do+ cleanTempFiles logger tmpfs+ cleanTempDirs logger tmpfs traverse_ stopInterp (hsc_interp hsc_env) -- exceptions will be blocked while we clean the temporary files, -- so there shouldn't be any difficulty if we receive further@@ -585,10 +590,10 @@ checkBrokenTablesNextToCode' :: MonadIO m => Logger -> DynFlags -> m Bool checkBrokenTablesNextToCode' logger dflags- | not (isARM arch) = return False- | WayDyn `S.notMember` ways dflags = return False- | not tablesNextToCode = return False- | otherwise = do+ | not (isARM arch) = return False+ | ways dflags `hasNotWay` WayDyn = return False+ | not tablesNextToCode = return False+ | otherwise = do linkerInfo <- liftIO $ getLinkerInfo logger dflags case linkerInfo of GnuLD _ -> return True@@ -1583,7 +1588,7 @@ let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1 case lexTokenStream (initParserOpts dflags) source startLoc of POk _ ts -> return ts- PFailed pst -> throwErrors (GhcPsMessage <$> getErrorMessages pst)+ PFailed pst -> throwErrors (GhcPsMessage <$> getPsErrorMessages pst) -- | Give even more information on the source than 'getTokenStream' -- This function allows reconstructing the source completely with@@ -1594,7 +1599,7 @@ let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1 case lexTokenStream (initParserOpts dflags) source startLoc of POk _ ts -> return $ addSourceToTokens startLoc source ts- PFailed pst -> throwErrors (GhcPsMessage <$> getErrorMessages pst)+ PFailed pst -> throwErrors (GhcPsMessage <$> getPsErrorMessages pst) -- | Given a source location and a StringBuffer corresponding to this -- location, return a rich token stream with the source associated to the@@ -1655,9 +1660,10 @@ let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env+ let fopts = initFinderOpts dflags case maybe_pkg of Just pkg | not (isHomeUnit home_unit (fsToUnit pkg)) && pkg /= fsLit "this" -> liftIO $ do- res <- findImportedModule fc units home_unit dflags mod_name maybe_pkg+ res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg case res of Found _ m -> return m err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err@@ -1666,12 +1672,14 @@ case home of Just m -> return m Nothing -> liftIO $ do- res <- findImportedModule fc units home_unit dflags mod_name maybe_pkg+ res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg case res of Found loc m | not (isHomeModule home_unit m) -> return m | otherwise -> modNotLoadedError dflags m loc err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err+ where + modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $ text "module is not loaded:" <+>@@ -1695,7 +1703,8 @@ let fc = hsc_FC hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env- res <- findExposedPackageModule fc units dflags mod_name Nothing+ let fopts = initFinderOpts dflags+ res <- findExposedPackageModule fc fopts units mod_name Nothing case res of Found _ m -> return m err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err@@ -1773,11 +1782,11 @@ case unP Parser.parseModule (initParserState (initParserOpts dflags) buf loc) of PFailed pst ->- let (warns,errs) = getMessages pst in+ let (warns,errs) = getPsMessages pst in (GhcPsMessage <$> warns, Left $ GhcPsMessage <$> errs) POk pst rdr_module ->- let (warns,_) = getMessages pst in+ let (warns,_) = getPsMessages pst in (GhcPsMessage <$> warns, Right rdr_module) -- -----------------------------------------------------------------------------
compiler/GHC/Builtin/Names/TH.hs view
@@ -72,7 +72,7 @@ classDName, instanceWithOverlapDName, standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName, pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,- pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName,+ pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, defaultDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, dataInstDName, newtypeInstDName, tySynInstDName, infixLDName, infixRDName, infixNDName,@@ -353,7 +353,7 @@ funDName, valDName, dataDName, newtypeDName, tySynDName, classDName, instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,- pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName,+ pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, defaultDName, dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName, infixNDName, roleAnnotDName, patSynDName, patSynSigDName,@@ -368,6 +368,7 @@ standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey sigDName = libFun (fsLit "sigD") sigDIdKey kiSigDName = libFun (fsLit "kiSigD") kiSigDIdKey+defaultDName = libFun (fsLit "defaultD") defaultDIdKey defaultSigDName = libFun (fsLit "defaultSigD") defaultSigDIdKey forImpDName = libFun (fsLit "forImpD") forImpDIdKey pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey@@ -878,7 +879,7 @@ newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey, infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,- kiSigDIdKey :: Unique+ kiSigDIdKey, defaultDIdKey :: Unique funDIdKey = mkPreludeMiscIdUnique 320 valDIdKey = mkPreludeMiscIdUnique 321 dataDIdKey = mkPreludeMiscIdUnique 322@@ -912,6 +913,7 @@ pragCompleteDIdKey = mkPreludeMiscIdUnique 350 implicitParamBindDIdKey = mkPreludeMiscIdUnique 351 kiSigDIdKey = mkPreludeMiscIdUnique 352+defaultDIdKey = mkPreludeMiscIdUnique 353 -- type Cxt = ... cxtIdKey :: Unique
compiler/GHC/ByteCode/Asm.hs view
@@ -459,7 +459,7 @@ JMP l -> emit bci_JMP [LabelOp l] ENTER -> emit bci_ENTER [] RETURN -> emit bci_RETURN []- RETURN_UBX rep -> emit (return_ubx rep) []+ RETURN_UNLIFTED rep -> emit (return_unlifted rep) [] RETURN_TUPLE -> emit bci_RETURN_T [] CCALL off m_addr i -> do np <- addr m_addr emit bci_CCALL [SmallOp off, Op np, SmallOp i]@@ -527,16 +527,16 @@ push_alts V32 = error "push_alts: vector" push_alts V64 = error "push_alts: vector" -return_ubx :: ArgRep -> Word16-return_ubx V = bci_RETURN_V-return_ubx P = bci_RETURN_P-return_ubx N = bci_RETURN_N-return_ubx L = bci_RETURN_L-return_ubx F = bci_RETURN_F-return_ubx D = bci_RETURN_D-return_ubx V16 = error "return_ubx: vector"-return_ubx V32 = error "return_ubx: vector"-return_ubx V64 = error "return_ubx: vector"+return_unlifted :: ArgRep -> Word16+return_unlifted V = bci_RETURN_V+return_unlifted P = bci_RETURN_P+return_unlifted N = bci_RETURN_N+return_unlifted L = bci_RETURN_L+return_unlifted F = bci_RETURN_F+return_unlifted D = bci_RETURN_D+return_unlifted V16 = error "return_unlifted: vector"+return_unlifted V32 = error "return_unlifted: vector"+return_unlifted V64 = error "return_unlifted: vector" {- we can only handle up to a fixed number of words on the stack,
compiler/GHC/ByteCode/Instr.hs view
@@ -172,9 +172,9 @@ -- To Infinity And Beyond | ENTER- | RETURN -- return a lifted value- | RETURN_UBX ArgRep -- return an unlifted value, here's its rep- | RETURN_TUPLE -- return an unboxed tuple (info already on stack)+ | RETURN -- return a lifted value+ | RETURN_UNLIFTED ArgRep -- return an unlifted value, here's its rep+ | RETURN_TUPLE -- return an unboxed tuple (info already on stack) -- Breakpoints | BRK_FUN Word16 Unique (RemotePtr CostCentre)@@ -310,7 +310,7 @@ <+> text "by" <+> ppr n ppr ENTER = text "ENTER" ppr RETURN = text "RETURN"- ppr (RETURN_UBX pk) = text "RETURN_UBX " <+> ppr pk+ ppr (RETURN_UNLIFTED pk) = text "RETURN_UNLIFTED " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "<cc>" @@ -390,7 +390,7 @@ bciStackUse JMP{} = 0 bciStackUse ENTER{} = 0 bciStackUse RETURN{} = 0-bciStackUse RETURN_UBX{} = 1 -- pushes stg_ret_X for some X+bciStackUse RETURN_UNLIFTED{} = 1 -- pushes stg_ret_X for some X bciStackUse RETURN_TUPLE{} = 1 -- pushes stg_ret_t header bciStackUse CCALL{} = 0 bciStackUse SWIZZLE{} = 0
compiler/GHC/Cmm/Opt.hs view
@@ -108,10 +108,6 @@ intconv True = MO_SS_Conv intconv False = MO_UU_Conv --- ToDo: a narrow of a load can be collapsed into a narrow load, right?--- but what if the architecture only supports word-sized loads, should--- we do the transformation anyway?- cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of -- for comparisons: don't forget to narrow the arguments before@@ -357,7 +353,7 @@ CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require -- it is a reg. FIXME: remove this restriction. Just $! (cmmMachOpFold platform (MO_S_Shr rep)- [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)])+ [signedQuotRemHelper rep p, CmmLit (CmmInt p $ wordWidth platform)]) MO_S_Rem rep | Just p <- exactLog2 n, CmmReg _ <- x -> -- We duplicate x in signedQuotRemHelper, hence require@@ -391,7 +387,7 @@ where bits = fromIntegral (widthInBits rep) - 1 shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep- x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]+ x1 = CmmMachOp shr [x, CmmLit (CmmInt bits $ wordWidth platform)] x2 = if p == 1 then x1 else CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
compiler/GHC/Cmm/Parser.y view
@@ -1509,7 +1509,7 @@ -- in there we don't want. case unPD cmmParse dflags home_unit init_state of PFailed pst -> do- let (warnings,errors) = getMessages pst+ let (warnings,errors) = getPsMessages pst return (warnings, errors, Nothing) POk pst code -> do st <- initC@@ -1520,7 +1520,7 @@ ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info return (cmm ++ cmm2, used_info) (cmm, _) = runC dflags no_module st fcode- (warnings,errors) = getMessages pst+ (warnings,errors) = getPsMessages pst if not (isEmptyMessages errors) then return (warnings, errors, Nothing) else return (warnings, errors, Just cmm)
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs view
@@ -1281,6 +1281,37 @@ MO_F32_Fabs -> mkCCall "fasbf" MO_F32_Sqrt -> mkCCall "sqrtf" + -- 64-bit primops+ MO_I64_ToI -> mkCCall "hs_int64ToInt"+ MO_I64_FromI -> mkCCall "hs_intToInt64"+ MO_W64_ToW -> mkCCall "hs_word64ToWord"+ MO_W64_FromW -> mkCCall "hs_wordToWord64"+ MO_x64_Neg -> mkCCall "hs_neg64"+ MO_x64_Add -> mkCCall "hs_add64"+ MO_x64_Sub -> mkCCall "hs_sub64"+ MO_x64_Mul -> mkCCall "hs_mul64"+ MO_I64_Quot -> mkCCall "hs_quotInt64"+ MO_I64_Rem -> mkCCall "hs_remInt64"+ MO_W64_Quot -> mkCCall "hs_quotWord64"+ MO_W64_Rem -> mkCCall "hs_remWord64"+ MO_x64_And -> mkCCall "hs_and64"+ MO_x64_Or -> mkCCall "hs_or64"+ MO_x64_Xor -> mkCCall "hs_xor64"+ MO_x64_Not -> mkCCall "hs_not64"+ MO_x64_Shl -> mkCCall "hs_uncheckedShiftL64"+ MO_I64_Shr -> mkCCall "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> mkCCall "hs_uncheckedShiftRL64"+ MO_x64_Eq -> mkCCall "hs_eq64"+ MO_x64_Ne -> mkCCall "hs_ne64"+ MO_I64_Ge -> mkCCall "hs_geInt64"+ MO_I64_Gt -> mkCCall "hs_gtInt64"+ MO_I64_Le -> mkCCall "hs_leInt64"+ MO_I64_Lt -> mkCCall "hs_ltInt64"+ MO_W64_Ge -> mkCCall "hs_geWord64"+ MO_W64_Gt -> mkCCall "hs_gtWord64"+ MO_W64_Le -> mkCCall "hs_leWord64"+ MO_W64_Lt -> mkCCall "hs_ltWord64"+ -- Conversion MO_UF_Conv w -> mkCCall (word2FloatLabel w)
compiler/GHC/CmmToAsm/PIC.hs view
@@ -285,14 +285,11 @@ -- when generating PIC code, all cross-module data references must -- must go via a symbol pointer, too, because the assembler -- cannot generate code for a label difference where one- -- label is undefined. Doesn't apply t x86_64.- -- Unfortunately, we don't know whether it's cross-module,- -- so we do it for all externally visible labels.- -- This is a slight waste of time and space, but otherwise- -- we'd need to pass the current Module all the way in to- -- this function.+ -- label is undefined. Doesn't apply to x86_64 (why?). | arch /= ArchX86_64- , ncgPIC config && externallyVisibleCLabel lbl+ , not (isLocalCLabel (ncgThisModule config) lbl)+ , ncgPIC config+ , externallyVisibleCLabel lbl = AccessViaSymbolPtr | otherwise
compiler/GHC/CmmToAsm/PPC/CodeGen.hs view
@@ -2006,6 +2006,39 @@ MO_F64_Acosh -> (fsLit "acosh", False) MO_F64_Atanh -> (fsLit "atanh", False) + MO_I64_ToI -> (fsLit "hs_int64ToInt", False)+ MO_I64_FromI -> (fsLit "hs_intToInt64", False)+ MO_W64_ToW -> (fsLit "hs_word64ToWord", False)+ MO_W64_FromW -> (fsLit "hs_wordToWord64", False)++ MO_x64_Neg -> (fsLit "hs_neg64", False)+ MO_x64_Add -> (fsLit "hs_add64", False)+ MO_x64_Sub -> (fsLit "hs_sub64", False)+ MO_x64_Mul -> (fsLit "hs_mul64", False)+ MO_I64_Quot -> (fsLit "hs_quotInt64", False)+ MO_I64_Rem -> (fsLit "hs_remInt64", False)+ MO_W64_Quot -> (fsLit "hs_quotWord64", False)+ MO_W64_Rem -> (fsLit "hs_remWord64", False)++ MO_x64_And -> (fsLit "hs_and64", False)+ MO_x64_Or -> (fsLit "hs_or64", False)+ MO_x64_Xor -> (fsLit "hs_xor64", False)+ MO_x64_Not -> (fsLit "hs_not64", False)+ MO_x64_Shl -> (fsLit "hs_uncheckedShiftL64", False)+ MO_I64_Shr -> (fsLit "hs_uncheckedIShiftRA64", False)+ MO_W64_Shr -> (fsLit "hs_uncheckedShiftRL64", False)++ MO_x64_Eq -> (fsLit "hs_eq64", False)+ MO_x64_Ne -> (fsLit "hs_ne64", False)+ MO_I64_Ge -> (fsLit "hs_geInt64", False)+ MO_I64_Gt -> (fsLit "hs_gtInt64", False)+ MO_I64_Le -> (fsLit "hs_leInt64", False)+ MO_I64_Lt -> (fsLit "hs_ltInt64", False)+ MO_W64_Ge -> (fsLit "hs_geWord64", False)+ MO_W64_Gt -> (fsLit "hs_gtWord64", False)+ MO_W64_Le -> (fsLit "hs_leWord64", False)+ MO_W64_Lt -> (fsLit "hs_ltWord64", False)+ MO_UF_Conv w -> (word2FloatLabel w, False) MO_Memcpy _ -> (fsLit "memcpy", False)@@ -2053,7 +2086,7 @@ genSwitch config expr targets | OSAIX <- platformOS platform = do- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)+ (reg,e_code) <- getSomeReg indexExpr let fmt = archWordFormat $ target32Bit platform sha = if target32Bit platform then 2 else 3 tmp <- getNewRegNat fmt@@ -2070,7 +2103,7 @@ | (ncgPIC config) || (not $ target32Bit platform) = do- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)+ (reg,e_code) <- getSomeReg indexExpr let fmt = archWordFormat $ target32Bit platform sha = if target32Bit platform then 2 else 3 tmp <- getNewRegNat fmt@@ -2087,7 +2120,7 @@ return code | otherwise = do- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)+ (reg,e_code) <- getSomeReg indexExpr let fmt = archWordFormat $ target32Bit platform sha = if target32Bit platform then 2 else 3 tmp <- getNewRegNat fmt@@ -2101,6 +2134,12 @@ ] return code where+ indexExpr = cmmOffset platform exprWidened offset+ -- We widen to a native-width register to santize the high bits+ exprWidened = CmmMachOp+ (MO_UU_Conv (cmmExprWidth platform expr)+ (platformWordWidth platform))+ [expr] (offset, ids) = switchTargetsToTable targets platform = ncgPlatform config
compiler/GHC/CmmToAsm/SPARC/CodeGen.hs view
@@ -313,7 +313,7 @@ = error "MachCodeGen: sparc genSwitch PIC not finished\n" | otherwise- = do (e_reg, e_code) <- getSomeReg (cmmOffset (ncgPlatform config) expr offset)+ = do (e_reg, e_code) <- getSomeReg indexExpr base_reg <- getNewRegNat II32 offset_reg <- getNewRegNat II32@@ -334,7 +334,15 @@ , LD II32 (AddrRegReg base_reg offset_reg) dst , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label , NOP ]- where (offset, ids) = switchTargetsToTable targets+ where+ indexExpr = cmmOffset platform exprWidened offset+ -- We widen to a native-width register to santize the high bits+ exprWidened = CmmMachOp+ (MO_UU_Conv (cmmExprWidth platform expr)+ (platformWordWidth platform))+ [expr]+ (offset, ids) = switchTargetsToTable targets+ platform = ncgPlatform config generateJumpTableForInstr :: Platform -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)@@ -657,6 +665,36 @@ MO_F64_Asinh -> fsLit "asinh" MO_F64_Acosh -> fsLit "acosh" MO_F64_Atanh -> fsLit "atanh"++ MO_I64_ToI -> fsLit "hs_int64ToInt"+ MO_I64_FromI -> fsLit "hs_intToInt64"+ MO_W64_ToW -> fsLit "hs_word64ToWord"+ MO_W64_FromW -> fsLit "hs_wordToWord64"+ MO_x64_Neg -> fsLit "hs_neg64"+ MO_x64_Add -> fsLit "hs_add64"+ MO_x64_Sub -> fsLit "hs_sub64"+ MO_x64_Mul -> fsLit "hs_mul64"+ MO_I64_Quot -> fsLit "hs_quotInt64"+ MO_I64_Rem -> fsLit "hs_remInt64"+ MO_W64_Quot -> fsLit "hs_quotWord64"+ MO_W64_Rem -> fsLit "hs_remWord64"+ MO_x64_And -> fsLit "hs_and64"+ MO_x64_Or -> fsLit "hs_or64"+ MO_x64_Xor -> fsLit "hs_xor64"+ MO_x64_Not -> fsLit "hs_not64"+ MO_x64_Shl -> fsLit "hs_uncheckedShiftL64"+ MO_I64_Shr -> fsLit "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> fsLit "hs_uncheckedShiftRL64"+ MO_x64_Eq -> fsLit "hs_eq64"+ MO_x64_Ne -> fsLit "hs_ne64"+ MO_I64_Ge -> fsLit "hs_geInt64"+ MO_I64_Gt -> fsLit "hs_gtInt64"+ MO_I64_Le -> fsLit "hs_leInt64"+ MO_I64_Lt -> fsLit "hs_ltInt64"+ MO_W64_Ge -> fsLit "hs_geWord64"+ MO_W64_Gt -> fsLit "hs_gtWord64"+ MO_W64_Le -> fsLit "hs_leWord64"+ MO_W64_Lt -> fsLit "hs_ltWord64" MO_UF_Conv w -> word2FloatLabel w
compiler/GHC/CmmToAsm/X86/CodeGen.hs view
@@ -2476,18 +2476,17 @@ mask_r <- getNewRegNat format let dst_r = getRegisterReg platform (CmmLocal dst) return $ code_src src_r `appOL` code_mask mask_r `appOL`- (if width == W8 then- -- The PDEP instruction doesn't take a r/m8- unitOL (MOVZxL II8 (OpReg src_r ) (OpReg src_r )) `appOL`- unitOL (MOVZxL II8 (OpReg mask_r) (OpReg mask_r)) `appOL`- unitOL (PDEP II16 (OpReg mask_r) (OpReg src_r ) dst_r)- else- unitOL (PDEP format (OpReg mask_r) (OpReg src_r) dst_r)) `appOL`- (if width == W8 || width == W16 then- -- We used a 16-bit destination register above,- -- so zero-extend- unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))- else nilOL)+ -- PDEP only supports > 32 bit args+ ( if width == W8 || width == W16 then+ toOL+ [ MOVZxL format (OpReg src_r ) (OpReg src_r )+ , MOVZxL format (OpReg mask_r) (OpReg mask_r)+ , PDEP II32 (OpReg mask_r) (OpReg src_r ) dst_r+ , MOVZxL format (OpReg dst_r) (OpReg dst_r) -- Truncate to op width+ ]+ else+ unitOL (PDEP format (OpReg mask_r) (OpReg src_r) dst_r)+ ) else do targetExpr <- cmmMakeDynamicReference config CallReference lbl@@ -2509,18 +2508,17 @@ mask_r <- getNewRegNat format let dst_r = getRegisterReg platform (CmmLocal dst) return $ code_src src_r `appOL` code_mask mask_r `appOL`- (if width == W8 then- -- The PEXT instruction doesn't take a r/m8- unitOL (MOVZxL II8 (OpReg src_r ) (OpReg src_r )) `appOL`- unitOL (MOVZxL II8 (OpReg mask_r) (OpReg mask_r)) `appOL`- unitOL (PEXT II16 (OpReg mask_r) (OpReg src_r) dst_r)- else- unitOL (PEXT format (OpReg mask_r) (OpReg src_r) dst_r)) `appOL` (if width == W8 || width == W16 then- -- We used a 16-bit destination register above,- -- so zero-extend- unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))- else nilOL)+ -- The PEXT instruction doesn't take a r/m8 or 16+ toOL+ [ MOVZxL format (OpReg src_r ) (OpReg src_r )+ , MOVZxL format (OpReg mask_r) (OpReg mask_r)+ , PEXT II32 (OpReg mask_r) (OpReg src_r ) dst_r+ , MOVZxL format (OpReg dst_r) (OpReg dst_r) -- Truncate to op width+ ]+ else+ unitOL (PEXT format (OpReg mask_r) (OpReg src_r) dst_r)+ ) else do targetExpr <- cmmMakeDynamicReference config CallReference lbl@@ -3390,6 +3388,36 @@ MO_F64_Acosh -> fsLit "acosh" MO_F64_Atanh -> fsLit "atanh" + MO_I64_ToI -> fsLit "hs_int64ToInt"+ MO_I64_FromI -> fsLit "hs_intToInt64"+ MO_W64_ToW -> fsLit "hs_word64ToWord"+ MO_W64_FromW -> fsLit "hs_wordToWord64"+ MO_x64_Neg -> fsLit "hs_neg64"+ MO_x64_Add -> fsLit "hs_add64"+ MO_x64_Sub -> fsLit "hs_sub64"+ MO_x64_Mul -> fsLit "hs_mul64"+ MO_I64_Quot -> fsLit "hs_quotInt64"+ MO_I64_Rem -> fsLit "hs_remInt64"+ MO_W64_Quot -> fsLit "hs_quotWord64"+ MO_W64_Rem -> fsLit "hs_remWord64"+ MO_x64_And -> fsLit "hs_and64"+ MO_x64_Or -> fsLit "hs_or64"+ MO_x64_Xor -> fsLit "hs_xor64"+ MO_x64_Not -> fsLit "hs_not64"+ MO_x64_Shl -> fsLit "hs_uncheckedShiftL64"+ MO_I64_Shr -> fsLit "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> fsLit "hs_uncheckedShiftRL64"+ MO_x64_Eq -> fsLit "hs_eq64"+ MO_x64_Ne -> fsLit "hs_ne64"+ MO_I64_Ge -> fsLit "hs_geInt64"+ MO_I64_Gt -> fsLit "hs_gtInt64"+ MO_I64_Le -> fsLit "hs_leInt64"+ MO_I64_Lt -> fsLit "hs_ltInt64"+ MO_W64_Ge -> fsLit "hs_geWord64"+ MO_W64_Gt -> fsLit "hs_gtWord64"+ MO_W64_Le -> fsLit "hs_leWord64"+ MO_W64_Lt -> fsLit "hs_ltWord64"+ MO_Memcpy _ -> fsLit "memcpy" MO_Memset _ -> fsLit "memset" MO_Memmove _ -> fsLit "memmove"@@ -3448,9 +3476,16 @@ genSwitch expr targets = do config <- getConfig let platform = ncgPlatform config+ -- We widen to a native-width register because we cannot use arbitry sizes+ -- in x86 addressing modes.+ exprWidened = CmmMachOp+ (MO_UU_Conv (cmmExprWidth platform expr)+ (platformWordWidth platform))+ [expr]+ indexExpr = cmmOffset platform exprWidened offset if ncgPIC config then do- (reg,e_code) <- getNonClobberedReg (cmmOffset platform expr offset)+ (reg,e_code) <- getNonClobberedReg indexExpr -- getNonClobberedReg because it needs to survive across t_code lbl <- getNewLabelNat let is32bit = target32Bit platform@@ -3491,7 +3526,7 @@ JMP_TBL (OpReg tableReg) ids rosection lbl ] else do- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)+ (reg,e_code) <- getSomeReg indexExpr lbl <- getNewLabelNat let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl lbl)) code = e_code `appOL` toOL [
compiler/GHC/CmmToAsm/X86/Instr.hs view
@@ -199,7 +199,11 @@ -- Moves. | MOV Format Operand Operand | CMOV Cond Format Operand Reg- | MOVZxL Format Operand Operand -- format is the size of operand 1+ | MOVZxL Format Operand Operand+ -- ^ The format argument is the size of operand 1 (the number of bits we keep)+ -- We always zero *all* high bits, even though this isn't how the actual instruction+ -- works. The code generator also seems to rely on this behaviour and it's faster+ -- to execute on many cpus as well so for now I'm just documenting the fact. | MOVSxL Format Operand Operand -- format is the size of operand 1 -- x86_64 note: plain mov into a 32-bit register always zero-extends -- into the 64-bit reg, in contrast to the 8 and 16-bit movs which
compiler/GHC/CmmToC.hs view
@@ -341,15 +341,17 @@ where (pairs, mbdef) = switchTargetsFallThrough ids + rep = typeWidth (cmmExprType platform e)+ -- fall through case caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix where do_fallthrough ix =- hsep [ text "case" , pprHexVal platform ix (wordWidth platform) <> colon ,+ hsep [ text "case" , pprHexVal platform ix rep <> colon , text "/* fall through */" ] final_branch ix =- hsep [ text "case" , pprHexVal platform ix (wordWidth platform) <> colon ,+ hsep [ text "case" , pprHexVal platform ix rep <> colon , text "goto" , (pprBlockId ident) <> semi ] caseify (_ , _ ) = panic "pprSwitch: switch with no cases!"@@ -861,6 +863,35 @@ (MO_Prefetch_Data _ ) -> unsupported --- we could support prefetch via "__builtin_prefetch" --- Not adding it for now+ MO_I64_ToI -> text "hs_int64ToInt"+ MO_I64_FromI -> text "hs_intToInt64"+ MO_W64_ToW -> text "hs_word64ToWord"+ MO_W64_FromW -> text "hs_wordToWord64"+ MO_x64_Neg -> text "hs_neg64"+ MO_x64_Add -> text "hs_add64"+ MO_x64_Sub -> text "hs_sub64"+ MO_x64_Mul -> text "hs_mul64"+ MO_I64_Quot -> text "hs_quotInt64"+ MO_I64_Rem -> text "hs_remInt64"+ MO_W64_Quot -> text "hs_quotWord64"+ MO_W64_Rem -> text "hs_remWord64"+ MO_x64_And -> text "hs_and64"+ MO_x64_Or -> text "hs_xor64"+ MO_x64_Xor -> text "hs_xor64"+ MO_x64_Not -> text "hs_not64"+ MO_x64_Shl -> text "hs_uncheckedShiftL64"+ MO_I64_Shr -> text "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> text "hs_uncheckedShiftRL64"+ MO_x64_Eq -> text "hs_eq64"+ MO_x64_Ne -> text "hs_ne64"+ MO_I64_Ge -> text "hs_geInt64"+ MO_I64_Gt -> text "hs_gtInt64"+ MO_I64_Le -> text "hs_leInt64"+ MO_I64_Lt -> text "hs_ltInt64"+ MO_W64_Ge -> text "hs_geWord64"+ MO_W64_Gt -> text "hs_gtWord64"+ MO_W64_Le -> text "hs_leWord64"+ MO_W64_Lt -> text "hs_ltWord64" where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop ++ " not supported!")
compiler/GHC/CmmToLlvm/CodeGen.hs view
@@ -911,6 +911,37 @@ MO_Cmpxchg _ -> unsupported MO_Xchg _ -> unsupported + MO_I64_ToI -> fsLit "hs_int64ToInt"+ MO_I64_FromI -> fsLit "hs_intToInt64"+ MO_W64_ToW -> fsLit "hs_word64ToWord"+ MO_W64_FromW -> fsLit "hs_wordToWord64"+ MO_x64_Neg -> fsLit "hs_neg64"+ MO_x64_Add -> fsLit "hs_add64"+ MO_x64_Sub -> fsLit "hs_sub64"+ MO_x64_Mul -> fsLit "hs_mul64"+ MO_I64_Quot -> fsLit "hs_quotInt64"+ MO_I64_Rem -> fsLit "hs_remInt64"+ MO_W64_Quot -> fsLit "hs_quotWord64"+ MO_W64_Rem -> fsLit "hs_remWord64"+ MO_x64_And -> fsLit "hs_and64"+ MO_x64_Or -> fsLit "hs_or64"+ MO_x64_Xor -> fsLit "hs_xor64"+ MO_x64_Not -> fsLit "hs_not64"+ MO_x64_Shl -> fsLit "hs_uncheckedShiftL64"+ MO_I64_Shr -> fsLit "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> fsLit "hs_uncheckedShiftRL64"+ MO_x64_Eq -> fsLit "hs_eq64"+ MO_x64_Ne -> fsLit "hs_ne64"+ MO_I64_Ge -> fsLit "hs_geInt64"+ MO_I64_Gt -> fsLit "hs_gtInt64"+ MO_I64_Le -> fsLit "hs_leInt64"+ MO_I64_Lt -> fsLit "hs_ltInt64"+ MO_W64_Ge -> fsLit "hs_geWord64"+ MO_W64_Gt -> fsLit "hs_gtWord64"+ MO_W64_Le -> fsLit "hs_leWord64"+ MO_W64_Lt -> fsLit "hs_ltWord64"++ -- | Tail function calls genJump :: CmmExpr -> [GlobalReg] -> LlvmM StmtData
compiler/GHC/Core/Opt/Pipeline.hs view
@@ -691,8 +691,8 @@ -- about to begin, with '1' for the first | iteration_no > max_iterations -- Stop if we've run out of iterations = warnPprTrace (debugIsOn && (max_iterations > 2))- ( hang (text "Simplifier bailing out after" <+> int max_iterations- <+> text "iterations"+ ( hang (ppr this_mod <> colon <+> text "simplifier bailing out after"+ <+> int max_iterations <+> text "iterations" <+> (brackets $ hsep $ punctuate comma $ map (int . simplCountN) (reverse counts_so_far))) 2 (text "Size =" <+> ppr (coreBindsStats binds))) $
compiler/GHC/Core/Opt/Simplify.hs view
@@ -57,15 +57,13 @@ import GHC.Types.Basic import GHC.Types.Tickish import GHC.Types.Var ( isTyCoVar )- import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( orElse )+import GHC.Data.Maybe ( isNothing, orElse ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName, pprModuleName )- import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain@@ -292,33 +290,30 @@ simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs | Just env' <- preInlineUnconditionally env top_lvl old_bndr rhs env = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-}- trace_bind "pre-inline-uncond" $+ simplTrace env "SimplBindr:inline-uncond" (ppr old_bndr) $ do { tick (PreInlineUnconditionally old_bndr) ; return ( emptyFloats env, env' ) } | Just cont <- mb_cont = {-#SCC "simplRecOrTopPair-join" #-} assert (isNotTopLevel top_lvl && isJoinId new_bndr )- trace_bind "join" $+ simplTrace env "SimplBind:join" (ppr old_bndr) $ simplJoinBind env cont old_bndr new_bndr rhs env | otherwise = {-#SCC "simplRecOrTopPair-normal" #-}- trace_bind "normal" $+ simplTrace env "SimplBind:normal" (ppr old_bndr) $ simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env +simplTrace :: SimplEnv -> String -> SDoc -> a -> a+simplTrace env herald doc thing_inside+ | not (logHasDumpFlag logger Opt_D_verbose_core2core)+ = thing_inside+ | otherwise+ = logTraceMsg logger herald doc thing_inside where logger = seLogger env - -- trace_bind emits a trace for each top-level binding, which- -- helps to locate the tracing for inlining and rule firing- trace_bind what thing_inside- | not (logHasDumpFlag logger Opt_D_verbose_core2core)- = thing_inside- | otherwise- = logTraceMsg logger ("SimplBind " ++ what)- (ppr old_bndr) thing_inside- -------------------------- simplLazyBind :: SimplEnv -> TopLevelFlag -> RecFlag@@ -366,16 +361,17 @@ -- ANF-ise a constructor or PAP rhs -- We get at most one float per argument here+ ; let body_env1 = body_env `setInScopeFromF` body_floats1+ -- body_env1: add to in-scope set the binders from body_floats1+ -- so that prepareBinding knows what is in scope in body1 ; (let_floats, body2) <- {-#SCC "prepareBinding" #-}- prepareBinding env top_lvl bndr1 body1+ prepareBinding body_env1 top_lvl bndr1 body1 ; let body_floats2 = body_floats1 `addLetFloats` let_floats - ; (rhs_floats, rhs')+ ; (rhs_floats, body3) <- if not (doFloatFromRhs top_lvl is_rec False body_floats2 body2) then -- No floating, revert to body1- {-#SCC "simplLazyBind-no-floating" #-}- do { rhs' <- mkLam env tvs' (wrapFloats body_floats2 body1) rhs_cont- ; return (emptyFloats env, rhs') }+ return (emptyFloats env, wrapFloats body_floats2 body1) else if null tvs then -- Simple floating {-#SCC "simplLazyBind-simple-floating" #-}@@ -388,11 +384,11 @@ ; (poly_binds, body3) <- abstractFloats (seUnfoldingOpts env) top_lvl tvs' body_floats2 body2 ; let floats = foldl' extendFloats (emptyFloats env) poly_binds- ; rhs' <- mkLam env tvs' body3 rhs_cont- ; return (floats, rhs') }+ ; return (floats, body3) } - ; (bind_float, env2) <- completeBind (env `setInScopeFromF` rhs_floats)- top_lvl Nothing bndr bndr1 rhs'+ ; let env' = env `setInScopeFromF` rhs_floats+ ; rhs' <- mkLam env' tvs' body3 rhs_cont+ ; (bind_float, env2) <- completeBind env' top_lvl Nothing bndr bndr1 rhs' ; return (rhs_floats `addFloats` bind_float, env2) } --------------------------@@ -427,6 +423,12 @@ | Coercion co <- new_rhs = return (emptyFloats env, extendCvSubst env bndr co) + | exprIsTrivial new_rhs -- Short-cut for let x = y in ...+ -- This case would ultimately land in postInlineUnconditionally+ -- but it seems not uncommon, and avoids a lot of faff to do it here+ = return (emptyFloats env+ , extendIdSubst env bndr (DoneEx new_rhs Nothing))+ | otherwise = do { (env', bndr') <- simplBinder env bndr ; completeNonRecX NotTopLevel env' (isStrictId bndr') bndr bndr' new_rhs }@@ -607,7 +609,7 @@ , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4 , not (isUnliftedType rhs_ty) -- Not if rhs has an unlifted type; -- see Note [Cast w/w: unlifted]- = do { (rhs_floats, work_rhs) <- prepareRhs mode top_lvl occ_fs rhs+ = do { (rhs_floats, work_rhs) <- prepareRhs env top_lvl occ_fs rhs ; uniq <- getUniqueM ; let work_name = mkSystemVarName uniq occ_fs work_id = mkLocalIdWithInfo work_name Many rhs_ty worker_info@@ -690,7 +692,7 @@ -> OutId -> OutExpr -> SimplM (LetFloats, OutExpr) prepareBinding env top_lvl bndr rhs- = prepareRhs (getMode env) top_lvl (getOccFS bndr) rhs+ = prepareRhs env top_lvl (getOccFS bndr) rhs {- Note [prepareRhs] ~~~~~~~~~~~~~~~~~~~~@@ -710,17 +712,17 @@ That's what the 'go' loop in prepareRhs does -} -prepareRhs :: SimplMode -> TopLevelFlag+prepareRhs :: SimplEnv -> TopLevelFlag -> FastString -- Base for any new variables -> OutExpr -> SimplM (LetFloats, OutExpr) -- Transforms a RHS into a better RHS by ANF'ing args -- for expandable RHSs: constructors and PAPs -- e.g x = Just e--- becomes a = e+-- becomes a = e -- 'a' is fresh -- x = Just a -- See Note [prepareRhs]-prepareRhs mode top_lvl occ rhs0+prepareRhs env top_lvl occ rhs0 = do { (_is_exp, floats, rhs1) <- go 0 rhs0 ; return (floats, rhs1) } where@@ -735,7 +737,7 @@ = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun ; case is_exp of False -> return (False, emptyLetFloats, App fun arg)- True -> do { (floats2, arg') <- makeTrivial mode top_lvl topDmd occ arg+ True -> do { (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } } go n_val_args (Var fun) = return (is_exp, emptyLetFloats, Var fun)@@ -764,58 +766,64 @@ go _ other = return (False, emptyLetFloats, other) -makeTrivialArg :: SimplMode -> ArgSpec -> SimplM (LetFloats, ArgSpec)-makeTrivialArg mode arg@(ValArg { as_arg = e, as_dmd = dmd })- = do { (floats, e') <- makeTrivial mode NotTopLevel dmd (fsLit "arg") e+makeTrivialArg :: SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec)+makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd })+ = do { (floats, e') <- makeTrivial env NotTopLevel dmd (fsLit "arg") e ; return (floats, arg { as_arg = e' }) } makeTrivialArg _ arg = return (emptyLetFloats, arg) -- CastBy, TyArg -makeTrivial :: SimplMode -> TopLevelFlag -> Demand+makeTrivial :: SimplEnv -> TopLevelFlag -> Demand -> FastString -- ^ A "friendly name" to build the new binder from -> OutExpr -- ^ This expression satisfies the let/app invariant -> SimplM (LetFloats, OutExpr) -- Binds the expression to a variable, if it's not trivial, returning the variable -- For the Demand argument, see Note [Keeping demand info in StrictArg Plan A]-makeTrivial mode top_lvl dmd occ_fs expr+makeTrivial env top_lvl dmd occ_fs expr | exprIsTrivial expr -- Already trivial || not (bindingOk top_lvl expr expr_ty) -- Cannot trivialise -- See Note [Cannot trivialise] = return (emptyLetFloats, expr) | Cast expr' co <- expr- = do { (floats, triv_expr) <- makeTrivial mode top_lvl dmd occ_fs expr'+ = do { (floats, triv_expr) <- makeTrivial env top_lvl dmd occ_fs expr' ; return (floats, Cast triv_expr co) } | otherwise- = do { (floats, new_id) <- makeTrivialBinding mode top_lvl occ_fs+ = do { (floats, new_id) <- makeTrivialBinding env top_lvl occ_fs id_info expr expr_ty ; return (floats, Var new_id) } where id_info = vanillaIdInfo `setDemandInfo` dmd expr_ty = exprType expr -makeTrivialBinding :: SimplMode -> TopLevelFlag+makeTrivialBinding :: SimplEnv -> TopLevelFlag -> FastString -- ^ a "friendly name" to build the new binder from -> IdInfo -> OutExpr -- ^ This expression satisfies the let/app invariant -> OutType -- Type of the expression -> SimplM (LetFloats, OutId)-makeTrivialBinding mode top_lvl occ_fs info expr expr_ty- = do { (floats, expr1) <- prepareRhs mode top_lvl occ_fs expr+makeTrivialBinding env top_lvl occ_fs info expr expr_ty+ = do { (floats, expr1) <- prepareRhs env top_lvl occ_fs expr ; uniq <- getUniqueM ; let name = mkSystemVarName uniq occ_fs var = mkLocalIdWithInfo name Many expr_ty info -- Now something very like completeBind, -- but without the postInlineUnconditionally part- ; (arity_type, expr2) <- tryEtaExpandRhs mode var expr1+ ; (arity_type, expr2) <- tryEtaExpandRhs env var expr1+ -- Technically we should extend the in-scope set in 'env' with+ -- the 'floats' from prepareRHS; but they are all fresh, so there is+ -- no danger of introducing name shadowig in eta expansion+ ; unf <- mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs var expr2 ; let final_id = addLetBndrInfo var arity_type unf bind = NonRec final_id expr2 ; return ( floats `addLetFlts` unitLetFloat bind, final_id ) }+ where+ mode = getMode env bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool -- True iff we can have a binding of this expression at this level@@ -899,11 +907,10 @@ do { let old_info = idInfo old_bndr old_unf = realUnfoldingInfo old_info occ_info = occInfo old_info- mode = getMode env -- Do eta-expansion on the RHS of the binding -- See Note [Eta-expanding at let bindings] in GHC.Core.Opt.Simplify.Utils- ; (new_arity, eta_rhs) <- tryEtaExpandRhs mode new_bndr new_rhs+ ; (new_arity, eta_rhs) <- tryEtaExpandRhs env new_bndr new_rhs -- Simplify the unfolding ; new_unfolding <- simplLetUnfolding env top_lvl mb_cont old_bndr@@ -916,9 +923,12 @@ then -- Inline and discard the binding do { tick (PostInlineUnconditionally old_bndr)- ; return ( emptyFloats env+ ; let unf_rhs = maybeUnfoldingTemplate new_unfolding `orElse` eta_rhs+ -- See Note [Use occ-anald RHS in postInlineUnconditionally]+ ; simplTrace env "PostInlineUnconditionally" (ppr new_bndr <+> ppr unf_rhs) $+ return ( emptyFloats env , extendIdSubst env old_bndr $- DoneEx eta_rhs (isJoinId_maybe new_bndr)) }+ DoneEx unf_rhs (isJoinId_maybe new_bndr)) } -- Use the substitution to make quite, quite sure that the -- substitution will happen, since we are going to discard the binding @@ -1022,7 +1032,22 @@ (for example) be no longer strictly demanded. The solution here is a bit ad hoc... +Note [Use occ-anald RHS in postInlineUnconditionally]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we postInlineUnconditionally 'f in+ let f = \x -> x True in ...(f blah)...+then we'd like to inline the /occ-anald/ RHS for 'f'. If we+use the non-occ-anald version, we'll end up with a+ ...(let x = blah in x True)...+and hence an extra Simplifier iteration. +We already /have/ the occ-anald version in the Unfolding for+the Id. Well, maybe not /quite/ always. If the binder is Dead,+postInlineUnconditionally will return True, but we may not have an+unfolding because it's too big. Hence the belt-and-braces `orElse`+in the defn of unf_rhs. The Nothing case probably never happens.++ ************************************************************************ * * \subsection[Simplify-simplExpr]{The main function: simplExpr}@@ -1632,8 +1657,8 @@ -- Not enough args, so there are real lambdas left to put in the result simplLam env bndrs body cont = do { (env', bndrs') <- simplLamBndrs env bndrs- ; body' <- simplExpr env' body- ; new_lam <- mkLam env bndrs' body' cont+ ; body' <- simplExpr env' body+ ; new_lam <- mkLam env' bndrs' body' cont ; rebuild env' new_lam cont } -------------@@ -2684,6 +2709,27 @@ We could try and be more clever (like maybe wfloats only contain let binders, so we could float them). But the need for the extra complication is not clear.++Note [Do not duplicate constructor applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this (#20125)+ let x = (a,b)+ in ...(case x of x' -> blah)...x...x...++We want that `case` to vanish (since `x` is bound to a data con) leaving+ let x = (a,b)+ in ...(let x'=x in blah)...x..x...++In rebuildCase, `exprIsConApp_maybe` will succeed on the scrutinee `x`,+since is bound to (a,b). But in eliminating the case, if the scrutinee+is trivial, we want to bind the case-binder to the scrutinee, /not/ to+the constructor application. Hence the case_bndr_rhs in rebuildCase.++This applies equally to a non-DEFAULT case alternative, say+ let x = (a,b) in ...(case x of x' { (p,q) -> blah })...+This variant is handled by bind_case_bndr in knownCon.++We want to bind x' to x, and not to a duplicated (a,b)). -} ---------------------------------------------------------@@ -2717,19 +2763,21 @@ , let env0 = setInScopeSet env in_scope' = do { tick (KnownBranch case_bndr) ; let scaled_wfloats = map scale_float wfloats+ -- case_bndr_unf: see Note [Do not duplicate constructor applications]+ case_bndr_rhs | exprIsTrivial scrut = scrut+ | otherwise = con_app+ con_app = Var (dataConWorkId con) `mkTyApps` ty_args+ `mkApps` other_args ; case findAlt (DataAlt con) alts of- Nothing -> missingAlt env0 case_bndr alts cont- Just (Alt DEFAULT bs rhs) -> let con_app = Var (dataConWorkId con)- `mkTyApps` ty_args- `mkApps` other_args- in simple_rhs env0 scaled_wfloats con_app bs rhs- Just (Alt _ bs rhs) -> knownCon env0 scrut scaled_wfloats con ty_args other_args- case_bndr bs rhs cont+ Nothing -> missingAlt env0 case_bndr alts cont+ Just (Alt DEFAULT bs rhs) -> simple_rhs env0 scaled_wfloats case_bndr_rhs bs rhs+ Just (Alt _ bs rhs) -> knownCon env0 scrut scaled_wfloats con ty_args+ other_args case_bndr bs rhs cont } where- simple_rhs env wfloats scrut' bs rhs =+ simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $- do { (floats1, env') <- simplNonRecX env case_bndr scrut'+ do { (floats1, env') <- simplNonRecX env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let/app invariant ; (floats2, expr') <- simplExprF env' rhs cont@@ -3295,6 +3343,7 @@ | isDeadBinder bndr = return (emptyFloats env, env) | exprIsTrivial scrut = return (emptyFloats env , extendIdSubst env bndr (DoneEx scrut Nothing))+ -- See Note [Do not duplicate constructor applications] | otherwise = do { dc_args <- mapM (simplVar env) bs -- dc_ty_args are already OutTypes, -- but bs are InBndrs@@ -3428,13 +3477,14 @@ (StrictArg { sc_fun = fun, sc_cont = cont , sc_fun_ty = fun_ty }) -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable- | thumbsUpPlanA cont+ | isNothing (isDataConId_maybe (ai_fun fun))+ , thumbsUpPlanA cont -- See point (3) of Note [Duplicating join points] = -- Use Plan A of Note [Duplicating StrictArg] do { let (_ : dmds) = ai_dmds fun ; (floats1, cont') <- mkDupableContWithDmds env dmds cont -- Use the demands from the function to add the right -- demand info on any bindings we make for further args- ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg (getMode env))+ ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg env) (ai_args fun) ; return ( foldl' addLetFloats floats1 floats_s , StrictArg { sc_fun = fun { ai_args = args' }@@ -3480,7 +3530,7 @@ ; (floats1, cont') <- mkDupableContWithDmds env dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg- ; (let_floats2, arg'') <- makeTrivial (getMode env) NotTopLevel dmd (fsLit "karg") arg'+ ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats , ApplyToVal { sc_arg = arg''@@ -3537,7 +3587,7 @@ mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType -> SimplM (SimplFloats, SimplCont) mkDupableStrictBind env arg_bndr join_rhs res_ty- | exprIsDupable (targetPlatform (seDynFlags env)) join_rhs+ | exprIsTrivial join_rhs -- See point (2) of Note [Duplicating join points] = return (emptyFloats env , StrictBind { sc_bndr = arg_bndr, sc_bndrs = [] , sc_body = join_rhs@@ -3564,8 +3614,8 @@ mkDupableAlt :: Platform -> OutId -> JoinFloats -> OutAlt -> SimplM (JoinFloats, OutAlt)-mkDupableAlt platform case_bndr jfloats (Alt con bndrs' rhs')- | exprIsDupable platform rhs' -- Note [Small alternative rhs]+mkDupableAlt _platform case_bndr jfloats (Alt con bndrs' rhs')+ | exprIsTrivial rhs' -- See point (2) of Note [Duplicating join points] = return (jfloats, Alt con bndrs' rhs') | otherwise@@ -3632,6 +3682,77 @@ See #4957 a fuller example. +Note [Duplicating join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+IN #19996 we discovered that we want to be really careful about+inlining join points. Consider+ case (join $j x = K f x )+ (in case v of )+ ( p1 -> $j x1 ) of+ ( p2 -> $j x2 )+ ( p3 -> $j x3 )+ K g y -> blah[g,y]++Here the join-point RHS is very small, just a constructor+application (K x y). So we might inline it to get+ case (case v of )+ ( p1 -> K f x1 ) of+ ( p2 -> K f x2 )+ ( p3 -> K f x3 )+ K g y -> blah[g,y]++But now we have to make `blah` into a join point, /abstracted/+over `g` and `y`. In contrast, if we /don't/ inline $j we+don't need a join point for `blah` and we'll get+ join $j x = let g=f, y=x in blah[g,y]+ in case v of+ p1 -> $j x1+ p2 -> $j x2+ p3 -> $j x3++This can make a /massive/ difference, because `blah` can see+what `f` is, instead of lambda-abstracting over it.++To achieve this:++1. Do not postInlineUnconditionally a join point, until the Final+ phase. (The Final phase is still quite early, so we might consider+ delaying still more.)++2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for+ all alternatives, except for exprIsTrival RHSs. Previously we used+ exprIsDupable. This generates a lot more join points, but makes+ them much more case-of-case friendly.++ It is definitely worth checking for exprIsTrivial, otherwise we get+ an extra Simplifier iteration, because it is inlined in the next+ round.++3. By the same token we want to use Plan B in+ Note [Duplicating StrictArg] when the RHS of the new join point+ is a data constructor application. That same Note explains why we+ want Plan A when the RHS of the new join point would be a+ non-data-constructor application++4. You might worry that $j will be inlined by the call-site inliner,+ but it won't because the call-site context for a join is usually+ extremely boring (the arguments come from the pattern match).+ And if not, then perhaps inlining it would be a good idea.++ You might also wonder if we get UnfWhen, because the RHS of the+ join point is no bigger than the call. But in the cases we care+ about it will be a little bigger, because of that free `f` in+ $j x = K f x+ So for now we don't do anything special in callSiteInline++There is a bit of tension between (2) and (3). Do we want to retain+the join point only when the RHS is+* a constructor application? or+* just non-trivial?+Currently, a bit ad-hoc, but we definitely want to retain the join+point for data constructors in mkDupalbleALt (point 2); that is the+whole point of #19996 described above.+ Historical Note [Case binders and join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ NB: this entire Note is now irrelevant. In Jun 21 we stopped@@ -3686,24 +3807,6 @@ but zapping it (as we do in mkDupableCont, the Select case) is safe, and at worst delays the join-point inlining. -Note [Small alternative rhs]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-It is worth checking for a small RHS because otherwise we-get extra let bindings that may cause an extra iteration of the simplifier to-inline back in place. Quite often the rhs is just a variable or constructor.-The Ord instance of Maybe in PrelMaybe.hs, for example, took several extra-iterations because the version with the let bindings looked big, and so wasn't-inlined, but after the join points had been inlined it looked smaller, and so-was inlined.--NB: we have to check the size of rhs', not rhs.-Duplicating a small InAlt might invalidate occurrence information-However, if it *is* dupable, we return the *un* simplified alternative,-because otherwise we'd need to pair it up with an empty subst-env....-but we only have one env shared between all the alts.-(Remember we must zap the subst-env before re-simplifying something).-Rather than do this we simply agree to re-simplify the original (small) thing later.- Note [Funky mkLamTypes] ~~~~~~~~~~~~~~~~~~~~~~ Notice the funky mkLamTypes. If the constructor has existentials@@ -3749,10 +3852,18 @@ join $j x = f e1 x e3 in case x of { True -> jump $j r1 ; False -> jump $j r2 }- Notice that Plan B is very like the way we handle strict- bindings; see Note [Duplicating StrictBind]. -Plan A is good. Here's an example from #3116+ Notice that Plan B is very like the way we handle strict bindings;+ see Note [Duplicating StrictBind]. And Plan B is exactly what we'd+ get if we turned use a case expression to evaluate the strict arg:++ case (case x of { True -> r1; False -> r2 }) of+ r -> f e1 r e3++ So, looking at Note [Duplicating join points], we also want Plan B+ when `f` is a data constructor.++Plan A is often good. Here's an example from #3116 go (n+1) (case l of 1 -> bs' _ -> Chunk p fpc (o+1) (l-1) bs')@@ -3913,8 +4024,7 @@ mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource -> InId -> OutExpr -> SimplM Unfolding mkLetUnfolding !uf_opts top_lvl src id new_rhs- = is_bottoming `seq` -- See Note [Force bottoming field]- return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs)+ = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs) -- We make an unfolding *even for loop-breakers*. -- Reason: (a) It might be useful to know that they are WHNF -- (b) In GHC.Iface.Tidy we currently assume that, if we want to@@ -3922,8 +4032,11 @@ -- to expose. (We could instead use the RHS, but currently -- we don't.) The simple thing is always to have one. where- is_top_lvl = isTopLevel top_lvl- is_bottoming = isDeadEndId id+ -- Might as well force this, profiles indicate up to 0.5MB of thunks+ -- just from this site.+ !is_top_lvl = isTopLevel top_lvl+ -- See Note [Force bottoming field]+ !is_bottoming = isDeadEndId id ------------------- simplStableUnfolding :: SimplEnv -> TopLevelFlag@@ -3960,11 +4073,17 @@ , ug_boring_ok = boring_ok } -- Happens for INLINE things- -> let guide' =+ -- Really important to force new_boring_ok as otherwise+ -- `ug_boring_ok` is a thunk chain of+ -- inlineBoringExprOk expr0+ -- || inlineBoringExprOk expr1 || ...+ -- See #20134+ -> let !new_boring_ok = boring_ok || inlineBoringOk expr'+ guide' = UnfWhen { ug_arity = arity , ug_unsat_ok = sat_ok- , ug_boring_ok =- boring_ok || inlineBoringOk expr'+ , ug_boring_ok = new_boring_ok+ } -- Refresh the boring-ok flag, in case expr' -- has got small. This happens, notably in the inlinings@@ -3985,7 +4104,9 @@ | otherwise -> return noUnfolding -- Discard unstable unfoldings where uf_opts = seUnfoldingOpts env- is_top_lvl = isTopLevel top_lvl+ -- Forcing this can save about 0.5MB of max residency and the result+ -- is small and easy to compute so might as well force it.+ !is_top_lvl = isTopLevel top_lvl act = idInlineActivation id unf_env = updMode (updModeForStableUnfoldings act) env -- See Note [Simplifying inside stable unfoldings] in GHC.Core.Opt.Simplify.Utils@@ -3994,7 +4115,7 @@ eta_expand expr | not eta_on = expr | exprIsTrivial expr = expr- | otherwise = etaExpandAT id_arity expr+ | otherwise = etaExpandAT (getInScope env) id_arity expr eta_on = sm_eta_expand (getMode env) {- Note [Eta-expand stable unfoldings]@@ -4126,3 +4247,4 @@ than necesary. Allowing some inlining might, for example, eliminate a binding. -}+
compiler/GHC/Core/Opt/Simplify/Env.hs view
@@ -576,10 +576,13 @@ -- Add the let-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1-addLetFloats floats let_floats@(LetFloats binds _)+addLetFloats floats let_floats = floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats- , sfInScope = foldlOL extendInScopeSetBind- (sfInScope floats) binds }+ , sfInScope = sfInScope floats `extendInScopeFromLF` let_floats }++extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet+extendInScopeFromLF in_scope (LetFloats binds _)+ = foldlOL extendInScopeSetBind in_scope binds addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats addJoinFloats floats join_floats
compiler/GHC/Core/Opt/Simplify/Utils.hs view
@@ -409,6 +409,7 @@ contIsRhs :: SimplCont -> Bool contIsRhs (Stop _ RhsCtxt) = True+contIsRhs (CastIt _ k) = contIsRhs k -- For f = e |> co, treat e as Rhs context contIsRhs _ = False -------------------@@ -1386,6 +1387,8 @@ | isStableUnfolding unfolding = False -- Note [Stable unfoldings and postInlineUnconditionally] | isTopLevel top_lvl = False -- Note [Top level and postInlineUnconditionally] | exprIsTrivial rhs = True+ | isJoinId bndr -- See point (1) of Note [Duplicating join points]+ , not (phase == FinalPhase) = False -- in Simplify.hs | otherwise = case occ_info of OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br }@@ -1440,7 +1443,8 @@ where unfolding = idUnfolding bndr uf_opts = seUnfoldingOpts env- active = isActive (sm_phase (getMode env)) (idInlineActivation bndr)+ phase = sm_phase (getMode env)+ active = isActive phase (idInlineActivation bndr) -- See Note [pre/postInlineUnconditionally in gentle mode] {- Note [Inline small things to avoid creating a thunk]@@ -1554,11 +1558,13 @@ -- mkLam tries three things -- a) eta reduction, if that gives a trivial expression -- b) eta expansion [only if there are some value lambdas]-+--+-- NB: the SimplEnv already includes the [OutBndr] in its in-scope set mkLam _env [] body _cont = return body mkLam env bndrs body cont- = do { dflags <- getDynFlags+ = {-#SCC "mkLam" #-}+ do { dflags <- getDynFlags ; mkLam' dflags bndrs body } where mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr@@ -1592,13 +1598,16 @@ , let body_arity = exprEtaExpandArity dflags body , expandableArityType body_arity = do { tick (EtaExpansion (head bndrs))- ; let res = mkLams bndrs (etaExpandAT body_arity body)+ ; let res = mkLams bndrs $+ etaExpandAT in_scope body_arity body ; traceSmpl "eta expand" (vcat [text "before" <+> ppr (mkLams bndrs body) , text "after" <+> ppr res]) ; return res } | otherwise = return (mkLams bndrs body)+ where+ in_scope = getInScope env -- Includes 'bndrs' {- Note [Eta expanding lambdas]@@ -1661,13 +1670,13 @@ ************************************************************************ -} -tryEtaExpandRhs :: SimplMode -> OutId -> OutExpr+tryEtaExpandRhs :: SimplEnv -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] -- If tryEtaExpandRhs rhs = (n, is_bot, rhs') then -- (a) rhs' has manifest arity n -- (b) if is_bot is True then rhs' applied to n args is guaranteed bottom-tryEtaExpandRhs mode bndr rhs+tryEtaExpandRhs env bndr rhs | Just join_arity <- isJoinId_maybe bndr = do { let (join_bndrs, join_body) = collectNBinders join_arity rhs oss = [idOneShotInfo id | id <- join_bndrs, isId id]@@ -1683,12 +1692,14 @@ , new_arity > old_arity -- And the current manifest arity isn't enough , want_eta rhs = do { tick (EtaExpansion bndr)- ; return (arity_type, etaExpandAT arity_type rhs) }+ ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise = return (arity_type, rhs) where+ mode = getMode env+ in_scope = getInScope env dflags = sm_dflags mode old_arity = exprArity rhs
compiler/GHC/CoreToStg.hs view
@@ -61,7 +61,6 @@ import Control.Monad (ap) import Data.Maybe (fromMaybe) import Data.Tuple (swap)-import qualified Data.Set as Set -- Note [Live vs free] -- ~~~~~~~~~~~~~~~~~~~@@ -248,7 +247,7 @@ then collectDebugInformation dflags ml pgm' else (pgm', emptyInfoTableProvMap) - prof = WayProf `Set.member` ways dflags+ prof = ways dflags `hasWay` WayProf final_ccs | prof && gopt Opt_AutoSccsOnIndividualCafs dflags
compiler/GHC/Driver/Backpack.hs view
@@ -21,6 +21,7 @@ -- In a separate module because it hooks into the parser. import GHC.Driver.Backpack.Syntax+import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic import GHC.Driver.Monad@@ -107,7 +108,7 @@ buf <- liftIO $ hGetStringBuffer src_filename let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 -- TODO: not great case unP parseBackpack (initParserState (initParserOpts dflags) buf loc) of- PFailed pst -> throwErrors (GhcPsMessage <$> getErrorMessages pst)+ PFailed pst -> throwErrors (GhcPsMessage <$> getPsErrorMessages pst) POk _ pkgname_bkp -> do -- OK, so we have an LHsUnit PackageName, but we want an -- LHsUnit HsComponentId. So let's rename it.@@ -742,9 +743,10 @@ hsc_env <- getSession let dflags = hsc_dflags hsc_env let home_unit = hsc_home_unit hsc_env+ let fopts = initFinderOpts dflags let PackageName pn_fs = pn- location <- liftIO $ mkHomeModLocation2 dflags mod_name+ location <- liftIO $ mkHomeModLocation2 fopts mod_name (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig" env <- getBkpEnv@@ -769,6 +771,7 @@ ms_hie_date = hie_timestamp, ms_srcimps = [], ms_textual_imps = extra_sig_imports,+ ms_ghc_prim_import = False, ms_parsed_mod = Just (HsParsedModule { hpm_module = L loc (HsModule { hsmodAnn = noAnn,@@ -827,13 +830,14 @@ -- Use the PACKAGE NAME to find the location let PackageName unit_fs = pn dflags = hsc_dflags hsc_env+ fopts = initFinderOpts dflags -- Unfortunately, we have to define a "fake" location in -- order to appease the various code which uses the file -- name to figure out where to put, e.g. object files. -- To add insult to injury, we don't even actually use -- these filenames to figure out where the hi files go. -- A travesty!- location0 <- liftIO $ mkHomeModLocation2 dflags modname+ location0 <- liftIO $ mkHomeModLocation2 fopts modname (unpackFS unit_fs </> moduleNameSlashes modname) (case hsc_src of@@ -854,8 +858,9 @@ let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps -- GHC.Prim doesn't exist physically, so don't go looking for it.- ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)- ord_idecls+ (ordinary_imps, ghc_prim_import)+ = partition ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)+ ord_idecls implicit_prelude = xopt LangExt.ImplicitPrelude dflags implicit_imports = mkPrelImports modname loc@@ -884,6 +889,7 @@ ms_hspp_opts = dflags, ms_hspp_buf = Nothing, ms_srcimps = map convImport src_idecls,+ ms_ghc_prim_import = not (null ghc_prim_import), ms_textual_imps = normal_imports -- We have to do something special here: -- due to merging, requirements may end up with
compiler/GHC/Driver/CodeOutput.hs view
@@ -27,6 +27,7 @@ import GHC.Cmm.CLabel import GHC.Driver.Session+import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.CmmToAsm (initNCGConfig) import GHC.Driver.Ppr import GHC.Driver.Backend@@ -209,8 +210,8 @@ Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do- let stub_h = mkStubPaths dflags (moduleName mod) location- stub_c <- newTempName logger tmpfs dflags TFL_CurrentModule "c"+ let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location+ stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of NoStubs ->
compiler/GHC/Driver/Main.hs view
@@ -121,7 +121,7 @@ import GHC.HsToCore -import GHC.StgToByteCode ( byteCodeGen, stgExprToBCOs )+import GHC.StgToByteCode ( byteCodeGen ) import GHC.IfaceToCore ( typecheckIface ) @@ -193,8 +193,7 @@ import GHC.Types.SafeHaskell import GHC.Types.ForeignStubs import GHC.Types.Var.Env ( emptyTidyEnv )-import GHC.Types.Error hiding ( getMessages )-import qualified GHC.Types.Error as Error.Types+import GHC.Types.Error import GHC.Types.Fixity.Env import GHC.Types.CostCentre import GHC.Types.IPE@@ -224,7 +223,6 @@ import qualified GHC.SysTools import Data.Data hiding (Fixity, TyCon)-import Data.Maybe ( fromJust ) import Data.List ( nub, isPrefixOf, partition ) import Control.Monad import Data.IORef@@ -236,6 +234,7 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first)+import GHC.Data.Maybe {- ********************************************************************** %* *@@ -413,9 +412,9 @@ case unP parseMod (initParserState (initParserOpts dflags) buf loc) of PFailed pst ->- handleWarningsThrowErrors (getMessages pst)+ handleWarningsThrowErrors (getPsMessages pst) POk pst rdr_module -> do- let (warns, errs) = getMessages pst+ let (warns, errs) = getPsMessages pst logDiagnostics (GhcPsMessage <$> warns) liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed "Parser" FormatHaskell (ppr rdr_module)@@ -438,7 +437,8 @@ -- - filter out the .hs/.lhs source filename if we have one -- let n_hspp = FilePath.normalise src_filename- srcs0 = nub $ filter (not . (tmpDir dflags `isPrefixOf`))+ TempDir tmp_dir = tmpDir dflags+ srcs0 = nub $ filter (not . (tmp_dir `isPrefixOf`)) $ filter (not . (== n_hspp)) $ map FilePath.normalise $ filter (not . isPrefixOf "<")@@ -565,15 +565,13 @@ hsc_env <- getHscEnv dflags <- getDynFlags - let reason = WarningWithFlag Opt_WarnMissingSafeHaskellMode let diag_opts = initDiagOpts dflags -- -Wmissing-safe-haskell-mode when (not (safeHaskellModeEnabled dflags) && wopt Opt_WarnMissingSafeHaskellMode dflags) $ logDiagnostics $ singleMessage $ mkPlainMsgEnvelope diag_opts (getLoc (hpm_module mod)) $- GhcDriverMessage $ DriverUnknownMessage $- mkPlainDiagnostic reason noHints warnMissingSafeHaskellMode+ GhcDriverMessage $ DriverMissingSafeHaskellMode (ms_mod sum) tcg_res <- {-# SCC "Typecheck-Rename" #-} ioMsgMaybe $ hoistTcRnMessage $@@ -602,25 +600,14 @@ | safeHaskell dflags == Sf_Safe -> return () | otherwise -> (logDiagnostics $ singleMessage $ mkPlainMsgEnvelope diag_opts (warnSafeOnLoc dflags) $- GhcDriverMessage $ DriverUnknownMessage $- mkPlainDiagnostic (WarningWithFlag Opt_WarnSafe) noHints $- errSafe tcg_res')+ GhcDriverMessage $ DriverInferredSafeModule (tcg_mod tcg_res')) False | safeHaskell dflags == Sf_Trustworthy && wopt Opt_WarnTrustworthySafe dflags -> (logDiagnostics $ singleMessage $ mkPlainMsgEnvelope diag_opts (trustworthyOnLoc dflags) $- GhcDriverMessage $ DriverUnknownMessage $- mkPlainDiagnostic (WarningWithFlag Opt_WarnTrustworthySafe) noHints $- errTwthySafe tcg_res')+ GhcDriverMessage $ DriverMarkedTrustworthyButInferredSafe (tcg_mod tcg_res')) False -> return () return tcg_res'- where- pprMod t = ppr $ moduleName $ tcg_mod t- errSafe t = quotes (pprMod t) <+> text "has been inferred as safe!"- errTwthySafe t = quotes (pprMod t)- <+> text "is marked as Trustworthy but has been inferred as safe!"- warnMissingSafeHaskellMode = ppr (moduleName (ms_mod sum))- <+> text "is missing Safe Haskell mode" -- | Convert a typechecked module to Core hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts@@ -1175,12 +1162,8 @@ warns diag_opts rules = mkMessages $ listToBag $ map (warnRules diag_opts) rules warnRules :: DiagOpts -> LRuleDecl GhcTc -> MsgEnvelope DriverMessage- warnRules diag_opts (L loc (HsRule { rd_name = n })) =- mkPlainMsgEnvelope diag_opts (locA loc) $- DriverUnknownMessage $- mkPlainDiagnostic WarningWithoutFlag noHints $- text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$- text "User defined rules are disabled under Safe Haskell"+ warnRules diag_opts (L loc rule) =+ mkPlainMsgEnvelope diag_opts (locA loc) $ DriverUserDefinedRuleIgnored rule -- | Validate that safe imported modules are actually safe. For modules in the -- HomePackage (the package the module we are compiling in resides) this just@@ -1256,9 +1239,7 @@ | imv_is_safe v1 /= imv_is_safe v2 = throwOneError $ mkPlainErrorMsgEnvelope (imv_span v1) $- GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $- text "Module" <+> ppr (imv_name v1) <+>- (text $ "is imported both as a safe and unsafe import!")+ GhcDriverMessage $ DriverMixedSafetyImport (imv_name v1) | otherwise = return v1 @@ -1327,9 +1308,7 @@ -- can't load iface to check trust! Nothing -> throwOneError $ mkPlainErrorMsgEnvelope l $- GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $- text "Can't load the interface file for" <+> ppr m- <> text ", to check that it can be safely imported"+ GhcDriverMessage $ DriverCannotLoadInterfaceFile m -- got iface, check trust Just iface' ->@@ -1361,30 +1340,13 @@ state = hsc_units hsc_env inferredImportWarn diag_opts = singleMessage $ mkMsgEnvelope diag_opts l (pkgQual state)- $ GhcDriverMessage $ DriverUnknownMessage- $ mkPlainDiagnostic (WarningWithFlag Opt_WarnInferredSafeImports) noHints- $ sep- [ text "Importing Safe-Inferred module "- <> ppr (moduleName m)- <> text " from explicitly Safe module"- ]+ $ GhcDriverMessage $ DriverInferredSafeImport m pkgTrustErr = singleMessage $ mkErrorMsgEnvelope l (pkgQual state)- $ GhcDriverMessage $ DriverUnknownMessage- $ mkPlainError noHints- $ sep [ ppr (moduleName m)- <> text ": Can't be safely imported!"- , text "The package ("- <> (pprWithUnitState state $ ppr (moduleUnit m))- <> text ") the module resides in isn't trusted."- ]+ $ GhcDriverMessage $ DriverCannotImportFromUntrustedPackage state m modTrustErr = singleMessage $ mkErrorMsgEnvelope l (pkgQual state)- $ GhcDriverMessage $ DriverUnknownMessage- $ mkPlainError noHints- $ sep [ ppr (moduleName m)- <> text ": Can't be safely imported!"- , text "The module itself isn't safe." ]+ $ GhcDriverMessage $ DriverCannotImportUnsafeModule m -- | Check the package a module resides in is trusted. Safe compiled -- modules are trusted without requiring that their package is trusted. For@@ -1430,12 +1392,7 @@ = (`consBag` acc) $ mkErrorMsgEnvelope noSrcSpan (pkgQual state) $ GhcDriverMessage- $ DriverUnknownMessage- $ mkPlainError noHints- $ pprWithUnitState state- $ text "The package ("- <> ppr pkg- <> text ") is required to be trusted but it isn't!"+ $ DriverPackageNotTrusted state pkg if isEmptyBag errors then return () else liftIO $ throwErrors $ mkMessages errors@@ -1478,7 +1435,7 @@ whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" , nest 4 $ (vcat $ badFlags df) $+$- (vcat $ pprMsgEnvelopeBagWithLoc (Error.Types.getMessages whyUnsafe)) $+$+ (vcat $ pprMsgEnvelopeBagWithLoc (getMessages whyUnsafe)) $+$ (vcat $ badInsts $ tcg_insts tcg_env) ] badFlags df = concatMap (badFlag df) unsafeFlagsForInfer@@ -1564,7 +1521,7 @@ -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)- -- ^ @Just f@ <=> _stub.c is f+ -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. -- From now on, we just use the bits we need.@@ -1815,7 +1772,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Module -> ModLocation -> CoreExpr- -> IO ( StgRhs+ -> IO ( Id+ , [StgTopBinding] , InfoTableProvMap , CollectedCCs ) myCoreToStgExpr logger dflags ictxt this_mod ml prepd_expr = do@@ -1825,14 +1783,14 @@ (mkPseudoUniqueE 0) Many (exprType prepd_expr)- ([StgTopLifted (StgNonRec _ stg_expr)], prov_map, collected_ccs) <-+ (stg_binds, prov_map, collected_ccs) <- myCoreToStg logger dflags ictxt this_mod ml [NonRec bco_tmp_id prepd_expr]- return (stg_expr, prov_map, collected_ccs)+ return (bco_tmp_id, stg_binds, prov_map, collected_ccs) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Module -> ModLocation -> CoreProgram@@ -2001,7 +1959,7 @@ stg_binds data_tycons mod_breaks let src_span = srcLocSpan interactiveSrcLoc- liftIO $ loadDecls interp hsc_env (src_span, Nothing) cbc+ _ <- liftIO $ loadDecls interp hsc_env (src_span, Nothing) cbc {- Load static pointer table entries -} liftIO $ hscAddSptEntries hsc_env Nothing (cg_spt_entries tidy_cg)@@ -2129,9 +2087,9 @@ case unP parser (initParserState (initParserOpts dflags) buf loc) of PFailed pst ->- handleWarningsThrowErrors (getMessages pst)+ handleWarningsThrowErrors (getPsMessages pst) POk pst thing -> do- logWarningsReportErrors (getMessages pst)+ logWarningsReportErrors (getPsMessages pst) liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed "Parser" FormatHaskell (ppr thing) liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed_ast "Parser AST"@@ -2172,7 +2130,7 @@ ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env- ; (stg_expr, _, _) <-+ ; (binding_id, stg_expr, _, _) <- myCoreToStgExpr (hsc_logger hsc_env) (hsc_dflags hsc_env) ictxt@@ -2181,13 +2139,16 @@ prepd_expr {- Convert to BCOs -}- ; bcos <- stgExprToBCOs hsc_env+ ; bcos <- byteCodeGen hsc_env (icInteractiveModule ictxt)- (exprType prepd_expr) stg_expr+ [] Nothing {- load it -}- ; loadExpr (hscInterp hsc_env) hsc_env srcspan bcos }+ ; fv_hvs <- loadDecls (hscInterp hsc_env) hsc_env srcspan bcos+ {- Get the HValue for the root -}+ ; return (expectJust "hscCompileCoreExpr'"+ $ lookup (idName binding_id) fv_hvs) } {- **********************************************************************
compiler/GHC/Driver/Make.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-# LANGUAGE FlexibleContexts #-} -- ----------------------------------------------------------------------------- --@@ -41,6 +42,7 @@ ) where import GHC.Prelude+import GHC.Platform import GHC.Tc.Utils.Backpack import GHC.Tc.Utils.Monad ( initIfaceCheck )@@ -51,6 +53,7 @@ import GHC.Runtime.Context +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic@@ -78,7 +81,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Utils.Exception ( AsyncException(..), evaluate )-import GHC.Utils.Monad ( allM )+import GHC.Utils.Monad ( allM, MonadIO ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain@@ -87,7 +90,6 @@ import GHC.Utils.Logger import GHC.Utils.Fingerprint import GHC.Utils.TmpFs-import GHC.Utils.Constants (isWindowsHost) import GHC.Types.Basic import GHC.Types.Error@@ -102,7 +104,6 @@ import GHC.Types.Name.Env import GHC.Unit-import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface@@ -124,7 +125,7 @@ import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import qualified Control.Monad.Catch as MC import Data.IORef-import Data.List (nub, sort, sortBy, partition)+import Data.List (sortBy, partition) import qualified Data.List as List import Data.Foldable (toList) import Data.Maybe@@ -338,7 +339,7 @@ load how_much = do (errs, mod_graph) <- depanalE [] False -- #17459 success <- load' how_much (Just batchMsg) mod_graph- warnUnusedPackages+ warnUnusedPackages mod_graph if isEmptyMessages errs then pure success else throwErrors (fmap GhcDriverMessage errs)@@ -350,24 +351,21 @@ -- actually loaded packages. All the packages, specified on command line, -- but never loaded, are probably unused dependencies. -warnUnusedPackages :: GhcMonad m => m ()-warnUnusedPackages = do+warnUnusedPackages :: GhcMonad m => ModuleGraph -> m ()+warnUnusedPackages mod_graph = do hsc_env <- getSession- eps <- liftIO $ hscEPS hsc_env let dflags = hsc_dflags hsc_env state = hsc_units hsc_env- pit = eps_PIT eps diag_opts = initDiagOpts dflags+ us = hsc_units hsc_env - let loadedPackages- = map (unsafeLookupUnit state)- . nub . sort- . map moduleUnit- . moduleEnvKeys- $ pit+ -- Only need non-source imports here because SOURCE imports are always HPT+ let loadedPackages = concat $+ mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs)+ $ concatMap ms_imps (mgModSummaries mod_graph) - requestedArgs = mapMaybe packageArg (packageFlags dflags)+ let requestedArgs = mapMaybe packageArg (packageFlags dflags) unusedArgs = filter (\arg -> not $ any (matching state arg) loadedPackages)@@ -541,7 +539,7 @@ -- Clean up after ourselves hsc_env1 <- getSession- liftIO $ cleanCurrentModuleTempFiles logger (hsc_tmpfs hsc_env1) dflags+ liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags -- Issue a warning for the confusing case where the user -- said '-o foo' but we're not going to do any linking.@@ -608,7 +606,7 @@ ] tmpfs <- hsc_tmpfs <$> getSession liftIO $ changeTempFilesLifetime tmpfs TFL_CurrentModule unneeded_temps- liftIO $ cleanCurrentModuleTempFiles logger tmpfs dflags+ liftIO $ cleanCurrentModuleTempFilesMaybe logger tmpfs dflags let hpt5 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep) hpt4@@ -697,6 +695,7 @@ guessOutputFile :: GhcMonad m => m () guessOutputFile = modifySession $ \env -> let dflags = hsc_dflags env+ platform = targetPlatform dflags -- Force mod_graph to avoid leaking env !mod_graph = hsc_mod_graph env mainModuleSrcPath :: Maybe String@@ -709,7 +708,7 @@ -- we must add the .exe extension unconditionally here, otherwise -- when name has an extension of its own, the .exe extension will -- not be added by GHC.Driver.Pipeline.exeFileName. See #2248- name' <- if isWindowsHost --FIXME: should be the target platform+ name' <- if platformOS platform == OSMinGW32 then fmap (<.> "exe") name else name mainModuleSrcPath' <- mainModuleSrcPath@@ -1337,9 +1336,9 @@ return (hsc_env'', localize_hsc_env hsc_env'') -- Clean up any intermediate files.- cleanCurrentModuleTempFiles (hsc_logger lcl_hsc_env')- (hsc_tmpfs lcl_hsc_env')- (hsc_dflags lcl_hsc_env')+ cleanCurrentModuleTempFilesMaybe (hsc_logger lcl_hsc_env')+ (hsc_tmpfs lcl_hsc_env')+ (hsc_dflags lcl_hsc_env') return Succeeded where@@ -1437,9 +1436,9 @@ hsc_env <- getSession -- Remove unwanted tmp files between compilations- liftIO $ cleanCurrentModuleTempFiles (hsc_logger hsc_env)- (hsc_tmpfs hsc_env)- (hsc_dflags hsc_env)+ liftIO $ cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env)+ (hsc_tmpfs hsc_env)+ (hsc_dflags hsc_env) -- Get ready to tie the knot type_env_var <- liftIO $ newIORef emptyNameEnv@@ -1557,7 +1556,7 @@ compile_it :: Maybe Linkable -> IO HomeModInfo compile_it mb_linkable =- compileOne' Nothing mHscMessage hsc_env summary mod_index nmods+ compileOne' mHscMessage hsc_env summary mod_index nmods mb_old_iface mb_linkable in@@ -2177,7 +2176,7 @@ , ms_mod `Set.member` needs_codegen_set = do let new_temp_file suf dynsuf = do- tn <- newTempName logger tmpfs dflags staticLife suf+ tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] return tn@@ -2313,9 +2312,10 @@ preimps@PreprocessedImports {..} <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf + let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file- location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) pi_mod_name src_fn+ location <- liftIO $ mkHomeModLocation fopts pi_mod_name src_fn -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path@@ -2430,6 +2430,7 @@ | otherwise = find_it where dflags = hsc_dflags hsc_env+ fopts = initFinderOpts dflags home_unit = hsc_home_unit hsc_env fc = hsc_FC hsc_env units = hsc_units hsc_env@@ -2441,7 +2442,7 @@ old_summary location find_it = do- found <- findImportedModule fc units home_unit dflags wanted_mod Nothing+ found <- findImportedModule fc fopts units home_unit wanted_mod Nothing case found of Found location mod | isJust (ml_hs_file location) ->@@ -2540,6 +2541,7 @@ , ms_hspp_buf = Just pi_hspp_buf , ms_parsed_mod = Nothing , ms_srcimps = pi_srcimps+ , ms_ghc_prim_import = pi_ghc_prim_import , ms_textual_imps = pi_theimps ++ extra_sig_imports ++@@ -2558,6 +2560,7 @@ { pi_local_dflags :: DynFlags , pi_srcimps :: [(Maybe FastString, Located ModuleName)] , pi_theimps :: [(Maybe FastString, Located ModuleName)]+ , pi_ghc_prim_import :: Bool , pi_hspp_fn :: FilePath , pi_hspp_buf :: StringBuffer , pi_mod_name_loc :: SrcSpan@@ -2577,7 +2580,7 @@ (pi_local_dflags, pi_hspp_fn) <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn- (pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name)+ (pi_srcimps, pi_theimps, pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name) <- ExceptT $ do let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags popts = initParserOpts pi_local_dflags@@ -2711,3 +2714,9 @@ ppr_ms :: ModSummary -> SDoc ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+> (parens (text (msHsFilePath ms)))+++cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()+cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =+ unless (gopt Opt_KeepTmpFiles dflags) $+ liftIO $ cleanCurrentModuleTempFiles logger tmpfs
compiler/GHC/Driver/MakeFile.hs view
@@ -16,6 +16,7 @@ import GHC.Prelude import qualified GHC+import GHC.Driver.Config.Finder import GHC.Driver.Monad import GHC.Driver.Session import GHC.Driver.Ppr@@ -136,7 +137,7 @@ beginMkDependHS logger tmpfs dflags = do -- open a new temp file in which to stuff the dependency info -- as we go along.- tmp_file <- newTempName logger tmpfs dflags TFL_CurrentModule "dep"+ tmp_file <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "dep" tmp_hdl <- openFile tmp_file WriteMode -- open the makefile@@ -291,9 +292,10 @@ let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env+ let fopts = initFinderOpts dflags -- Find the module; this will be fast because -- we've done it once during downsweep- r <- findImportedModule fc units home_unit dflags imp pkg+ r <- findImportedModule fc fopts units home_unit imp pkg case r of Found loc _ -- Home package: just depend on the .hi or hi-boot file
compiler/GHC/Driver/Pipeline.hs view
@@ -1,2251 +1,969 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NondecreasingIndentation #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE LambdaCase #-}--{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}------------------------------------------------------------------------------------- GHC Driver------ (c) The University of Glasgow 2005-----------------------------------------------------------------------------------module GHC.Driver.Pipeline (- -- Run a series of compilation steps in a pipeline, for a- -- collection of source files.- oneShot, compileFile,-- -- Interfaces for the compilation manager (interpreted/batch-mode)- preprocess,- compileOne, compileOne',- link,-- -- Exports for hooks to override runPhase and link- PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),- phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,- hscPostBackendPhase, getLocation, setModLocation, setDynFlags,- runPhase,- doCpp,- linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode- ) where--#include "ghcplatform.h"-import GHC.Prelude--import GHC.Platform--import GHC.Tc.Types-import GHC.Tc.Utils.Monad hiding ( getImports )--import GHC.Driver.Main-import GHC.Driver.Env hiding ( Hsc )-import GHC.Driver.Errors-import GHC.Driver.Errors.Types-import GHC.Driver.Pipeline.Monad-import GHC.Driver.Config.Parser (initParserOpts)-import GHC.Driver.Config.Diagnostic-import GHC.Driver.Phases-import GHC.Driver.Session-import GHC.Driver.Backend-import GHC.Driver.Ppr-import GHC.Driver.Hooks--import GHC.Platform.Ways-import GHC.Platform.ArchOS--import GHC.Parser.Header--import GHC.SysTools-import GHC.Utils.TmpFs--import GHC.Linker.ExtraObj-import GHC.Linker.Dynamic-import GHC.Linker.Static-import GHC.Linker.Types--import GHC.Utils.Outputable-import GHC.Utils.Error-import GHC.Utils.Fingerprint-import GHC.Utils.Panic-import GHC.Utils.Panic.Plain-import GHC.Utils.Misc-import GHC.Utils.Exception as Exception-import GHC.Utils.Logger--import GHC.CmmToLlvm ( llvmFixupAsm, llvmVersionList )-import qualified GHC.LanguageExtensions as LangExt-import GHC.Settings--import GHC.Data.FastString ( mkFastString )-import GHC.Data.StringBuffer ( hGetStringBuffer, hPutStringBuffer )-import GHC.Data.Maybe ( expectJust )--import GHC.Iface.Make ( mkFullIface )-import GHC.Runtime.Loader ( initializePlugins )---import GHC.Types.Basic ( SuccessFlag(..) )-import GHC.Types.Error ( singleMessage, getMessages )-import GHC.Types.Name.Env-import GHC.Types.Target-import GHC.Types.SrcLoc-import GHC.Types.SourceFile-import GHC.Types.SourceError--import GHC.Unit-import GHC.Unit.Env-import GHC.Unit.Finder-import GHC.Unit.Module.ModSummary-import GHC.Unit.Module.ModIface-import GHC.Unit.Module.Graph (needsTemplateHaskellOrQQ)-import GHC.Unit.Module.Deps-import GHC.Unit.Home.ModInfo--import System.Directory-import System.FilePath-import System.IO-import Control.Monad-import qualified Control.Monad.Catch as MC (handle)-import Data.IORef-import Data.List ( isInfixOf, intercalate )-import Data.Maybe-import Data.Version-import Data.Either ( partitionEithers )--import Data.Time ( getCurrentTime )---- ------------------------------------------------------------------------------ Pre-process---- | Just preprocess a file, put the result in a temp. file (used by the--- compilation manager during the summary phase).------ We return the augmented DynFlags, because they contain the result--- of slurping in the OPTIONS pragmas--preprocess :: HscEnv- -> FilePath -- ^ input filename- -> Maybe InputFileBuffer- -- ^ optional buffer to use instead of reading the input file- -> Maybe Phase -- ^ starting phase- -> IO (Either DriverMessages (DynFlags, FilePath))-preprocess hsc_env input_fn mb_input_buf mb_phase =- handleSourceError (\err -> return $ Left $ to_driver_messages $ srcErrorMessages err) $- MC.handle handler $- fmap Right $ do- massertPpr (isJust mb_phase || isHaskellSrcFilename input_fn) (text input_fn)- (dflags, fp, mb_iface, mb_linkable) <- runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase)- Nothing- -- We keep the processed file for the whole session to save on- -- duplicated work in ghci.- (Temporary TFL_GhcSession)- Nothing{-no ModLocation-}- []{-no foreign objects-}- -- We stop before Hsc phase so we shouldn't generate an interface- massert (isNothing mb_iface)- massert (isNothing mb_linkable)- return (dflags, fp)- where- srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1- handler (ProgramError msg) =- return $ Left $ singleMessage $- mkPlainErrorMsgEnvelope srcspan $- DriverUnknownMessage $ mkPlainError noHints $ text msg- handler ex = throwGhcExceptionIO ex-- to_driver_messages :: Messages GhcMessage -> Messages DriverMessage- to_driver_messages msgs = case traverse to_driver_message msgs of- Nothing -> pprPanic "non-driver message in preprocess"- (vcat $ pprMsgEnvelopeBagWithLoc (getMessages msgs))- Just msgs' -> msgs'-- to_driver_message = \case- GhcDriverMessage msg- -> Just msg- GhcPsMessage (PsHeaderMessage msg)- -> Just (DriverPsHeaderMessage (PsHeaderMessage msg))- _ -> Nothing---- ------------------------------------------------------------------------------- | Compile------ Compile a single module, under the control of the compilation manager.------ This is the interface between the compilation manager and the--- compiler proper (hsc), where we deal with tedious details like--- reading the OPTIONS pragma from the source file, converting the--- C or assembly that GHC produces into an object file, and compiling--- FFI stub files.------ NB. No old interface can also mean that the source has changed.--compileOne :: HscEnv- -> ModSummary -- ^ summary for module being compiled- -> Int -- ^ module N ...- -> Int -- ^ ... of M- -> Maybe ModIface -- ^ old interface, if we have one- -> Maybe Linkable -- ^ old linkable, if we have one- -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful--compileOne = compileOne' Nothing (Just batchMsg)--compileOne' :: Maybe TcGblEnv- -> Maybe Messager- -> HscEnv- -> ModSummary -- ^ summary for module being compiled- -> Int -- ^ module N ...- -> Int -- ^ ... of M- -> Maybe ModIface -- ^ old interface, if we have one- -> Maybe Linkable -- ^ old linkable, if we have one- -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful--compileOne' m_tc_result mHscMessage- hsc_env0 summary mod_index nmods mb_old_iface mb_old_linkable- = do-- debugTraceMsg logger 2 (text "compile: input file" <+> text input_fnpp)-- let flags = hsc_dflags hsc_env0- in do unless (gopt Opt_KeepHiFiles flags) $- addFilesToClean tmpfs TFL_CurrentModule $- [ml_hi_file $ ms_location summary]- unless (gopt Opt_KeepOFiles flags) $- addFilesToClean tmpfs TFL_GhcSession $- [ml_obj_file $ ms_location summary]-- plugin_hsc_env <- initializePlugins hsc_env (Just (ms_mnwib summary))- let runPostTc = compileOnePostTc plugin_hsc_env summary-- case m_tc_result of- Just tc_result- | not always_do_basic_recompilation_check -> do- runPostTc (FrontendTypecheck tc_result) emptyMessages Nothing- _ -> do- status <- hscRecompStatus mHscMessage plugin_hsc_env summary- mb_old_iface mb_old_linkable (mod_index, nmods)-- case status of- HscUpToDate iface old_linkable -> do- massert ( isJust old_linkable || isNoLink (ghcLink dflags) )- -- See Note [ModDetails and --make mode]- details <- initModDetails plugin_hsc_env summary iface- return $! HomeModInfo iface details old_linkable- HscRecompNeeded mb_old_hash -> do- (tc_result, warnings) <- hscTypecheckAndGetWarnings plugin_hsc_env summary- runPostTc tc_result warnings mb_old_hash-- where lcl_dflags = ms_hspp_opts summary- location = ms_location summary- input_fn = expectJust "compile:hs" (ml_hs_file location)- input_fnpp = ms_hspp_file summary- mod_graph = hsc_mod_graph hsc_env0- needsLinker = needsTemplateHaskellOrQQ mod_graph- isDynWay = any (== WayDyn) (ways lcl_dflags)- isProfWay = any (== WayProf) (ways lcl_dflags)- internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)-- logger = hsc_logger hsc_env0- tmpfs = hsc_tmpfs hsc_env0-- -- #8180 - when using TemplateHaskell, switch on -dynamic-too so- -- the linker can correctly load the object files. This isn't necessary- -- when using -fexternal-interpreter.- dflags1 = if hostIsDynamic && internalInterpreter &&- not isDynWay && not isProfWay && needsLinker- then gopt_set lcl_dflags Opt_BuildDynamicToo- else lcl_dflags-- -- #16331 - when no "internal interpreter" is available but we- -- need to process some TemplateHaskell or QuasiQuotes, we automatically- -- turn on -fexternal-interpreter.- dflags2 = if not internalInterpreter && needsLinker- then gopt_set dflags1 Opt_ExternalInterpreter- else dflags1-- basename = dropExtension input_fn-- -- We add the directory in which the .hs files resides) to the import- -- path. This is needed when we try to compile the .hc file later, if it- -- imports a _stub.h file that we created here.- current_dir = takeDirectory basename- old_paths = includePaths dflags2- loadAsByteCode- | Just Target { targetAllowObjCode = obj } <- findTarget summary (hsc_targets hsc_env0)- , not obj- = True- | otherwise = False- -- Figure out which backend we're using- (bcknd, dflags3)- -- #8042: When module was loaded with `*` prefix in ghci, but DynFlags- -- suggest to generate object code (which may happen in case -fobject-code- -- was set), force it to generate byte-code. This is NOT transitive and- -- only applies to direct targets.- | loadAsByteCode- = (Interpreter, gopt_set (dflags2 { backend = Interpreter }) Opt_ForceRecomp)- | otherwise- = (backend dflags, dflags2)- dflags = dflags3 { includePaths = addImplicitQuoteInclude old_paths [current_dir] }- hsc_env = hscSetFlags dflags hsc_env0-- always_do_basic_recompilation_check = case bcknd of- Interpreter -> True- _ -> False---- | Do the post typechecking compilation of a module in the --make mode-compileOnePostTc- :: HscEnv- -> ModSummary- -> FrontendResult- -> WarningMessages- -> Maybe Fingerprint- -> IO HomeModInfo-compileOnePostTc hsc_env summary tc_result warnings mb_old_hash = do- output_fn <- getOutputFilename logger tmpfs next_phase- (Temporary TFL_CurrentModule)- basename dflags next_phase (Just location)- (_, _, Just iface, mb_linkable) <- runPipeline StopLn hsc_env- (output_fn,- Nothing,- Just (HscPostTc summary tc_result warnings mb_old_hash))- (Just basename)- pipelineOutput- (Just location)- []- -- TODO: figure out a way to set this in runPipeline for HsSrcFile- mLinkable <- case () of- _ | Just l <- mb_linkable -> return $ Just l- | bcknd == NoBackend -> return Nothing- | src_flavour == HsSrcFile -> do- -- The object filename comes from the ModLocation- o_time <- getModificationUTCTime object_filename- let !linkable = LM o_time this_mod [DotO object_filename]- return $ Just linkable- | otherwise -> return Nothing- -- See Note [ModDetails and --make mode]- details <- initModDetails hsc_env summary iface- return $! HomeModInfo iface details mLinkable-- where dflags = hsc_dflags hsc_env- this_mod = ms_mod summary- location = ms_location summary- input_fn = expectJust "compile:hs" (ml_hs_file location)-- logger = hsc_logger hsc_env- tmpfs = hsc_tmpfs hsc_env- src_flavour = ms_hsc_src summary- next_phase = hscPostBackendPhase src_flavour bcknd- bcknd = backend dflags- object_filename = ml_obj_file location-- basename = dropExtension input_fn-- pipelineOutput = case bcknd of- Interpreter -> NoOutputFile- NoBackend -> NoOutputFile- _ -> Persistent---------------------------------------------------------------------------------- stub .h and .c files (for foreign export support), and cc files.---- The _stub.c file is derived from the haskell source file, possibly taking--- into account the -stubdir option.------ The object file created by compiling the _stub.c file is put into a--- temporary file, which will be later combined with the main .o file--- (see the MergeForeigns phase).------ Moreover, we also let the user emit arbitrary C/C++/ObjC/ObjC++ files--- from TH, that are then compiled and linked to the module. This is--- useful to implement facilities such as inline-c.--compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath-compileForeign _ RawObject object_file = return object_file-compileForeign hsc_env lang stub_c = do- let phase = case lang of- LangC -> Cc- LangCxx -> Ccxx- LangObjc -> Cobjc- LangObjcxx -> Cobjcxx- LangAsm -> As True -- allow CPP-#if __GLASGOW_HASKELL__ < 811- RawObject -> panic "compileForeign: should be unreachable"-#endif- (_, stub_o, _, _) <- runPipeline StopLn hsc_env- (stub_c, Nothing, Just (RealPhase phase))- Nothing (Temporary TFL_GhcSession)- Nothing{-no ModLocation-}- []- return stub_o--compileStub :: HscEnv -> FilePath -> IO FilePath-compileStub hsc_env stub_c = compileForeign hsc_env LangC stub_c--compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()-compileEmptyStub dflags hsc_env basename location mod_name = do- -- To maintain the invariant that every Haskell file- -- compiles to object code, we make an empty (but- -- valid) stub object file for signatures. However,- -- we make sure this object file has a unique symbol,- -- so that ranlib on OS X doesn't complain, see- -- https://gitlab.haskell.org/ghc/ghc/issues/12673- -- and https://github.com/haskell/cabal/issues/2257- let logger = hsc_logger hsc_env- let tmpfs = hsc_tmpfs hsc_env- empty_stub <- newTempName logger tmpfs dflags TFL_CurrentModule "c"- let home_unit = hsc_home_unit hsc_env- src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"- writeFile empty_stub (showSDoc dflags (pprCode CStyle src))- _ <- runPipeline StopLn hsc_env- (empty_stub, Nothing, Nothing)- (Just basename)- Persistent- (Just location)- []- return ()---- ------------------------------------------------------------------------------ Link------ Note [Dynamic linking on macOS]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ Since macOS Sierra (10.14), the dynamic system linker enforces--- a limit on the Load Commands. Specifically the Load Command Size--- Limit is at 32K (32768). The Load Commands contain the install--- name, dependencies, runpaths, and a few other commands. We however--- only have control over the install name, dependencies and runpaths.------ The install name is the name by which this library will be--- referenced. This is such that we do not need to bake in the full--- absolute location of the library, and can move the library around.------ The dependency commands contain the install names from of referenced--- libraries. Thus if a libraries install name is @rpath/libHS...dylib,--- that will end up as the dependency.------ Finally we have the runpaths, which informs the linker about the--- directories to search for the referenced dependencies.------ The system linker can do recursive linking, however using only the--- direct dependencies conflicts with ghc's ability to inline across--- packages, and as such would end up with unresolved symbols.------ Thus we will pass the full dependency closure to the linker, and then--- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs).------ We still need to add the relevant runpaths, for the dynamic linker to--- lookup the referenced libraries though. The linker (ld64) does not--- have any option to dead strip runpaths; which makes sense as runpaths--- can be used for dependencies of dependencies as well.------ The solution we then take in GHC is to not pass any runpaths to the--- linker at link time, but inject them after the linking. For this to--- work we'll need to ask the linker to create enough space in the header--- to add more runpaths after the linking (-headerpad 8000).------ After the library has been linked by $LD (usually ld64), we will use--- otool to inspect the libraries left over after dead stripping, compute--- the relevant runpaths, and inject them into the linked product using--- the install_name_tool command.------ This strategy should produce the smallest possible set of load commands--- while still retaining some form of relocatability via runpaths.------ The only way I can see to reduce the load command size further would be--- by shortening the library names, or start putting libraries into the same--- folders, such that one runpath would be sufficient for multiple/all--- libraries.-link :: GhcLink -- ^ interactive or batch- -> Logger -- ^ Logger- -> TmpFs- -> Hooks- -> DynFlags -- ^ dynamic flags- -> UnitEnv -- ^ unit environment- -> Bool -- ^ attempt linking in batch mode?- -> HomePackageTable -- ^ what to link- -> IO SuccessFlag---- For the moment, in the batch linker, we don't bother to tell doLink--- which packages to link -- it just tries all that are available.--- batch_attempt_linking should only be *looked at* in batch mode. It--- should only be True if the upsweep was successful and someone--- exports main, i.e., we have good reason to believe that linking--- will succeed.--link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt =- case linkHook hooks of- Nothing -> case ghcLink of- NoLink -> return Succeeded- LinkBinary -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt- LinkStaticLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt- LinkDynLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt- LinkInMemory- | platformMisc_ghcWithInterpreter $ platformMisc dflags- -> -- Not Linking...(demand linker will do the job)- return Succeeded- | otherwise- -> panicBadLink LinkInMemory- Just h -> h ghcLink dflags batch_attempt_linking hpt---panicBadLink :: GhcLink -> a-panicBadLink other = panic ("link: GHC not built to link this way: " ++- show other)--link' :: Logger- -> TmpFs- -> DynFlags -- ^ dynamic flags- -> UnitEnv -- ^ unit environment- -> Bool -- ^ attempt linking in batch mode?- -> HomePackageTable -- ^ what to link- -> IO SuccessFlag--link' logger tmpfs dflags unit_env batch_attempt_linking hpt- | batch_attempt_linking- = do- let- staticLink = case ghcLink dflags of- LinkStaticLib -> True- _ -> False-- home_mod_infos = eltsHpt hpt-- -- the packages we depend on- pkg_deps = concatMap (dep_direct_pkgs . mi_deps . hm_iface) home_mod_infos-- -- the linkables to link- linkables = map (expectJust "link".hm_linkable) home_mod_infos-- debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))-- -- check for the -no-link flag- if isNoLink (ghcLink dflags)- then do debugTraceMsg logger 3 (text "link(batch): linking omitted (-c flag given).")- return Succeeded- else do-- let getOfiles LM{ linkableUnlinked } = map nameOfObject (filter isObject linkableUnlinked)- obj_files = concatMap getOfiles linkables- platform = targetPlatform dflags- exe_file = exeFileName platform staticLink (outputFile dflags)-- linking_needed <- linkingNeeded logger dflags unit_env staticLink linkables pkg_deps-- if not (gopt Opt_ForceRecomp dflags) && not linking_needed- then do debugTraceMsg logger 2 (text exe_file <+> text "is up to date, linking not required.")- return Succeeded- else do-- compilationProgressMsg logger (text "Linking " <> text exe_file <> text " ...")-- -- Don't showPass in Batch mode; doLink will do that for us.- let link = case ghcLink dflags of- LinkBinary -> linkBinary logger tmpfs- LinkStaticLib -> linkStaticLib logger- LinkDynLib -> linkDynLibCheck logger tmpfs- other -> panicBadLink other- link dflags unit_env obj_files pkg_deps-- debugTraceMsg logger 3 (text "link: done")-- -- linkBinary only returns if it succeeds- return Succeeded-- | otherwise- = do debugTraceMsg logger 3 (text "link(batch): upsweep (partially) failed OR" $$- text " Main.main not exported; not linking.")- return Succeeded---linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO Bool-linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do- -- if the modification time on the executable is later than the- -- modification times on all of the objects and libraries, then omit- -- linking (unless the -fforce-recomp flag was given).- let platform = ue_platform unit_env- unit_state = ue_units unit_env- exe_file = exeFileName platform staticLink (outputFile dflags)- e_exe_time <- tryIO $ getModificationUTCTime exe_file- case e_exe_time of- Left _ -> return True- Right t -> do- -- first check object files and extra_ld_inputs- let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]- e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs- let (errs,extra_times) = partitionEithers e_extra_times- let obj_times = map linkableTime linkables ++ extra_times- if not (null errs) || any (t <) obj_times- then return True- else do-- -- next, check libraries. XXX this only checks Haskell libraries,- -- not extra_libraries or -l things from the command line.- let pkg_hslibs = [ (collectLibraryDirs (ways dflags) [c], lib)- | Just c <- map (lookupUnitId unit_state) pkg_deps,- lib <- unitHsLibs (ghcNameVersion dflags) (ways dflags) c ]-- pkg_libfiles <- mapM (uncurry (findHSLib platform (ways dflags))) pkg_hslibs- if any isNothing pkg_libfiles then return True else do- e_lib_times <- mapM (tryIO . getModificationUTCTime)- (catMaybes pkg_libfiles)- let (lib_errs,lib_times) = partitionEithers e_lib_times- if not (null lib_errs) || any (t <) lib_times- then return True- else checkLinkInfo logger dflags unit_env pkg_deps exe_file--findHSLib :: Platform -> Ways -> [String] -> String -> IO (Maybe FilePath)-findHSLib platform ws dirs lib = do- let batch_lib_file = if WayDyn `notElem` ws- then "lib" ++ lib <.> "a"- else platformSOName platform lib- found <- filterM doesFileExist (map (</> batch_lib_file) dirs)- case found of- [] -> return Nothing- (x:_) -> return (Just x)---- -------------------------------------------------------------------------------- Compile files in one-shot mode.--oneShot :: HscEnv -> Phase -> [(String, Maybe Phase)] -> IO ()-oneShot hsc_env stop_phase srcs = do- o_files <- mapM (compileFile hsc_env stop_phase) srcs- doLink hsc_env stop_phase o_files--compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath-compileFile hsc_env stop_phase (src, mb_phase) = do- exists <- doesFileExist src- when (not exists) $- throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))-- let- dflags = hsc_dflags hsc_env- mb_o_file = outputFile dflags- ghc_link = ghcLink dflags -- Set by -c or -no-link-- -- When linking, the -o argument refers to the linker's output.- -- otherwise, we use it as the name for the pipeline's output.- output- | NoBackend <- backend dflags = NoOutputFile- | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent- -- -o foo applies to linker- | isJust mb_o_file = SpecificFile- -- -o foo applies to the file we are compiling now- | otherwise = Persistent-- ( _, out_file, _, _) <- runPipeline stop_phase hsc_env- (src, Nothing, fmap RealPhase mb_phase)- Nothing- output- Nothing{-no ModLocation-} []- return out_file---doLink :: HscEnv -> Phase -> [FilePath] -> IO ()-doLink hsc_env stop_phase o_files- | not (isStopLn stop_phase)- = return () -- We stopped before the linking phase-- | otherwise- = let- dflags = hsc_dflags hsc_env- logger = hsc_logger hsc_env- unit_env = hsc_unit_env hsc_env- tmpfs = hsc_tmpfs hsc_env- in case ghcLink dflags of- NoLink -> return ()- LinkBinary -> linkBinary logger tmpfs dflags unit_env o_files []- LinkStaticLib -> linkStaticLib logger dflags unit_env o_files []- LinkDynLib -> linkDynLibCheck logger tmpfs dflags unit_env o_files []- other -> panicBadLink other----- ------------------------------------------------------------------------------- | Run a compilation pipeline, consisting of multiple phases.------ This is the interface to the compilation pipeline, which runs--- a series of compilation steps on a single source file, specifying--- at which stage to stop.------ The DynFlags can be modified by phases in the pipeline (eg. by--- OPTIONS_GHC pragmas), and the changes affect later phases in the--- pipeline.-runPipeline- :: Phase -- ^ When to stop- -> HscEnv -- ^ Compilation environment- -> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)- -- ^ Pipeline input file name, optional- -- buffer and maybe -x suffix- -> Maybe FilePath -- ^ original basename (if different from ^^^)- -> PipelineOutput -- ^ Output filename- -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module- -> [FilePath] -- ^ foreign objects- -> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)- -- ^ (final flags, output filename, interface, linkable)-runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)- mb_basename output maybe_loc foreign_os-- = do let- -- Decide where dump files should go based on the pipeline output- hsc_env = hscUpdateFlags (\dflags -> dflags { dumpPrefix = Just (basename ++ ".")}) hsc_env0- logger = hsc_logger hsc_env- tmpfs = hsc_tmpfs hsc_env- dflags = hsc_dflags hsc_env-- (input_basename, suffix) = splitExtension input_fn- suffix' = drop 1 suffix -- strip off the .- basename | Just b <- mb_basename = b- | otherwise = input_basename-- -- If we were given a -x flag, then use that phase to start from- start_phase = fromMaybe (RealPhase (startPhase suffix')) mb_phase-- isHaskell (RealPhase (Unlit _)) = True- isHaskell (RealPhase (Cpp _)) = True- isHaskell (RealPhase (HsPp _)) = True- isHaskell (RealPhase (Hsc _)) = True- isHaskell (HscPostTc {}) = True- isHaskell (HscBackend {}) = True- isHaskell _ = False-- isHaskellishFile = isHaskell start_phase-- env = PipeEnv{ stop_phase,- src_filename = input_fn,- src_basename = basename,- src_suffix = suffix',- output_spec = output }-- when (isBackpackishSuffix suffix') $- throwGhcExceptionIO (UsageError- ("use --backpack to process " ++ input_fn))-- -- We want to catch cases of "you can't get there from here" before- -- we start the pipeline, because otherwise it will just run off the- -- end.- let happensBefore' = happensBefore (targetPlatform dflags)- case start_phase of- RealPhase start_phase' ->- -- See Note [Partial ordering on phases]- -- Not the same as: (stop_phase `happensBefore` start_phase')- when (not (start_phase' `happensBefore'` stop_phase ||- start_phase' `eqPhase` stop_phase)) $- throwGhcExceptionIO (UsageError- ("cannot compile this file to desired target: "- ++ input_fn))- HscPostTc {} -> return ()- HscBackend {} -> return ()-- -- Write input buffer to temp file if requested- input_fn' <- case (start_phase, mb_input_buf) of- (RealPhase real_start_phase, Just input_buf) -> do- let suffix = phaseInputExt real_start_phase- fn <- newTempName logger tmpfs dflags TFL_CurrentModule suffix- hdl <- openBinaryFile fn WriteMode- -- Add a LINE pragma so reported source locations will- -- mention the real input file, not this temp file.- hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}"- hPutStringBuffer hdl input_buf- hClose hdl- return fn- (_, _) -> return input_fn-- debugTraceMsg logger 4 (text "Running the pipeline")- r <- runPipeline' start_phase hsc_env env input_fn'- maybe_loc foreign_os-- when isHaskellishFile $- dynamicTooState dflags >>= \case- DT_Dont -> return ()- DT_Dyn -> return ()- DT_OK -> return ()- -- If we are compiling a Haskell module with -dynamic-too, we- -- first try the "fast path": that is we compile the non-dynamic- -- version and at the same time we check that interfaces depended- -- on exist both for the non-dynamic AND the dynamic way. We also- -- check that they have the same hash.- -- If they don't, dynamicTooState is set to DT_Failed.- -- See GHC.Iface.Load.checkBuildDynamicToo- -- If they do, in the end we produce both the non-dynamic and- -- dynamic outputs.- --- -- If this "fast path" failed, we execute the whole pipeline- -- again, this time for the dynamic way *only*. To do that we- -- just set the dynamicNow bit from the start to ensure that the- -- dynamic DynFlags fields are used and we disable -dynamic-too- -- (its state is already set to DT_Failed so it wouldn't do much- -- anyway).- DT_Failed- -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)- | OSMinGW32 <- platformOS (targetPlatform dflags) -> return ()- | otherwise -> do- debugTraceMsg logger 4- (text "Running the full pipeline again for -dynamic-too")- let dflags0 = flip gopt_unset Opt_BuildDynamicToo- $ setDynamicNow- $ dflags- hsc_env' <- newHscEnv dflags0- (dbs,unit_state,home_unit,mconstants) <- initUnits logger dflags0 Nothing- dflags1 <- updatePlatformConstants dflags0 mconstants- unit_env0 <- initUnitEnv (ghcNameVersion dflags1) (targetPlatform dflags1)- let unit_env = unit_env0- { ue_home_unit = Just home_unit- , ue_units = unit_state- , ue_unit_dbs = Just dbs- }- let hsc_env'' = hscSetFlags dflags1- $ hsc_env' { hsc_unit_env = unit_env }- _ <- runPipeline' start_phase hsc_env'' env input_fn'- maybe_loc foreign_os- return ()- return r--runPipeline'- :: PhasePlus -- ^ When to start- -> HscEnv -- ^ Compilation environment- -> PipeEnv- -> FilePath -- ^ Input filename- -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module- -> [FilePath] -- ^ foreign objects, if we have one- -> IO (DynFlags, FilePath, Maybe ModIface, Maybe Linkable)- -- ^ (final flags, output filename, interface, linkable)-runPipeline' start_phase hsc_env env input_fn- maybe_loc foreign_os- = do- -- Execute the pipeline...- let state = PipeState{ hsc_env, maybe_loc, foreign_os = foreign_os, iface = Nothing- , maybe_linkable = Nothing }- (pipe_state, fp) <- evalP (pipeLoop start_phase input_fn) env state- return (pipeStateDynFlags pipe_state, fp, pipeStateModIface pipe_state- , pipeStateLinkable pipe_state )---- ------------------------------------------------------------------------------ outer pipeline loop---- | pipeLoop runs phases until we reach the stop phase-pipeLoop :: PhasePlus -> FilePath -> CompPipeline FilePath-pipeLoop phase input_fn = do- env <- getPipeEnv- dflags <- getDynFlags- logger <- getLogger- -- See Note [Partial ordering on phases]- let happensBefore' = happensBefore (targetPlatform dflags)- stopPhase = stop_phase env- case phase of- RealPhase realPhase | realPhase `eqPhase` stopPhase -- All done- -> -- Sometimes, a compilation phase doesn't actually generate any output- -- (eg. the CPP phase when -fcpp is not turned on). If we end on this- -- stage, but we wanted to keep the output, then we have to explicitly- -- copy the file, remembering to prepend a {-# LINE #-} pragma so that- -- further compilation stages can tell what the original filename was.- case output_spec env of- Temporary _ ->- return input_fn- NoOutputFile -> return input_fn- output ->- do pst <- getPipeState- tmpfs <- hsc_tmpfs <$> getPipeSession- final_fn <- liftIO $ getOutputFilename logger tmpfs- stopPhase output (src_basename env)- dflags stopPhase (maybe_loc pst)- when (final_fn /= input_fn) $ do- let msg = "Copying `" ++ input_fn ++"' to `" ++ final_fn ++ "'"- line_prag = "{-# LINE 1 \"" ++ src_filename env ++ "\" #-}\n"- liftIO $ showPass logger msg- liftIO $ copyWithHeader line_prag input_fn final_fn- return final_fn--- | not (realPhase `happensBefore'` stopPhase)- -- Something has gone wrong. We'll try to cover all the cases when- -- this could happen, so if we reach here it is a panic.- -- eg. it might happen if the -C flag is used on a source file that- -- has {-# OPTIONS -fasm #-}.- -> panic ("pipeLoop: at phase " ++ show realPhase ++- " but I wanted to stop at phase " ++ show stopPhase)-- _- -> do liftIO $ debugTraceMsg logger 4- (text "Running phase" <+> ppr phase)-- case phase of- HscBackend {} -> do- -- Depending on the dynamic-too state, we first run the- -- backend to generate the non-dynamic objects and then- -- re-run it to generate the dynamic ones.- let noDynToo = do- (next_phase, output_fn) <- runHookedPhase phase input_fn- pipeLoop next_phase output_fn- let dynToo = do- -- we must run the non-dynamic way before the dynamic- -- one because there may be interfaces loaded only in- -- the backend (e.g., in CorePrep). See #19264- r <- noDynToo-- -- we must check the dynamic-too state again, because- -- we may have failed to load a dynamic interface in- -- the backend.- dynamicTooState dflags >>= \case- DT_OK -> do- let dflags' = setDynamicNow dflags -- set "dynamicNow"- setDynFlags dflags'- (next_phase, output_fn) <- runHookedPhase phase input_fn- _ <- pipeLoop next_phase output_fn- -- TODO: we probably shouldn't ignore the result of- -- the dynamic compilation- setDynFlags dflags -- restore flags without "dynamicNow" set- return r- _ -> return r-- dynamicTooState dflags >>= \case- DT_Dont -> noDynToo- DT_Failed -> noDynToo- DT_OK -> dynToo- DT_Dyn -> noDynToo- -- it shouldn't be possible to be in this last case- -- here. It would mean that we executed the whole- -- pipeline with DynamicNow and Opt_BuildDynamicToo set.- --- -- When we restart the whole pipeline for -dynamic-too- -- we set DynamicNow but we unset Opt_BuildDynamicToo so- -- it's weird.- _ -> do- (next_phase, output_fn) <- runHookedPhase phase input_fn- pipeLoop next_phase output_fn--runHookedPhase :: PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath)-runHookedPhase pp input = do- hooks <- hsc_hooks <$> getPipeSession- case runPhaseHook hooks of- Nothing -> runPhase pp input- Just h -> h pp input---- -------------------------------------------------------------------------------- In each phase, we need to know into what filename to generate the--- output. All the logic about which filenames we generate output--- into is embodied in the following function.---- | Computes the next output filename after we run @next_phase@.--- Like 'getOutputFilename', but it operates in the 'CompPipeline' monad--- (which specifies all of the ambient information.)-phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath-phaseOutputFilename next_phase = do- PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv- PipeState{maybe_loc,hsc_env} <- getPipeState- dflags <- getDynFlags- logger <- getLogger- let tmpfs = hsc_tmpfs hsc_env- liftIO $ getOutputFilename logger tmpfs stop_phase output_spec- src_basename dflags next_phase maybe_loc---- | Computes the next output filename for something in the compilation--- pipeline. This is controlled by several variables:------ 1. 'Phase': the last phase to be run (e.g. 'stopPhase'). This--- is used to tell if we're in the last phase or not, because--- in that case flags like @-o@ may be important.--- 2. 'PipelineOutput': is this intended to be a 'Temporary' or--- 'Persistent' build output? Temporary files just go in--- a fresh temporary name.--- 3. 'String': what was the basename of the original input file?--- 4. 'DynFlags': the obvious thing--- 5. 'Phase': the phase we want to determine the output filename of.--- 6. @Maybe ModLocation@: the 'ModLocation' of the module we're--- compiling; this can be used to override the default output--- of an object file. (TODO: do we actually need this?)-getOutputFilename- :: Logger- -> TmpFs- -> Phase- -> PipelineOutput- -> String- -> DynFlags- -> Phase -- next phase- -> Maybe ModLocation- -> IO FilePath-getOutputFilename logger tmpfs stop_phase output basename dflags next_phase maybe_location- | is_last_phase, Persistent <- output = persistent_fn- | is_last_phase, SpecificFile <- output = case outputFile dflags of- Just f -> return f- Nothing ->- panic "SpecificFile: No filename"- | keep_this_output = persistent_fn- | Temporary lifetime <- output = newTempName logger tmpfs dflags lifetime suffix- | otherwise = newTempName logger tmpfs dflags TFL_CurrentModule- suffix- where- hcsuf = hcSuf dflags- odir = objectDir dflags- osuf = objectSuf dflags- keep_hc = gopt Opt_KeepHcFiles dflags- keep_hscpp = gopt Opt_KeepHscppFiles dflags- keep_s = gopt Opt_KeepSFiles dflags- keep_bc = gopt Opt_KeepLlvmFiles dflags-- myPhaseInputExt HCc = hcsuf- myPhaseInputExt MergeForeign = osuf- myPhaseInputExt StopLn = osuf- myPhaseInputExt other = phaseInputExt other-- is_last_phase = next_phase `eqPhase` stop_phase-- -- sometimes, we keep output from intermediate stages- keep_this_output =- case next_phase of- As _ | keep_s -> True- LlvmOpt | keep_bc -> True- HCc | keep_hc -> True- HsPp _ | keep_hscpp -> True -- See #10869- _other -> False-- suffix = myPhaseInputExt next_phase-- -- persistent object files get put in odir- persistent_fn- | StopLn <- next_phase = return odir_persistent- | otherwise = return persistent-- persistent = basename <.> suffix-- odir_persistent- | Just loc <- maybe_location = ml_obj_file loc- | Just d <- odir = d </> persistent- | otherwise = persistent----- | LLVM Options. These are flags to be passed to opt and llc, to ensure--- consistency we list them in pairs, so that they form groups.-llvmOptions :: DynFlags- -> [(String, String)] -- ^ pairs of (opt, llc) arguments-llvmOptions dflags =- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ]- ++ [("-relocation-model=" ++ rmodel- ,"-relocation-model=" ++ rmodel) | not (null rmodel)]- ++ [("-stack-alignment=" ++ (show align)- ,"-stack-alignment=" ++ (show align)) | align > 0 ]-- -- Additional llc flags- ++ [("", "-mcpu=" ++ mcpu) | not (null mcpu)- , not (any (isInfixOf "-mcpu") (getOpts dflags opt_lc)) ]- ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]- ++ [("", "-target-abi=" ++ abi) | not (null abi) ]-- where target = platformMisc_llvmTarget $ platformMisc dflags- Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)-- -- Relocation models- rmodel | gopt Opt_PIC dflags = "pic"- | positionIndependent dflags = "pic"- | WayDyn `elem` ways dflags = "dynamic-no-pic"- | otherwise = "static"-- platform = targetPlatform dflags-- align :: Int- align = case platformArch platform of- ArchX86_64 | isAvxEnabled dflags -> 32- _ -> 0-- attrs :: String- attrs = intercalate "," $ mattr- ++ ["+sse42" | isSse4_2Enabled dflags ]- ++ ["+sse2" | isSse2Enabled platform ]- ++ ["+sse" | isSseEnabled platform ]- ++ ["+avx512f" | isAvx512fEnabled dflags ]- ++ ["+avx2" | isAvx2Enabled dflags ]- ++ ["+avx" | isAvxEnabled dflags ]- ++ ["+avx512cd"| isAvx512cdEnabled dflags ]- ++ ["+avx512er"| isAvx512erEnabled dflags ]- ++ ["+avx512pf"| isAvx512pfEnabled dflags ]- ++ ["+bmi" | isBmiEnabled dflags ]- ++ ["+bmi2" | isBmi2Enabled dflags ]-- abi :: String- abi = case platformArch (targetPlatform dflags) of- ArchRISCV64 -> "lp64d"- _ -> ""---- -------------------------------------------------------------------------------- | Each phase in the pipeline returns the next phase to execute, and the--- name of the file in which the output was placed.------ We must do things dynamically this way, because we often don't know--- what the rest of the phases will be until part-way through the--- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning--- of a source file can change the latter stages of the pipeline from--- taking the LLVM route to using the native code generator.----runPhase :: PhasePlus -- ^ Run this phase- -> FilePath -- ^ name of the input file- -> CompPipeline (PhasePlus, -- next phase to run- FilePath) -- output filename-- -- Invariant: the output filename always contains the output- -- Interesting case: Hsc when there is no recompilation to do- -- Then the output filename is still a .o file------------------------------------------------------------------------------------- Unlit phase--runPhase (RealPhase (Unlit sf)) input_fn = do- let- -- escape the characters \, ", and ', but don't try to escape- -- Unicode or anything else (so we don't use Util.charToC- -- here). If we get this wrong, then in- -- GHC.HsToCore.Coverage.isGoodTickSrcSpan where we check that the filename in- -- a SrcLoc is the same as the source filenaame, the two will- -- look bogusly different. See test:- -- libraries/hpc/tests/function/subdir/tough2.hs- escape ('\\':cs) = '\\':'\\': escape cs- escape ('\"':cs) = '\\':'\"': escape cs- escape ('\'':cs) = '\\':'\'': escape cs- escape (c:cs) = c : escape cs- escape [] = []-- output_fn <- phaseOutputFilename (Cpp sf)-- let flags = [ -- The -h option passes the file name for unlit to- -- put in a #line directive- GHC.SysTools.Option "-h"- -- See Note [Don't normalise input filenames].- , GHC.SysTools.Option $ escape input_fn- , GHC.SysTools.FileOption "" input_fn- , GHC.SysTools.FileOption "" output_fn- ]-- dflags <- getDynFlags- logger <- getLogger- liftIO $ GHC.SysTools.runUnlit logger dflags flags-- return (RealPhase (Cpp sf), output_fn)------------------------------------------------------------------------------------ Cpp phase : (a) gets OPTIONS out of file--- (b) runs cpp if necessary--runPhase (RealPhase (Cpp sf)) input_fn- = do- dflags0 <- getDynFlags- let parser_opts0 = initParserOpts dflags0- src_opts <- liftIO $ getOptionsFromFile parser_opts0 input_fn- (dflags1, unhandled_flags, warns)- <- liftIO $ parseDynamicFilePragma dflags0 src_opts- setDynFlags dflags1- liftIO $ checkProcessArgsResult unhandled_flags--- if not (xopt LangExt.Cpp dflags1) then do- -- we have to be careful to emit warnings only once.- unless (gopt Opt_Pp dflags1) $ do- logger <- getLogger- liftIO $ handleFlagWarnings logger (initDiagOpts dflags1) warns-- -- no need to preprocess CPP, just pass input file along- -- to the next phase of the pipeline.- return (RealPhase (HsPp sf), input_fn)- else do- output_fn <- phaseOutputFilename (HsPp sf)- hsc_env <- getPipeSession- logger <- getLogger- liftIO $ doCpp logger- (hsc_tmpfs hsc_env)- (hsc_dflags hsc_env)- (hsc_unit_env hsc_env)- True{-raw-}- input_fn output_fn- -- re-read the pragmas now that we've preprocessed the file- -- See #2464,#3457- src_opts <- liftIO $ getOptionsFromFile parser_opts0 output_fn- (dflags2, unhandled_flags, warns)- <- liftIO $ parseDynamicFilePragma dflags0 src_opts- setDynFlags dflags2- liftIO $ checkProcessArgsResult unhandled_flags- unless (gopt Opt_Pp dflags2) $ do- logger <- getLogger- liftIO $ handleFlagWarnings logger (initDiagOpts dflags2) warns- -- the HsPp pass below will emit warnings-- return (RealPhase (HsPp sf), output_fn)------------------------------------------------------------------------------------ HsPp phase--runPhase (RealPhase (HsPp sf)) input_fn = do- dflags <- getDynFlags- logger <- getLogger- if not (gopt Opt_Pp dflags) then- -- no need to preprocess, just pass input file along- -- to the next phase of the pipeline.- return (RealPhase (Hsc sf), input_fn)- else do- PipeEnv{src_basename, src_suffix} <- getPipeEnv- let orig_fn = src_basename <.> src_suffix- output_fn <- phaseOutputFilename (Hsc sf)- liftIO $ GHC.SysTools.runPp logger dflags- ( [ GHC.SysTools.Option orig_fn- , GHC.SysTools.Option input_fn- , GHC.SysTools.FileOption "" output_fn- ]- )-- -- re-read pragmas now that we've parsed the file (see #3674)- let parser_opts = initParserOpts dflags- src_opts <- liftIO $ getOptionsFromFile parser_opts output_fn- (dflags1, unhandled_flags, warns)- <- liftIO $ parseDynamicFilePragma dflags src_opts- setDynFlags dflags1- liftIO $ checkProcessArgsResult unhandled_flags- liftIO $ handleFlagWarnings logger (initDiagOpts dflags1) warns-- return (RealPhase (Hsc sf), output_fn)---------------------------------------------------------------------------------- Hsc phase---- Compilation of a single module, in "legacy" mode (_not_ under--- the direction of the compilation manager).-runPhase (RealPhase (Hsc src_flavour)) input_fn- = do -- normal Hsc mode, not mkdependHS- dflags0 <- getDynFlags- PipeEnv{ src_basename=basename,- src_suffix=suff } <- getPipeEnv-- -- we add the current directory (i.e. the directory in which- -- the .hs files resides) to the include path, since this is- -- what gcc does, and it's probably what you want.- let current_dir = takeDirectory basename- new_includes = addImplicitQuoteInclude paths [current_dir]- paths = includePaths dflags0- dflags = dflags0 { includePaths = new_includes }-- setDynFlags dflags-- -- gather the imports and module name- (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do- buf <- hGetStringBuffer input_fn- let imp_prelude = xopt LangExt.ImplicitPrelude dflags- popts = initParserOpts dflags- eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)- case eimps of- Left errs -> throwErrors (GhcPsMessage <$> errs)- Right (src_imps,imps,L _ mod_name) -> return- (Just buf, mod_name, imps, src_imps)-- -- Take -o into account if present- -- Very like -ohi, but we must *only* do this if we aren't linking- -- (If we're linking then the -o applies to the linked thing, not to- -- the object file for one module.)- -- Note the nasty duplication with the same computation in compileFile above- location <- getLocation src_flavour mod_name- let o_file = ml_obj_file location -- The real object file- hi_file = ml_hi_file location- hie_file = ml_hie_file location- dyn_o_file = dynamicOutputFile dflags o_file-- src_hash <- liftIO $ getFileHash (basename <.> suff)- hi_date <- liftIO $ modificationTimeIfExists hi_file- hie_date <- liftIO $ modificationTimeIfExists hie_file- o_mod <- liftIO $ modificationTimeIfExists o_file- dyn_o_mod <- liftIO $ modificationTimeIfExists dyn_o_file-- PipeState{hsc_env=hsc_env'} <- getPipeState-- -- Tell the finder cache about this module- mod <- liftIO $ do- let home_unit = hsc_home_unit hsc_env'- let fc = hsc_FC hsc_env'- addHomeModuleToFinder fc home_unit mod_name location-- -- Make the ModSummary to hand to hscMain- let- mod_summary = ModSummary { ms_mod = mod,- ms_hsc_src = src_flavour,- ms_hspp_file = input_fn,- ms_hspp_opts = dflags,- ms_hspp_buf = hspp_buf,- ms_location = location,- ms_hs_hash = src_hash,- ms_obj_date = o_mod,- ms_dyn_obj_date = dyn_o_mod,- ms_parsed_mod = Nothing,- ms_iface_date = hi_date,- ms_hie_date = hie_date,- ms_textual_imps = imps,- ms_srcimps = src_imps }--- -- run the compiler!- let msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what- plugin_hsc_env' <- liftIO $ initializePlugins hsc_env' (Just $ ms_mnwib mod_summary)-- -- Need to set the knot-tying mutable variable for interface- -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.- -- See also Note [hsc_type_env_var hack]- type_env_var <- liftIO $ newIORef emptyNameEnv- let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_var = Just (mod, type_env_var) }-- status <- liftIO $ hscRecompStatus (Just msg) plugin_hsc_env mod_summary- Nothing Nothing (1, 1)-- logger <- getLogger- case status of- HscUpToDate iface _ ->- do liftIO $ touchObjectFile logger dflags o_file- -- The .o file must have a later modification date- -- than the source file (else we wouldn't get Nothing)- -- but we touch it anyway, to keep 'make' happy (we think).- setIface iface- return (RealPhase StopLn, o_file)- HscRecompNeeded mb_old_hash -> do- (tc_result, warnings) <- liftIO $- hscTypecheckAndGetWarnings plugin_hsc_env mod_summary-- -- In the rest of the pipeline use the loaded plugins- setPlugins (hsc_plugins plugin_hsc_env)- (hsc_static_plugins plugin_hsc_env)- -- "driver" plugins may have modified the DynFlags so we update them- setDynFlags (hsc_dflags plugin_hsc_env)-- return (HscPostTc mod_summary tc_result warnings mb_old_hash,- panic "HscPostTc doesn't have an input filename")--runPhase (HscPostTc mod_summary tc_result tc_warnings mb_old_hash) _ = do- PipeState{hsc_env=hsc_env'} <- getPipeState- hscBackendAction <- liftIO $ runHsc hsc_env' $ do- hscDesugarAndSimplify mod_summary tc_result tc_warnings mb_old_hash-- dflags <- getDynFlags- let hscBackendPhase = HscBackend mod_summary hscBackendAction- next_phase <- case hscBackendAction of- HscUpdate iface -> do- setIface iface- case backend dflags of- NoBackend -> return $ RealPhase StopLn- Interpreter -> return $ RealPhase StopLn- _ -> return hscBackendPhase -- Need to create .o, and handle -dynamic-too- _ -> return hscBackendPhase-- return (next_phase,- panic "HscBackend doesn't have an input filename")--runPhase (HscBackend mod_summary result) _ = do- let mod_name = moduleName (ms_mod mod_summary)- src_flavour = (ms_hsc_src mod_summary)-- dflags <- getDynFlags- logger <- getLogger- location <- getLocation src_flavour mod_name- setModLocation location-- let o_file = ml_obj_file location -- The real object file- next_phase = hscPostBackendPhase src_flavour (backend dflags)-- case result of- HscUpdate iface ->- do- case src_flavour of- HsigFile -> do- -- We need to create a REAL but empty .o file- -- because we are going to attempt to put it in a library- PipeState{hsc_env=hsc_env'} <- getPipeState- let input_fn = expectJust "runPhase" (ml_hs_file location)- basename = dropExtension input_fn- liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name-- -- In the case of hs-boot files, generate a dummy .o-boot- -- stamp file for the benefit of Make- HsBootFile -> liftIO $ touchObjectFile logger dflags o_file- HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"-- setIface iface- return (RealPhase StopLn, o_file)- HscRecomp { hscs_guts = cgguts,- hscs_mod_location = mod_location,- hscs_partial_iface = partial_iface,- hscs_old_iface_hash = mb_old_iface_hash- }- -> case backend dflags of- NoBackend -> panic "HscRecomp not relevant for NoBackend"- Interpreter -> do- PipeState{hsc_env=hsc_env'} <- getPipeState- -- In interpreted mode the regular codeGen backend is not run so we- -- generate a interface without codeGen info.- final_iface <- liftIO $ mkFullIface hsc_env' partial_iface Nothing- liftIO $ hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location-- (hasStub, comp_bc, spt_entries) <- liftIO $ hscInteractive hsc_env' cgguts mod_location-- stub_o <- liftIO $ case hasStub of- Nothing -> return []- Just stub_c -> do- stub_o <- compileStub hsc_env' stub_c- return [DotO stub_o]-- let hs_unlinked = [BCOs comp_bc spt_entries]- unlinked_time <- liftIO getCurrentTime- -- Why do we use the timestamp of the source file here,- -- rather than the current time? This works better in- -- the case where the local clock is out of sync- -- with the filesystem's clock. It's just as accurate:- -- if the source is modified, then the linkable will- -- be out of date.- let !linkable = LM unlinked_time (ms_mod mod_summary)- (hs_unlinked ++ stub_o)- setIface final_iface- setLinkable linkable- return (RealPhase StopLn,- panic "Interpreter backend doesn't have an output file")- _ -> do- output_fn <- phaseOutputFilename next_phase-- PipeState{hsc_env=hsc_env'} <- getPipeState-- (outputFilename, mStub, foreign_files, cg_infos) <- liftIO $- hscGenHardCode hsc_env' cgguts mod_location output_fn-- let dflags = hsc_dflags hsc_env'- final_iface <- liftIO (mkFullIface hsc_env' partial_iface (Just cg_infos))- setIface final_iface-- -- See Note [Writing interface files]- liftIO $ hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location-- stub_o <- liftIO (mapM (compileStub hsc_env') mStub)- foreign_os <- liftIO $- mapM (uncurry (compileForeign hsc_env')) foreign_files- setForeignOs (maybe [] return stub_o ++ foreign_os)-- return (RealPhase next_phase, outputFilename)---------------------------------------------------------------------------------- Cmm phase--runPhase (RealPhase CmmCpp) input_fn = do- hsc_env <- getPipeSession- logger <- getLogger- output_fn <- phaseOutputFilename Cmm- liftIO $ doCpp logger- (hsc_tmpfs hsc_env)- (hsc_dflags hsc_env)- (hsc_unit_env hsc_env)- False{-not raw-}- input_fn output_fn- return (RealPhase Cmm, output_fn)--runPhase (RealPhase Cmm) input_fn = do- hsc_env <- getPipeSession- let dflags = hsc_dflags hsc_env- let next_phase = hscPostBackendPhase HsSrcFile (backend dflags)- output_fn <- phaseOutputFilename next_phase- PipeState{hsc_env} <- getPipeState- mstub <- liftIO $ hscCompileCmmFile hsc_env input_fn output_fn- stub_o <- liftIO (mapM (compileStub hsc_env) mstub)- setForeignOs (maybeToList stub_o)- return (RealPhase next_phase, output_fn)---------------------------------------------------------------------------------- Cc phase--runPhase (RealPhase cc_phase) input_fn- | any (cc_phase `eqPhase`) [Cc, Ccxx, HCc, Cobjc, Cobjcxx]- = do- hsc_env <- getPipeSession- let dflags = hsc_dflags hsc_env- let unit_env = hsc_unit_env hsc_env- let home_unit = hsc_home_unit hsc_env- let tmpfs = hsc_tmpfs hsc_env- let platform = ue_platform unit_env- let hcc = cc_phase `eqPhase` HCc-- let cmdline_include_paths = includePaths dflags-- -- HC files have the dependent packages stamped into them- pkgs <- if hcc then liftIO $ getHCFilePackages input_fn else return []-- -- add package include paths even if we're just compiling .c- -- files; this is the Value Add(TM) that using ghc instead of- -- gcc gives you :)- ps <- liftIO $ mayThrowUnitErr (preloadUnitsInfo' unit_env pkgs)- let pkg_include_dirs = collectIncludeDirs ps- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []- (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []- (includePathsQuote cmdline_include_paths ++- includePathsQuoteImplicit cmdline_include_paths)- let include_paths = include_paths_quote ++ include_paths_global-- -- pass -D or -optP to preprocessor when compiling foreign C files- -- (#16737). Doing it in this way is simpler and also enable the C- -- compiler to perform preprocessing and parsing in a single pass,- -- but it may introduce inconsistency if a different pgm_P is specified.- let more_preprocessor_opts = concat- [ ["-Xpreprocessor", i]- | not hcc- , i <- getOpts dflags opt_P- ]-- let gcc_extra_viac_flags = extraGccViaCFlags dflags- let pic_c_flags = picCCOpts dflags-- let verbFlags = getVerbFlags dflags-- -- cc-options are not passed when compiling .hc files. Our- -- hc code doesn't not #include any header files anyway, so these- -- options aren't necessary.- let pkg_extra_cc_opts- | hcc = []- | otherwise = collectExtraCcOpts ps-- let framework_paths- | platformUsesFrameworks platform- = let pkgFrameworkPaths = collectFrameworksDirs ps- cmdlineFrameworkPaths = frameworkPaths dflags- in map ("-F"++) (cmdlineFrameworkPaths ++ pkgFrameworkPaths)- | otherwise- = []-- let cc_opt | optLevel dflags >= 2 = [ "-O2" ]- | optLevel dflags >= 1 = [ "-O" ]- | otherwise = []-- -- Decide next phase- let next_phase = As False- output_fn <- phaseOutputFilename next_phase-- let- more_hcc_opts =- -- on x86 the floating point regs have greater precision- -- than a double, which leads to unpredictable results.- -- By default, we turn this off with -ffloat-store unless- -- the user specified -fexcess-precision.- (if platformArch platform == ArchX86 &&- not (gopt Opt_ExcessPrecision dflags)- then [ "-ffloat-store" ]- else []) ++-- -- gcc's -fstrict-aliasing allows two accesses to memory- -- to be considered non-aliasing if they have different types.- -- This interacts badly with the C code we generate, which is- -- very weakly typed, being derived from C--.- ["-fno-strict-aliasing"]-- ghcVersionH <- liftIO $ getGhcVersionPathName dflags unit_env-- logger <- getLogger- liftIO $ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (- [ GHC.SysTools.FileOption "" input_fn- , GHC.SysTools.Option "-o"- , GHC.SysTools.FileOption "" output_fn- ]- ++ map GHC.SysTools.Option (- pic_c_flags-- -- Stub files generated for foreign exports references the runIO_closure- -- and runNonIO_closure symbols, which are defined in the base package.- -- These symbols are imported into the stub.c file via RtsAPI.h, and the- -- way we do the import depends on whether we're currently compiling- -- the base package or not.- ++ (if platformOS platform == OSMinGW32 &&- isHomeUnitId home_unit baseUnitId- then [ "-DCOMPILING_BASE_PACKAGE" ]- else [])-- -- We only support SparcV9 and better because V8 lacks an atomic CAS- -- instruction. Note that the user can still override this- -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag- -- regardless of the ordering.- --- -- This is a temporary hack. See #2872, commit- -- 5bd3072ac30216a505151601884ac88bf404c9f2- ++ (if platformArch platform == ArchSPARC- then ["-mcpu=v9"]- else [])-- -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.- ++ (if (cc_phase /= Ccxx && cc_phase /= Cobjcxx)- then ["-Wimplicit"]- else [])-- ++ (if hcc- then gcc_extra_viac_flags ++ more_hcc_opts- else [])- ++ verbFlags- ++ [ "-S" ]- ++ cc_opt- ++ [ "-include", ghcVersionH ]- ++ framework_paths- ++ include_paths- ++ more_preprocessor_opts- ++ pkg_extra_cc_opts- ))-- return (RealPhase next_phase, output_fn)---------------------------------------------------------------------------------- As, SpitAs phase : Assembler---- This is for calling the assembler on a regular assembly file-runPhase (RealPhase (As with_cpp)) input_fn- = do- hsc_env <- getPipeSession- let dflags = hsc_dflags hsc_env- let logger = hsc_logger hsc_env- let unit_env = hsc_unit_env hsc_env- let platform = ue_platform unit_env-- -- LLVM from version 3.0 onwards doesn't support the OS X system- -- assembler, so we use clang as the assembler instead. (#5636)- let (as_prog, get_asm_info) | backend dflags == LLVM- , platformOS platform == OSDarwin- = (GHC.SysTools.runClang, pure Clang)- | otherwise- = (GHC.SysTools.runAs, liftIO $ getAssemblerInfo logger dflags)-- asmInfo <- get_asm_info-- let cmdline_include_paths = includePaths dflags- let pic_c_flags = picCCOpts dflags-- next_phase <- maybeMergeForeign- output_fn <- phaseOutputFilename next_phase-- -- we create directories for the object file, because it- -- might be a hierarchical module.- liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)-- let global_includes = [ GHC.SysTools.Option ("-I" ++ p)- | p <- includePathsGlobal cmdline_include_paths ]- let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)- | p <- includePathsQuote cmdline_include_paths ++- includePathsQuoteImplicit cmdline_include_paths]- let runAssembler inputFilename outputFilename- = liftIO $- withAtomicRename outputFilename $ \temp_outputFilename ->- as_prog- logger dflags- (local_includes ++ global_includes- -- See Note [-fPIC for assembler]- ++ map GHC.SysTools.Option pic_c_flags- -- See Note [Produce big objects on Windows]- ++ [ GHC.SysTools.Option "-Wa,-mbig-obj"- | platformOS (targetPlatform dflags) == OSMinGW32- , not $ target32Bit (targetPlatform dflags)- ]-- -- We only support SparcV9 and better because V8 lacks an atomic CAS- -- instruction so we have to make sure that the assembler accepts the- -- instruction set. Note that the user can still override this- -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag- -- regardless of the ordering.- --- -- This is a temporary hack.- ++ (if platformArch (targetPlatform dflags) == ArchSPARC- then [GHC.SysTools.Option "-mcpu=v9"]- else [])- ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51]- then [GHC.SysTools.Option "-Qunused-arguments"]- else [])- ++ [ GHC.SysTools.Option "-x"- , if with_cpp- then GHC.SysTools.Option "assembler-with-cpp"- else GHC.SysTools.Option "assembler"- , GHC.SysTools.Option "-c"- , GHC.SysTools.FileOption "" inputFilename- , GHC.SysTools.Option "-o"- , GHC.SysTools.FileOption "" temp_outputFilename- ])-- liftIO $ debugTraceMsg logger 4 (text "Running the assembler")- runAssembler input_fn output_fn-- return (RealPhase next_phase, output_fn)----------------------------------------------------------------------------------- LlvmOpt phase-runPhase (RealPhase LlvmOpt) input_fn = do- dflags <- getDynFlags- logger <- getLogger- let -- we always (unless -optlo specified) run Opt since we rely on it to- -- fix up some pretty big deficiencies in the code we generate- optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2]- llvmOpts = case lookup optIdx $ llvmPasses $ llvmConfig dflags of- Just passes -> passes- Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "- ++ "is missing passes for level "- ++ show optIdx)- defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst- $ unzip (llvmOptions dflags)-- -- don't specify anything if user has specified commands. We do this- -- for opt but not llc since opt is very specifically for optimisation- -- passes only, so if the user is passing us extra options we assume- -- they know what they are doing and don't get in the way.- optFlag = if null (getOpts dflags opt_lo)- then map GHC.SysTools.Option $ words llvmOpts- else []-- output_fn <- phaseOutputFilename LlvmLlc-- liftIO $ GHC.SysTools.runLlvmOpt logger dflags- ( optFlag- ++ defaultOptions ++- [ GHC.SysTools.FileOption "" input_fn- , GHC.SysTools.Option "-o"- , GHC.SysTools.FileOption "" output_fn]- )-- return (RealPhase LlvmLlc, output_fn)----------------------------------------------------------------------------------- LlvmLlc phase--runPhase (RealPhase LlvmLlc) input_fn = do- -- Note [Clamping of llc optimizations]- --- -- See #13724- --- -- we clamp the llc optimization between [1,2]. This is because passing -O0- -- to llc 3.9 or llc 4.0, the naive register allocator can fail with- --- -- Error while trying to spill R1 from class GPR: Cannot scavenge register- -- without an emergency spill slot!- --- -- Observed at least with target 'arm-unknown-linux-gnueabihf'.- --- --- -- With LLVM4, llc -O3 crashes when ghc-stage1 tries to compile- -- rts/HeapStackCheck.cmm- --- -- llc -O3 '-mtriple=arm-unknown-linux-gnueabihf' -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s- -- 0 llc 0x0000000102ae63e8 llvm::sys::PrintStackTrace(llvm::raw_ostream&) + 40- -- 1 llc 0x0000000102ae69a6 SignalHandler(int) + 358- -- 2 libsystem_platform.dylib 0x00007fffc23f4b3a _sigtramp + 26- -- 3 libsystem_c.dylib 0x00007fffc226498b __vfprintf + 17876- -- 4 llc 0x00000001029d5123 llvm::SelectionDAGISel::LowerArguments(llvm::Function const&) + 5699- -- 5 llc 0x0000000102a21a35 llvm::SelectionDAGISel::SelectAllBasicBlocks(llvm::Function const&) + 3381- -- 6 llc 0x0000000102a202b1 llvm::SelectionDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 1457- -- 7 llc 0x0000000101bdc474 (anonymous namespace)::ARMDAGToDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 20- -- 8 llc 0x00000001025573a6 llvm::MachineFunctionPass::runOnFunction(llvm::Function&) + 134- -- 9 llc 0x000000010274fb12 llvm::FPPassManager::runOnFunction(llvm::Function&) + 498- -- 10 llc 0x000000010274fd23 llvm::FPPassManager::runOnModule(llvm::Module&) + 67- -- 11 llc 0x00000001027501b8 llvm::legacy::PassManagerImpl::run(llvm::Module&) + 920- -- 12 llc 0x000000010195f075 compileModule(char**, llvm::LLVMContext&) + 12133- -- 13 llc 0x000000010195bf0b main + 491- -- 14 libdyld.dylib 0x00007fffc21e5235 start + 1- -- Stack dump:- -- 0. Program arguments: llc -O3 -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s- -- 1. Running pass 'Function Pass Manager' on module '/var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc'.- -- 2. Running pass 'ARM Instruction Selection' on function '@"stg_gc_f1$def"'- --- -- Observed at least with -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa- --- dflags <- getDynFlags- logger <- getLogger- let- llvmOpts = case optLevel dflags of- 0 -> "-O1" -- required to get the non-naive reg allocator. Passing -regalloc=greedy is not sufficient.- 1 -> "-O1"- _ -> "-O2"-- defaultOptions = map GHC.SysTools.Option . concatMap words . snd- $ unzip (llvmOptions dflags)- optFlag = if null (getOpts dflags opt_lc)- then map GHC.SysTools.Option $ words llvmOpts- else []-- next_phase <- if -- hidden debugging flag '-dno-llvm-mangler' to skip mangling- | gopt Opt_NoLlvmMangler dflags -> return (As False)- | otherwise -> return LlvmMangle-- output_fn <- phaseOutputFilename next_phase-- liftIO $ GHC.SysTools.runLlvmLlc logger dflags- ( optFlag- ++ defaultOptions- ++ [ GHC.SysTools.FileOption "" input_fn- , GHC.SysTools.Option "-o"- , GHC.SysTools.FileOption "" output_fn- ]- )-- return (RealPhase next_phase, output_fn)------------------------------------------------------------------------------------ LlvmMangle phase--runPhase (RealPhase LlvmMangle) input_fn = do- let next_phase = As False- output_fn <- phaseOutputFilename next_phase- platform <- (ue_platform . hsc_unit_env) <$> getPipeSession- logger <- getLogger- liftIO $ withTiming logger (text "LLVM Mangler") id $- llvmFixupAsm platform input_fn output_fn- return (RealPhase next_phase, output_fn)---------------------------------------------------------------------------------- merge in stub objects--runPhase (RealPhase MergeForeign) input_fn = do- PipeState{foreign_os,hsc_env} <- getPipeState- output_fn <- phaseOutputFilename StopLn- liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)- if null foreign_os- then panic "runPhase(MergeForeign): no foreign objects"- else do- dflags <- getDynFlags- logger <- getLogger- let tmpfs = hsc_tmpfs hsc_env- liftIO $ joinObjectFiles logger tmpfs dflags (input_fn : foreign_os) output_fn- return (RealPhase StopLn, output_fn)---- warning suppression-runPhase (RealPhase other) _input_fn =- panic ("runPhase: don't know how to run phase " ++ show other)--maybeMergeForeign :: CompPipeline Phase-maybeMergeForeign- = do- PipeState{foreign_os} <- getPipeState- if null foreign_os then return StopLn else return MergeForeign--getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation-getLocation src_flavour mod_name = do- dflags <- getDynFlags-- PipeEnv{ src_basename=basename,- src_suffix=suff } <- getPipeEnv- location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff-- -- Boot-ify it if necessary- let location2- | HsBootFile <- src_flavour = addBootSuffixLocnOut location1- | otherwise = location1--- -- Take -ohi into account if present- -- This can't be done in mkHomeModuleLocation because- -- it only applies to the module being compiles- let ohi = outputHi dflags- location3 | Just fn <- ohi = location2{ ml_hi_file = fn }- | otherwise = location2-- -- Take -o into account if present- -- Very like -ohi, but we must *only* do this if we aren't linking- -- (If we're linking then the -o applies to the linked thing, not to- -- the object file for one module.)- -- Note the nasty duplication with the same computation in compileFile- -- above- let expl_o_file = outputFile dflags- location4 | Just ofile <- expl_o_file- , isNoLink (ghcLink dflags)- = location3 { ml_obj_file = ofile }- | otherwise = location3- return location4---------------------------------------------------------------------------------- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file--getHCFilePackages :: FilePath -> IO [UnitId]-getHCFilePackages filename =- Exception.bracket (openFile filename ReadMode) hClose $ \h -> do- l <- hGetLine h- case l of- '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->- return (map stringToUnitId (words rest))- _other ->- return []---linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()-linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do- when (haveRtsOptsFlags dflags) $- logMsg logger MCInfo noSrcSpan- $ withPprStyle defaultUserStyle- (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$- text " Call hs_init_ghc() from your main() function to set these options.")- linkDynLib logger tmpfs dflags unit_env o_files dep_units----- -------------------------------------------------------------------------------- Running CPP---- | Run CPP------ UnitEnv is needed to compute MIN_VERSION macros-doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()-doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do- let hscpp_opts = picPOpts dflags- let cmdline_include_paths = includePaths dflags- let unit_state = ue_units unit_env- pkg_include_dirs <- mayThrowUnitErr- (collectIncludeDirs <$> preloadUnitsInfo unit_env)- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []- (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []- (includePathsQuote cmdline_include_paths ++- includePathsQuoteImplicit cmdline_include_paths)- let include_paths = include_paths_quote ++ include_paths_global-- let verbFlags = getVerbFlags dflags-- let cpp_prog args | raw = GHC.SysTools.runCpp logger dflags args- | otherwise = GHC.SysTools.runCc Nothing logger tmpfs dflags- (GHC.SysTools.Option "-E" : args)-- let platform = targetPlatform dflags- targetArch = stringEncodeArch $ platformArch platform- targetOS = stringEncodeOS $ platformOS platform- isWindows = platformOS platform == OSMinGW32- let target_defs =- [ "-D" ++ HOST_OS ++ "_BUILD_OS",- "-D" ++ HOST_ARCH ++ "_BUILD_ARCH",- "-D" ++ targetOS ++ "_HOST_OS",- "-D" ++ targetArch ++ "_HOST_ARCH" ]- -- remember, in code we *compile*, the HOST is the same our TARGET,- -- and BUILD is the same as our HOST.-- let io_manager_defs =- [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] ++- [ "-D__IO_MANAGER_MIO__=1" ]-- let sse_defs =- [ "-D__SSE__" | isSseEnabled platform ] ++- [ "-D__SSE2__" | isSse2Enabled platform ] ++- [ "-D__SSE4_2__" | isSse4_2Enabled dflags ]-- let avx_defs =- [ "-D__AVX__" | isAvxEnabled dflags ] ++- [ "-D__AVX2__" | isAvx2Enabled dflags ] ++- [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++- [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++- [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++- [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]-- backend_defs <- getBackendDefs logger dflags-- let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]- -- Default CPP defines in Haskell source- ghcVersionH <- getGhcVersionPathName dflags unit_env- let hsSourceCppOpts = [ "-include", ghcVersionH ]-- -- MIN_VERSION macros- let uids = explicitUnits unit_state- pkgs = catMaybes (map (lookupUnit unit_state) uids)- mb_macro_include <-- if not (null pkgs) && gopt Opt_VersionMacros dflags- then do macro_stub <- newTempName logger tmpfs dflags TFL_CurrentModule "h"- writeFile macro_stub (generatePackageVersionMacros pkgs)- -- Include version macros for every *exposed* package.- -- Without -hide-all-packages and with a package database- -- size of 1000 packages, it takes cpp an estimated 2- -- milliseconds to process this file. See #10970- -- comment 8.- return [GHC.SysTools.FileOption "-include" macro_stub]- else return []-- cpp_prog ( map GHC.SysTools.Option verbFlags- ++ map GHC.SysTools.Option include_paths- ++ map GHC.SysTools.Option hsSourceCppOpts- ++ map GHC.SysTools.Option target_defs- ++ map GHC.SysTools.Option backend_defs- ++ map GHC.SysTools.Option th_defs- ++ map GHC.SysTools.Option hscpp_opts- ++ map GHC.SysTools.Option sse_defs- ++ map GHC.SysTools.Option avx_defs- ++ map GHC.SysTools.Option io_manager_defs- ++ mb_macro_include- -- Set the language mode to assembler-with-cpp when preprocessing. This- -- alleviates some of the C99 macro rules relating to whitespace and the hash- -- operator, which we tend to abuse. Clang in particular is not very happy- -- about this.- ++ [ GHC.SysTools.Option "-x"- , GHC.SysTools.Option "assembler-with-cpp"- , GHC.SysTools.Option input_fn- -- We hackily use Option instead of FileOption here, so that the file- -- name is not back-slashed on Windows. cpp is capable of- -- dealing with / in filenames, so it works fine. Furthermore- -- if we put in backslashes, cpp outputs #line directives- -- with *double* backslashes. And that in turn means that- -- our error messages get double backslashes in them.- -- In due course we should arrange that the lexer deals- -- with these \\ escapes properly.- , GHC.SysTools.Option "-o"- , GHC.SysTools.FileOption "" output_fn- ])--getBackendDefs :: Logger -> DynFlags -> IO [String]-getBackendDefs logger dflags | backend dflags == LLVM = do- llvmVer <- figureLlvmVersion logger dflags- return $ case fmap llvmVersionList llvmVer of- Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]- Just (m:n:_) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]- _ -> []- where- format (major, minor)- | minor >= 100 = error "getBackendDefs: Unsupported minor version"- | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int--getBackendDefs _ _ =- return []---- ------------------------------------------------------------------------------ Macros (cribbed from Cabal)--generatePackageVersionMacros :: [UnitInfo] -> String-generatePackageVersionMacros pkgs = concat- -- Do not add any C-style comments. See #3389.- [ generateMacros "" pkgname version- | pkg <- pkgs- , let version = unitPackageVersion pkg- pkgname = map fixchar (unitPackageNameString pkg)- ]--fixchar :: Char -> Char-fixchar '-' = '_'-fixchar c = c--generateMacros :: String -> String -> Version -> String-generateMacros prefix name version =- concat- ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n"- ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"- ," (major1) < ",major1," || \\\n"- ," (major1) == ",major1," && (major2) < ",major2," || \\\n"- ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"- ,"\n\n"- ]- where- (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)---- ------------------------------------------------------------------------------ join object files into a single relocatable object file, using ld -r--{--Note [Produce big objects on Windows]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--The Windows Portable Executable object format has a limit of 32k sections, which-we tend to blow through pretty easily. Thankfully, there is a "big object"-extension, which raises this limit to 2^32. However, it must be explicitly-enabled in the toolchain:-- * the assembler accepts the -mbig-obj flag, which causes it to produce a- bigobj-enabled COFF object.-- * the linker accepts the --oformat pe-bigobj-x86-64 flag. Despite what the name- suggests, this tells the linker to produce a bigobj-enabled COFF object, no a- PE executable.--We must enable bigobj output in a few places:-- * When merging object files (GHC.Driver.Pipeline.joinObjectFiles)-- * When assembling (GHC.Driver.Pipeline.runPhase (RealPhase As ...))--Unfortunately the big object format is not supported on 32-bit targets so-none of this can be used in that case.---Note [Merging object files for GHCi]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-GHCi can usually loads standard linkable object files using GHC's linker-implementation. However, most users build their projects with -split-sections,-meaning that such object files can have an extremely high number of sections.-As the linker must map each of these sections individually, loading such object-files is very inefficient.--To avoid this inefficiency, we use the linker's `-r` flag and a linker script-to produce a merged relocatable object file. This file will contain a singe-text section section and can consequently be mapped far more efficiently. As-gcc tends to do unpredictable things to our linker command line, we opt to-invoke ld directly in this case, in contrast to our usual strategy of linking-via gcc.---}--joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()-joinObjectFiles logger tmpfs dflags o_files output_fn = do- let toolSettings' = toolSettings dflags- ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'- osInfo = platformOS (targetPlatform dflags)- ld_r args = GHC.SysTools.runMergeObjects logger tmpfs dflags (- -- See Note [Produce big objects on Windows]- concat- [ [GHC.SysTools.Option "--oformat", GHC.SysTools.Option "pe-bigobj-x86-64"]- | OSMinGW32 == osInfo- , not $ target32Bit (targetPlatform dflags)- ]- ++ map GHC.SysTools.Option ld_build_id- ++ [ GHC.SysTools.Option "-o",- GHC.SysTools.FileOption "" output_fn ]- ++ args)-- -- suppress the generation of the .note.gnu.build-id section,- -- which we don't need and sometimes causes ld to emit a- -- warning:- ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"]- | otherwise = []-- if ldIsGnuLd- then do- script <- newTempName logger tmpfs dflags TFL_CurrentModule "ldscript"- cwd <- getCurrentDirectory- let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files- writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"- ld_r [GHC.SysTools.FileOption "" script]- else if toolSettings_ldSupportsFilelist toolSettings'- then do- filelist <- newTempName logger tmpfs dflags TFL_CurrentModule "filelist"- writeFile filelist $ unlines o_files- ld_r [GHC.SysTools.Option "-filelist",- GHC.SysTools.FileOption "" filelist]- else- ld_r (map (GHC.SysTools.FileOption "") o_files)---- -------------------------------------------------------------------------------- Misc.----- | What phase to run after one of the backend code generators has run-hscPostBackendPhase :: HscSource -> Backend -> Phase-hscPostBackendPhase HsBootFile _ = StopLn-hscPostBackendPhase HsigFile _ = StopLn-hscPostBackendPhase _ bcknd =- case bcknd of- ViaC -> HCc- NCG -> As False- LLVM -> LlvmOpt- NoBackend -> StopLn- Interpreter -> StopLn--touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()-touchObjectFile logger dflags path = do- createDirectoryIfMissing True $ takeDirectory path- GHC.SysTools.touch logger dflags "Touching object file" path---- | Find out path to @ghcversion.h@ file-getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath-getGhcVersionPathName dflags unit_env = do- candidates <- case ghcVersionFile dflags of- Just path -> return [path]- Nothing -> do- ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env [rtsUnitId])- return ((</> "ghcversion.h") <$> collectIncludeDirs ps)-- found <- filterM doesFileExist candidates- case found of- [] -> throwGhcExceptionIO (InstallationError- ("ghcversion.h missing; tried: "- ++ intercalate ", " candidates))- (x:_) -> return x---- Note [-fPIC for assembler]--- When compiling .c source file GHC's driver pipeline basically--- does the following two things:--- 1. ${CC} -S 'PIC_CFLAGS' source.c--- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S------ Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?--- Because on some architectures (at least sparc32) assembler also chooses--- the relocation type!--- Consider the following C module:------ /* pic-sample.c */--- int v;--- void set_v (int n) { v = n; }--- int get_v (void) { return v; }------ $ gcc -S -fPIC pic-sample.c--- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary--- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary------ $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od--- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od--- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od------ Most of architectures won't show any difference in this test, but on sparc32--- the following assembly snippet:------ sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7------ generates two kinds or relocations, only 'R_SPARC_PC22' is correct:------ 3c: 2f 00 00 00 sethi %hi(0), %l7--- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8--- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8--{- Note [Don't normalise input filenames]--Summary- We used to normalise input filenames when starting the unlit phase. This- broke hpc in `--make` mode with imported literate modules (#2991).--Introduction- 1) --main- When compiling a module with --main, GHC scans its imports to find out which- other modules it needs to compile too. It turns out that there is a small- difference between saying `ghc --make A.hs`, when `A` imports `B`, and- specifying both modules on the command line with `ghc --make A.hs B.hs`. In- the former case, the filename for B is inferred to be './B.hs' instead of- 'B.hs'.-- 2) unlit- When GHC compiles a literate haskell file, the source code first needs to go- through unlit, which turns it into normal Haskell source code. At the start- of the unlit phase, in `Driver.Pipeline.runPhase`, we call unlit with the- option `-h` and the name of the original file. We used to normalise this- filename using System.FilePath.normalise, which among other things removes- an initial './'. unlit then uses that filename in #line directives that it- inserts in the transformed source code.-- 3) SrcSpan- A SrcSpan represents a portion of a source code file. It has fields- linenumber, start column, end column, and also a reference to the file it- originated from. The SrcSpans for a literate haskell file refer to the- filename that was passed to unlit -h.-- 4) -fhpc- At some point during compilation with -fhpc, in the function- `GHC.HsToCore.Coverage.isGoodTickSrcSpan`, we compare the filename that a- `SrcSpan` refers to with the name of the file we are currently compiling.- For some reason I don't yet understand, they can sometimes legitimally be- different, and then hpc ignores that SrcSpan.--Problem- When running `ghc --make -fhpc A.hs`, where `A.hs` imports the literate- module `B.lhs`, `B` is inferred to be in the file `./B.lhs` (1). At the- start of the unlit phase, the name `./B.lhs` is normalised to `B.lhs` (2).- Therefore the SrcSpans of `B` refer to the file `B.lhs` (3), but we are- still compiling `./B.lhs`. Hpc thinks these two filenames are different (4),- doesn't include ticks for B, and we have unhappy customers (#2991).--Solution- Do not normalise `input_fn` when starting the unlit phase.--Alternative solution- Another option would be to not compare the two filenames on equality, but to- use System.FilePath.equalFilePath. That function first normalises its- arguments. The problem is that by the time we need to do the comparison, the- filenames have been turned into FastStrings, probably for performance- reasons, so System.FilePath.equalFilePath can not be used directly.--Archeology- The call to `normalise` was added in a commit called "Fix slash- direction on Windows with the new filePath code" (c9b6b5e8). The problem- that commit was addressing has since been solved in a different manner, in a- commit called "Fix the filename passed to unlit" (1eedbc6b). So the- `normalise` is no longer necessary.+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NondecreasingIndentation #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+--+-- GHC Driver+--+-- (c) The University of Glasgow 2005+--+-----------------------------------------------------------------------------++module GHC.Driver.Pipeline (+ -- * Run a series of compilation steps in a pipeline, for a+ -- collection of source files.+ oneShot, compileFile,++ -- * Interfaces for the compilation manager (interpreted/batch-mode)+ preprocess,+ compileOne, compileOne',+ compileForeign, compileEmptyStub,++ -- * Linking+ link, linkingNeeded, checkLinkInfo,++ -- * PipeEnv+ PipeEnv(..), mkPipeEnv, phaseOutputFilenameNew,++ -- * Running individual phases+ TPhase(..), runPhase,+ hscPostBackendPhase,++ -- * Constructing Pipelines+ TPipelineClass, MonadUse(..),++ preprocessPipeline, fullPipeline, hscPipeline, hscBackendPipeline, hscPostBackendPipeline,+ hscGenBackendPipeline, asPipeline, viaCPipeline, cmmCppPipeline, cmmPipeline,+ llvmPipeline, llvmLlcPipeline, llvmManglePipeline, pipelineStart,++ -- * Default method of running a pipeline+ runPipeline+) where+++#include "ghcplatform.h"+import GHC.Prelude++import GHC.Platform++import GHC.Utils.Monad ( MonadIO(liftIO), mapMaybeM )++import GHC.Driver.Main+import GHC.Driver.Env hiding ( Hsc )+import GHC.Driver.Errors+import GHC.Driver.Errors.Types+import GHC.Driver.Pipeline.Monad+import GHC.Driver.Config.Diagnostic+import GHC.Driver.Phases+import GHC.Driver.Pipeline.Phases+import GHC.Driver.Session+import GHC.Driver.Backend+import GHC.Driver.Ppr+import GHC.Driver.Hooks++import GHC.Platform.Ways++import GHC.SysTools+import GHC.Utils.TmpFs++import GHC.Linker.ExtraObj+import GHC.Linker.Static+import GHC.Linker.Types++import GHC.Utils.Outputable+import GHC.Utils.Error+import GHC.Utils.Panic+import GHC.Utils.Misc+import GHC.Utils.Exception as Exception+import GHC.Utils.Logger++import qualified GHC.LanguageExtensions as LangExt++import GHC.Data.FastString ( mkFastString )+import GHC.Data.StringBuffer ( hPutStringBuffer )+import GHC.Data.Maybe ( expectJust )++import GHC.Iface.Make ( mkFullIface )+import GHC.Runtime.Loader ( initializePlugins )+++import GHC.Types.Basic ( SuccessFlag(..), ForeignSrcLang(..) )+import GHC.Types.Error ( singleMessage, getMessages )+import GHC.Types.Target+import GHC.Types.SrcLoc+import GHC.Types.SourceFile+import GHC.Types.SourceError++import GHC.Unit+import GHC.Unit.Env+--import GHC.Unit.Finder+--import GHC.Unit.State+import GHC.Unit.Module.ModSummary+import GHC.Unit.Module.ModIface+import GHC.Unit.Module.Graph (needsTemplateHaskellOrQQ)+import GHC.Unit.Module.Deps+import GHC.Unit.Home.ModInfo++import System.Directory+import System.FilePath+import System.IO+import Control.Monad+import qualified Control.Monad.Catch as MC (handle)+import Data.Maybe+import Data.Either ( partitionEithers )++import Data.Time ( getCurrentTime )+import GHC.Driver.Pipeline.Execute++-- Simpler type synonym for actions in the pipeline monad+type P m = TPipelineClass TPhase m++-- ---------------------------------------------------------------------------+-- Pre-process++-- | Just preprocess a file, put the result in a temp. file (used by the+-- compilation manager during the summary phase).+--+-- We return the augmented DynFlags, because they contain the result+-- of slurping in the OPTIONS pragmas++preprocess :: HscEnv+ -> FilePath -- ^ input filename+ -> Maybe InputFileBuffer+ -- ^ optional buffer to use instead of reading the input file+ -> Maybe Phase -- ^ starting phase+ -> IO (Either DriverMessages (DynFlags, FilePath))+preprocess hsc_env input_fn mb_input_buf mb_phase =+ handleSourceError (\err -> return $ Left $ to_driver_messages $ srcErrorMessages err) $+ MC.handle handler $+ fmap Right $ do+ massertPpr (isJust mb_phase || isHaskellSrcFilename input_fn) (text input_fn)+ input_fn_final <- mkInputFn+ let preprocess_pipeline = preprocessPipeline pipe_env (setDumpPrefix pipe_env hsc_env) input_fn_final+ runPipeline (hsc_hooks hsc_env) preprocess_pipeline++ where+ srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1+ handler (ProgramError msg) =+ return $ Left $ singleMessage $+ mkPlainErrorMsgEnvelope srcspan $+ DriverUnknownMessage $ mkPlainError noHints $ text msg+ handler ex = throwGhcExceptionIO ex++ to_driver_messages :: Messages GhcMessage -> Messages DriverMessage+ to_driver_messages msgs = case traverse to_driver_message msgs of+ Nothing -> pprPanic "non-driver message in preprocess"+ (vcat $ pprMsgEnvelopeBagWithLoc (getMessages msgs))+ Just msgs' -> msgs'++ to_driver_message = \case+ GhcDriverMessage msg+ -> Just msg+ GhcPsMessage (PsHeaderMessage msg)+ -> Just (DriverPsHeaderMessage (PsHeaderMessage msg))+ _ -> Nothing++ pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession)+ mkInputFn =+ case mb_input_buf of+ Just input_buf -> do+ fn <- newTempName (hsc_logger hsc_env)+ (hsc_tmpfs hsc_env)+ (tmpDir (hsc_dflags hsc_env))+ TFL_CurrentModule+ ("buf_" ++ src_suffix pipe_env)+ hdl <- openBinaryFile fn WriteMode+ -- Add a LINE pragma so reported source locations will+ -- mention the real input file, not this temp file.+ hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}"+ hPutStringBuffer hdl input_buf+ hClose hdl+ return fn+ Nothing -> return input_fn++-- ---------------------------------------------------------------------------++-- | Compile+--+-- Compile a single module, under the control of the compilation manager.+--+-- This is the interface between the compilation manager and the+-- compiler proper (hsc), where we deal with tedious details like+-- reading the OPTIONS pragma from the source file, converting the+-- C or assembly that GHC produces into an object file, and compiling+-- FFI stub files.+--+-- NB. No old interface can also mean that the source has changed.+++compileOne :: HscEnv+ -> ModSummary -- ^ summary for module being compiled+ -> Int -- ^ module N ...+ -> Int -- ^ ... of M+ -> Maybe ModIface -- ^ old interface, if we have one+ -> Maybe Linkable -- ^ old linkable, if we have one+ -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful++compileOne = compileOne' (Just batchMsg)++compileOne' :: Maybe Messager+ -> HscEnv+ -> ModSummary -- ^ summary for module being compiled+ -> Int -- ^ module N ...+ -> Int -- ^ ... of M+ -> Maybe ModIface -- ^ old interface, if we have one+ -> Maybe Linkable -- ^ old linkable, if we have one+ -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful++compileOne' mHscMessage+ hsc_env0 summary mod_index nmods mb_old_iface mb_old_linkable+ = do++ debugTraceMsg logger 2 (text "compile: input file" <+> text input_fnpp)++ let flags = hsc_dflags hsc_env0+ in do unless (gopt Opt_KeepHiFiles flags) $+ addFilesToClean tmpfs TFL_CurrentModule $+ [ml_hi_file $ ms_location summary]+ unless (gopt Opt_KeepOFiles flags) $+ addFilesToClean tmpfs TFL_GhcSession $+ [ml_obj_file $ ms_location summary]++ plugin_hsc_env <- initializePlugins hsc_env (Just (ms_mnwib summary))+ let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput+ status <- hscRecompStatus mHscMessage plugin_hsc_env summary+ mb_old_iface mb_old_linkable (mod_index, nmods)+ let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, summary, status)+ (iface, old_linkable) <- runPipeline (hsc_hooks hsc_env) pipeline+ -- See Note [ModDetails and --make mode]+ details <- initModDetails plugin_hsc_env summary iface+ return $! HomeModInfo iface details old_linkable++ where lcl_dflags = ms_hspp_opts summary+ location = ms_location summary+ input_fn = expectJust "compile:hs" (ml_hs_file location)+ input_fnpp = ms_hspp_file summary+ mod_graph = hsc_mod_graph hsc_env0+ needsLinker = needsTemplateHaskellOrQQ mod_graph+ isDynWay = hasWay (ways lcl_dflags) WayDyn+ isProfWay = hasWay (ways lcl_dflags) WayProf+ internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)++ pipelineOutput = case bcknd of+ Interpreter -> NoOutputFile+ NoBackend -> NoOutputFile+ _ -> Persistent++ logger = hsc_logger hsc_env0+ tmpfs = hsc_tmpfs hsc_env0++ -- #8180 - when using TemplateHaskell, switch on -dynamic-too so+ -- the linker can correctly load the object files. This isn't necessary+ -- when using -fexternal-interpreter.+ dflags1 = if hostIsDynamic && internalInterpreter &&+ not isDynWay && not isProfWay && needsLinker+ then gopt_set lcl_dflags Opt_BuildDynamicToo+ else lcl_dflags++ -- #16331 - when no "internal interpreter" is available but we+ -- need to process some TemplateHaskell or QuasiQuotes, we automatically+ -- turn on -fexternal-interpreter.+ dflags2 = if not internalInterpreter && needsLinker+ then gopt_set dflags1 Opt_ExternalInterpreter+ else dflags1++ basename = dropExtension input_fn++ -- We add the directory in which the .hs files resides) to the import+ -- path. This is needed when we try to compile the .hc file later, if it+ -- imports a _stub.h file that we created here.+ current_dir = takeDirectory basename+ old_paths = includePaths dflags2+ loadAsByteCode+ | Just Target { targetAllowObjCode = obj } <- findTarget summary (hsc_targets hsc_env0)+ , not obj+ = True+ | otherwise = False+ -- Figure out which backend we're using+ (bcknd, dflags3)+ -- #8042: When module was loaded with `*` prefix in ghci, but DynFlags+ -- suggest to generate object code (which may happen in case -fobject-code+ -- was set), force it to generate byte-code. This is NOT transitive and+ -- only applies to direct targets.+ | loadAsByteCode+ = (Interpreter, gopt_set (dflags2 { backend = Interpreter }) Opt_ForceRecomp)+ | otherwise+ = (backend dflags, dflags2)+ dflags = dflags3 { includePaths = addImplicitQuoteInclude old_paths [current_dir] }+ hsc_env = hscSetFlags dflags hsc_env0++-- ---------------------------------------------------------------------------+-- Link+--+-- Note [Dynamic linking on macOS]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- Since macOS Sierra (10.14), the dynamic system linker enforces+-- a limit on the Load Commands. Specifically the Load Command Size+-- Limit is at 32K (32768). The Load Commands contain the install+-- name, dependencies, runpaths, and a few other commands. We however+-- only have control over the install name, dependencies and runpaths.+--+-- The install name is the name by which this library will be+-- referenced. This is such that we do not need to bake in the full+-- absolute location of the library, and can move the library around.+--+-- The dependency commands contain the install names from of referenced+-- libraries. Thus if a libraries install name is @rpath/libHS...dylib,+-- that will end up as the dependency.+--+-- Finally we have the runpaths, which informs the linker about the+-- directories to search for the referenced dependencies.+--+-- The system linker can do recursive linking, however using only the+-- direct dependencies conflicts with ghc's ability to inline across+-- packages, and as such would end up with unresolved symbols.+--+-- Thus we will pass the full dependency closure to the linker, and then+-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs).+--+-- We still need to add the relevant runpaths, for the dynamic linker to+-- lookup the referenced libraries though. The linker (ld64) does not+-- have any option to dead strip runpaths; which makes sense as runpaths+-- can be used for dependencies of dependencies as well.+--+-- The solution we then take in GHC is to not pass any runpaths to the+-- linker at link time, but inject them after the linking. For this to+-- work we'll need to ask the linker to create enough space in the header+-- to add more runpaths after the linking (-headerpad 8000).+--+-- After the library has been linked by $LD (usually ld64), we will use+-- otool to inspect the libraries left over after dead stripping, compute+-- the relevant runpaths, and inject them into the linked product using+-- the install_name_tool command.+--+-- This strategy should produce the smallest possible set of load commands+-- while still retaining some form of relocatability via runpaths.+--+-- The only way I can see to reduce the load command size further would be+-- by shortening the library names, or start putting libraries into the same+-- folders, such that one runpath would be sufficient for multiple/all+-- libraries.+link :: GhcLink -- ^ interactive or batch+ -> Logger -- ^ Logger+ -> TmpFs+ -> Hooks+ -> DynFlags -- ^ dynamic flags+ -> UnitEnv -- ^ unit environment+ -> Bool -- ^ attempt linking in batch mode?+ -> HomePackageTable -- ^ what to link+ -> IO SuccessFlag++-- For the moment, in the batch linker, we don't bother to tell doLink+-- which packages to link -- it just tries all that are available.+-- batch_attempt_linking should only be *looked at* in batch mode. It+-- should only be True if the upsweep was successful and someone+-- exports main, i.e., we have good reason to believe that linking+-- will succeed.++link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt =+ case linkHook hooks of+ Nothing -> case ghcLink of+ NoLink -> return Succeeded+ LinkBinary -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt+ LinkStaticLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt+ LinkDynLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt+ LinkInMemory+ | platformMisc_ghcWithInterpreter $ platformMisc dflags+ -> -- Not Linking...(demand linker will do the job)+ return Succeeded+ | otherwise+ -> panicBadLink LinkInMemory+ Just h -> h ghcLink dflags batch_attempt_linking hpt+++panicBadLink :: GhcLink -> a+panicBadLink other = panic ("link: GHC not built to link this way: " +++ show other)++link' :: Logger+ -> TmpFs+ -> DynFlags -- ^ dynamic flags+ -> UnitEnv -- ^ unit environment+ -> Bool -- ^ attempt linking in batch mode?+ -> HomePackageTable -- ^ what to link+ -> IO SuccessFlag++link' logger tmpfs dflags unit_env batch_attempt_linking hpt+ | batch_attempt_linking+ = do+ let+ staticLink = case ghcLink dflags of+ LinkStaticLib -> True+ _ -> False++ home_mod_infos = eltsHpt hpt++ -- the packages we depend on+ pkg_deps = concatMap (dep_direct_pkgs . mi_deps . hm_iface) home_mod_infos++ -- the linkables to link+ linkables = map (expectJust "link".hm_linkable) home_mod_infos++ debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))++ -- check for the -no-link flag+ if isNoLink (ghcLink dflags)+ then do debugTraceMsg logger 3 (text "link(batch): linking omitted (-c flag given).")+ return Succeeded+ else do++ let getOfiles LM{ linkableUnlinked } = map nameOfObject (filter isObject linkableUnlinked)+ obj_files = concatMap getOfiles linkables+ platform = targetPlatform dflags+ exe_file = exeFileName platform staticLink (outputFile dflags)++ linking_needed <- linkingNeeded logger dflags unit_env staticLink linkables pkg_deps++ if not (gopt Opt_ForceRecomp dflags) && not linking_needed+ then do debugTraceMsg logger 2 (text exe_file <+> text "is up to date, linking not required.")+ return Succeeded+ else do++ compilationProgressMsg logger (text "Linking " <> text exe_file <> text " ...")++ -- Don't showPass in Batch mode; doLink will do that for us.+ let link = case ghcLink dflags of+ LinkBinary -> linkBinary logger tmpfs+ LinkStaticLib -> linkStaticLib logger+ LinkDynLib -> linkDynLibCheck logger tmpfs+ other -> panicBadLink other+ link dflags unit_env obj_files pkg_deps++ debugTraceMsg logger 3 (text "link: done")++ -- linkBinary only returns if it succeeds+ return Succeeded++ | otherwise+ = do debugTraceMsg logger 3 (text "link(batch): upsweep (partially) failed OR" $$+ text " Main.main not exported; not linking.")+ return Succeeded+++linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO Bool+linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do+ -- if the modification time on the executable is later than the+ -- modification times on all of the objects and libraries, then omit+ -- linking (unless the -fforce-recomp flag was given).+ let platform = ue_platform unit_env+ unit_state = ue_units unit_env+ exe_file = exeFileName platform staticLink (outputFile dflags)+ e_exe_time <- tryIO $ getModificationUTCTime exe_file+ case e_exe_time of+ Left _ -> return True+ Right t -> do+ -- first check object files and extra_ld_inputs+ let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]+ e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs+ let (errs,extra_times) = partitionEithers e_extra_times+ let obj_times = map linkableTime linkables ++ extra_times+ if not (null errs) || any (t <) obj_times+ then return True+ else do++ -- next, check libraries. XXX this only checks Haskell libraries,+ -- not extra_libraries or -l things from the command line.+ let pkg_hslibs = [ (collectLibraryDirs (ways dflags) [c], lib)+ | Just c <- map (lookupUnitId unit_state) pkg_deps,+ lib <- unitHsLibs (ghcNameVersion dflags) (ways dflags) c ]++ pkg_libfiles <- mapM (uncurry (findHSLib platform (ways dflags))) pkg_hslibs+ if any isNothing pkg_libfiles then return True else do+ e_lib_times <- mapM (tryIO . getModificationUTCTime)+ (catMaybes pkg_libfiles)+ let (lib_errs,lib_times) = partitionEithers e_lib_times+ if not (null lib_errs) || any (t <) lib_times+ then return True+ else checkLinkInfo logger dflags unit_env pkg_deps exe_file++findHSLib :: Platform -> Ways -> [String] -> String -> IO (Maybe FilePath)+findHSLib platform ws dirs lib = do+ let batch_lib_file = if ws `hasNotWay` WayDyn+ then "lib" ++ lib <.> "a"+ else platformSOName platform lib+ found <- filterM doesFileExist (map (</> batch_lib_file) dirs)+ case found of+ [] -> return Nothing+ (x:_) -> return (Just x)++-- -----------------------------------------------------------------------------+-- Compile files in one-shot mode.++oneShot :: HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()+oneShot hsc_env stop_phase srcs = do+ o_files <- mapMaybeM (compileFile hsc_env stop_phase) srcs+ case stop_phase of+ StopPreprocess -> return ()+ StopC -> return ()+ StopAs -> return ()+ NoStop -> doLink hsc_env o_files++compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath)+compileFile hsc_env stop_phase (src, _mb_phase) = do+ exists <- doesFileExist src+ when (not exists) $+ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))++ let+ dflags = hsc_dflags hsc_env+ mb_o_file = outputFile dflags+ ghc_link = ghcLink dflags -- Set by -c or -no-link++ -- When linking, the -o argument refers to the linker's output.+ -- otherwise, we use it as the name for the pipeline's output.+ output+ | NoBackend <- backend dflags = NoOutputFile+ | NoStop <- stop_phase, not (isNoLink ghc_link) = Persistent+ -- -o foo applies to linker+ | isJust mb_o_file = SpecificFile+ -- -o foo applies to the file we are compiling now+ | otherwise = Persistent+ pipe_env = mkPipeEnv stop_phase src output+ pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src+ runPipeline (hsc_hooks hsc_env) pipeline+++doLink :: HscEnv -> [FilePath] -> IO ()+doLink hsc_env o_files =+ let+ dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ unit_env = hsc_unit_env hsc_env+ tmpfs = hsc_tmpfs hsc_env+ in case ghcLink dflags of+ NoLink -> return ()+ LinkBinary -> linkBinary logger tmpfs dflags unit_env o_files []+ LinkStaticLib -> linkStaticLib logger dflags unit_env o_files []+ LinkDynLib -> linkDynLibCheck logger tmpfs dflags unit_env o_files []+ other -> panicBadLink other++-----------------------------------------------------------------------------+-- stub .h and .c files (for foreign export support), and cc files.++-- The _stub.c file is derived from the haskell source file, possibly taking+-- into account the -stubdir option.+--+-- The object file created by compiling the _stub.c file is put into a+-- temporary file, which will be later combined with the main .o file+-- (see the MergeForeigns phase).+--+-- Moreover, we also let the user emit arbitrary C/C++/ObjC/ObjC++ files+-- from TH, that are then compiled and linked to the module. This is+-- useful to implement facilities such as inline-c.++compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath+compileForeign _ RawObject object_file = return object_file+compileForeign hsc_env lang stub_c = do+ let pipeline = case lang of+ LangC -> viaCPipeline Cc+ LangCxx -> viaCPipeline Ccxx+ LangObjc -> viaCPipeline Cobjc+ LangObjcxx -> viaCPipeline Cobjcxx+ LangAsm -> \pe hsc_env ml fp -> Just <$> asPipeline True pe hsc_env ml fp+#if __GLASGOW_HASKELL__ < 811+ RawObject -> panic "compileForeign: should be unreachable"+#endif+ pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession)+ res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c)+ case res of+ -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`.+ -- Future refactoring to not check StopC for this case+ Nothing -> pprPanic "compileForeign" (ppr stub_c)+ Just fp -> return fp++compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()+compileEmptyStub dflags hsc_env basename location mod_name = do+ -- To maintain the invariant that every Haskell file+ -- compiles to object code, we make an empty (but+ -- valid) stub object file for signatures. However,+ -- we make sure this object file has a unique symbol,+ -- so that ranlib on OS X doesn't complain, see+ -- https://gitlab.haskell.org/ghc/ghc/issues/12673+ -- and https://github.com/haskell/cabal/issues/2257+ let logger = hsc_logger hsc_env+ let tmpfs = hsc_tmpfs hsc_env+ empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c"+ let home_unit = hsc_home_unit hsc_env+ src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"+ writeFile empty_stub (showSDoc dflags (pprCode CStyle src))+ let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename}+ pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub+ _ <- runPipeline (hsc_hooks hsc_env) pipeline+ return ()+++{- Environment Initialisation -}++mkPipeEnv :: StopPhase -- End phase+ -> FilePath -- input fn+ -> PipelineOutput -- Output+ -> PipeEnv+mkPipeEnv stop_phase input_fn output =+ let (basename, suffix) = splitExtension input_fn+ suffix' = drop 1 suffix -- strip off the .+ env = PipeEnv{ stop_phase,+ src_filename = input_fn,+ src_basename = basename,+ src_suffix = suffix',+ output_spec = output }+ in env++setDumpPrefix :: PipeEnv -> HscEnv -> HscEnv+setDumpPrefix pipe_env hsc_env =+ hscUpdateFlags (\dflags -> dflags { dumpPrefix = Just (src_basename pipe_env ++ ".")}) hsc_env++{- The Pipelines -}++phaseIfFlag :: Monad m+ => HscEnv+ -> (DynFlags -> Bool)+ -> a+ -> m a+ -> m a+phaseIfFlag hsc_env flag def action =+ if flag (hsc_dflags hsc_env)+ then action+ else return def++-- | Check if the start is *before* the current phase, otherwise skip with a default+phaseIfAfter :: P m => Platform -> Phase -> Phase -> a -> m a -> m a+phaseIfAfter platform start_phase cur_phase def action =+ if start_phase `eqPhase` cur_phase+ || happensBefore platform start_phase cur_phase++ then action+ else return def++-- | The preprocessor pipeline+preprocessPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (DynFlags, FilePath)+preprocessPipeline pipe_env hsc_env input_fn = do+ unlit_fn <-+ runAfter (Unlit HsSrcFile) input_fn $ do+ use (T_Unlit pipe_env hsc_env input_fn)+++ (dflags1, warns1) <- use (T_FileArgs hsc_env unlit_fn)+ let hsc_env1 = hscSetFlags dflags1 hsc_env++ (cpp_fn, hsc_env2)+ <- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do+ cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn)+ (dflags2, _) <- use (T_FileArgs hsc_env1 cpp_fn)+ let hsc_env2 = hscSetFlags dflags2 hsc_env1+ return (cpp_fn, hsc_env2)+++ pp_fn <- runAfterFlag hsc_env2 (HsPp HsSrcFile) (gopt Opt_Pp) cpp_fn $+ use (T_HsPp pipe_env hsc_env2 input_fn cpp_fn)++ (dflags3, warns3)+ <- if pp_fn == unlit_fn+ -- Didn't run any preprocessors so don't need to reparse, would be nicer+ -- if `T_FileArgs` recognised this.+ then return (dflags1, warns1)+ else do+ -- Reparse with original hsc_env so that we don't get duplicated options+ use (T_FileArgs hsc_env pp_fn)++ liftIO (handleFlagWarnings (hsc_logger hsc_env) (initDiagOpts dflags3) warns3)+ return (dflags3, pp_fn)+++ -- This won't change through the compilation pipeline+ where platform = targetPlatform (hsc_dflags hsc_env)+ runAfter :: P p => Phase+ -> a -> p a -> p a+ runAfter = phaseIfAfter platform start_phase+ start_phase = startPhase (src_suffix pipe_env)+ runAfterFlag :: P p+ => HscEnv+ -> Phase+ -> (DynFlags -> Bool)+ -> a+ -> p a+ -> p a+ runAfterFlag hsc_env phase flag def action =+ runAfter phase def+ $ phaseIfFlag hsc_env flag def action++-- | The complete compilation pipeline, from start to finish+fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, Maybe Linkable)+fullPipeline pipe_env hsc_env pp_fn src_flavour = do+ (dflags, input_fn) <- preprocessPipeline pipe_env hsc_env pp_fn+ let hsc_env' = hscSetFlags dflags hsc_env+ (hsc_env_with_plugins, mod_sum, hsc_recomp_status)+ <- use (T_HscRecomp pipe_env hsc_env' input_fn src_flavour)+ res <- hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status)+ checkDynamicToo pipe_env hsc_env pp_fn src_flavour res+ -- Once the pipeline has finished, check to see if -dynamic-too failed and+ -- rerun again if it failed but just the `--dynamic` way.++checkDynamicToo :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> (ModIface, Maybe Linkable) -> m (ModIface, Maybe Linkable)+checkDynamicToo pipe_env hsc_env pp_fn src_flavour res = do+ liftIO (dynamicTooState (hsc_dflags hsc_env)) >>= \case+ DT_Dont -> return res+ DT_Dyn -> return res+ DT_OK -> return res+ -- If we are compiling a Haskell module with -dynamic-too, we+ -- first try the "fast path": that is we compile the non-dynamic+ -- version and at the same time we check that interfaces depended+ -- on exist both for the non-dynamic AND the dynamic way. We also+ -- check that they have the same hash.+ -- If they don't, dynamicTooState is set to DT_Failed.+ -- See GHC.Iface.Load.checkBuildDynamicToo+ -- If they do, in the end we produce both the non-dynamic and+ -- dynamic outputs.+ --+ -- If this "fast path" failed, we execute the whole pipeline+ -- again, this time for the dynamic way *only*. To do that we+ -- just set the dynamicNow bit from the start to ensure that the+ -- dynamic DynFlags fields are used and we disable -dynamic-too+ -- (its state is already set to DT_Failed so it wouldn't do much+ -- anyway).+ DT_Failed+ -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)+ | OSMinGW32 <- platformOS (targetPlatform dflags) -> return res+ | otherwise -> do+ liftIO (debugTraceMsg logger 4+ (text "Running the full pipeline again for -dynamic-too"))+ hsc_env' <- liftIO (resetHscEnv hsc_env)+ fullPipeline pipe_env hsc_env' pp_fn src_flavour+ where+ dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env++-- | Enable dynamic-too, reset EPS+resetHscEnv :: HscEnv -> IO HscEnv+resetHscEnv hsc_env = do+ let dflags0 = flip gopt_unset Opt_BuildDynamicToo+ $ setDynamicNow+ $ (hsc_dflags hsc_env)+ hsc_env' <- newHscEnv dflags0+ (dbs,unit_state,home_unit,mconstants) <- initUnits (hsc_logger hsc_env) dflags0 Nothing+ dflags1 <- updatePlatformConstants dflags0 mconstants+ unit_env0 <- initUnitEnv (ghcNameVersion dflags1) (targetPlatform dflags1)+ let unit_env = unit_env0+ { ue_home_unit = Just home_unit+ , ue_units = unit_state+ , ue_unit_dbs = Just dbs+ }+ let hsc_env'' = hscSetFlags dflags1 $ hsc_env'+ { hsc_unit_env = unit_env+ }+ return hsc_env''++-- | Everything after preprocess+hscPipeline :: P m => PipeEnv -> ((HscEnv, ModSummary, HscRecompStatus)) -> m (ModIface, Maybe Linkable)+hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do+ case hsc_recomp_status of+ HscUpToDate iface mb_linkable -> return (iface, mb_linkable)+ HscRecompNeeded mb_old_hash -> do+ (tc_result, warnings) <- use (T_Hsc hsc_env_with_plugins mod_sum)+ hscBackendAction <- use (T_HscPostTc hsc_env_with_plugins mod_sum tc_result warnings mb_old_hash )+ hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction++hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, Maybe Linkable)+hscBackendPipeline pipe_env hsc_env mod_sum result =+ case backend (hsc_dflags hsc_env) of+ NoBackend ->+ case result of+ HscUpdate iface -> return (iface, Nothing)+ HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing+ -- TODO: Why is there not a linkable?+ -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing+ _ -> do+ res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result+ liftIO (dynamicTooState (hsc_dflags hsc_env)) >>= \case+ DT_OK -> do+ let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow"+ () <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result+ _ -> return ()+ return res++hscGenBackendPipeline :: P m+ => PipeEnv+ -> HscEnv+ -> ModSummary+ -> HscBackendAction+ -> m (ModIface, Maybe Linkable)+hscGenBackendPipeline pipe_env hsc_env mod_sum result = do+ let mod_name = moduleName (ms_mod mod_sum)+ src_flavour = (ms_hsc_src mod_sum)+ dflags = hsc_dflags hsc_env+ -- MP: The ModLocation is recalculated here to get the right paths when+ -- -dynamic-too is enabled. `ModLocation` should be extended with a field for+ -- the location of the `dyn_o` file to avoid this recalculation.+ location <- liftIO (getLocation pipe_env dflags src_flavour mod_name)+ (fos, miface, mlinkable, o_file) <- use (T_HscBackend pipe_env hsc_env mod_name src_flavour location result)+ final_fp <- hscPostBackendPipeline pipe_env hsc_env (ms_hsc_src mod_sum) (backend (hsc_dflags hsc_env)) (Just location) o_file+ final_linkable <-+ case final_fp of+ -- No object file produced, bytecode or NoBackend+ Nothing -> return mlinkable+ Just o_fp -> do+ unlinked_time <- liftIO (liftIO getCurrentTime)+ final_o <- use (T_MergeForeign pipe_env hsc_env (Just location) o_fp fos)+ let !linkable = LM unlinked_time+ (ms_mod mod_sum)+ [DotO final_o]+ return (Just linkable)+ return (miface, final_linkable)++asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath+asPipeline use_cpp pipe_env hsc_env location input_fn = do+ use (T_As use_cpp pipe_env hsc_env location input_fn)++viaCPipeline :: P m => Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)+viaCPipeline c_phase pipe_env hsc_env location input_fn = do+ out_fn <- use (T_Cc c_phase pipe_env hsc_env input_fn)+ case stop_phase pipe_env of+ StopC -> return Nothing+ _ -> Just <$> asPipeline False pipe_env hsc_env location out_fn++llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath+llvmPipeline pipe_env hsc_env location fp = do+ opt_fn <- use (T_LlvmOpt pipe_env hsc_env fp)+ llvmLlcPipeline pipe_env hsc_env location opt_fn++llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath+llvmLlcPipeline pipe_env hsc_env location opt_fn = do+ llc_fn <- use (T_LlvmLlc pipe_env hsc_env opt_fn)+ llvmManglePipeline pipe_env hsc_env location llc_fn++llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath+llvmManglePipeline pipe_env hsc_env location llc_fn = do+ mangled_fn <-+ if gopt Opt_NoLlvmMangler (hsc_dflags hsc_env)+ then use (T_LlvmMangle pipe_env hsc_env llc_fn)+ else return llc_fn+ asPipeline False pipe_env hsc_env location mangled_fn++cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath+cmmCppPipeline pipe_env hsc_env input_fn = do+ output_fn <- use (T_CmmCpp pipe_env hsc_env input_fn)+ cmmPipeline pipe_env hsc_env output_fn++cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath+cmmPipeline pipe_env hsc_env input_fn = do+ (fos, output_fn) <- use (T_Cmm pipe_env hsc_env input_fn)+ mo_fn <- hscPostBackendPipeline pipe_env hsc_env HsSrcFile (backend (hsc_dflags hsc_env)) Nothing output_fn+ case mo_fn of+ Nothing -> panic "CMM pipeline - produced no .o file"+ Just mo_fn -> use (T_MergeForeign pipe_env hsc_env Nothing mo_fn fos)++hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)+hscPostBackendPipeline _ _ HsBootFile _ _ _ = return Nothing+hscPostBackendPipeline _ _ HsigFile _ _ _ = return Nothing+hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn =+ case bcknd of+ ViaC -> viaCPipeline HCc pipe_env hsc_env ml input_fn+ NCG -> Just <$> asPipeline False pipe_env hsc_env ml input_fn+ LLVM -> Just <$> llvmPipeline pipe_env hsc_env ml input_fn+ NoBackend -> return Nothing+ Interpreter -> return Nothing++-- Pipeline from a given suffix+pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)+pipelineStart pipe_env hsc_env input_fn =+ fromSuffix (src_suffix pipe_env)+ where+ stop_after = stop_phase pipe_env+ frontend :: P m => HscSource -> m (Maybe FilePath)+ frontend sf = case stop_after of+ StopPreprocess -> do+ -- The actual output from preprocessing+ (_, out_fn) <- preprocessPipeline pipe_env hsc_env input_fn+ let logger = hsc_logger hsc_env+ -- Sometimes, a compilation phase doesn't actually generate any output+ -- (eg. the CPP phase when -fcpp is not turned on). If we end on this+ -- stage, but we wanted to keep the output, then we have to explicitly+ -- copy the file, remembering to prepend a {-# LINE #-} pragma so that+ -- further compilation stages can tell what the original filename was.+ -- File name we expected the output to have+ final_fn <- liftIO $ phaseOutputFilenameNew (Hsc HsSrcFile) pipe_env hsc_env Nothing+ when (final_fn /= out_fn) $ do+ let msg = "Copying `" ++ input_fn ++"' to `" ++ final_fn ++ "'"+ line_prag = "{-# LINE 1 \"" ++ src_filename pipe_env ++ "\" #-}\n"+ liftIO (showPass logger msg)+ liftIO (copyWithHeader line_prag input_fn final_fn)+ return Nothing+ _ -> objFromLinkable <$> fullPipeline pipe_env hsc_env input_fn sf+ c :: P m => Phase -> m (Maybe FilePath)+ c phase = viaCPipeline phase pipe_env hsc_env Nothing input_fn+ as :: P m => Bool -> m (Maybe FilePath)+ as use_cpp = Just <$> asPipeline use_cpp pipe_env hsc_env Nothing input_fn++ objFromLinkable (_, Just (LM _ _ [DotO lnk])) = Just lnk+ objFromLinkable _ = Nothing+++ fromSuffix :: P m => String -> m (Maybe FilePath)+ fromSuffix "lhs" = frontend HsSrcFile+ fromSuffix "lhs-boot" = frontend HsBootFile+ fromSuffix "lhsig" = frontend HsigFile+ fromSuffix "hs" = frontend HsSrcFile+ fromSuffix "hs-boot" = frontend HsBootFile+ fromSuffix "hsig" = frontend HsigFile+ fromSuffix "hscpp" = frontend HsSrcFile+ fromSuffix "hspp" = frontend HsSrcFile+ fromSuffix "hc" = c HCc+ fromSuffix "c" = c Cc+ fromSuffix "cpp" = c Ccxx+ fromSuffix "C" = c Cc+ fromSuffix "m" = c Cobjc+ fromSuffix "M" = c Cobjcxx+ fromSuffix "mm" = c Cobjcxx+ fromSuffix "cc" = c Ccxx+ fromSuffix "cxx" = c Ccxx+ fromSuffix "s" = as False+ fromSuffix "S" = as True+ fromSuffix "ll" = Just <$> llvmPipeline pipe_env hsc_env Nothing input_fn+ fromSuffix "bc" = Just <$> llvmLlcPipeline pipe_env hsc_env Nothing input_fn+ fromSuffix "lm_s" = Just <$> llvmManglePipeline pipe_env hsc_env Nothing input_fn+ fromSuffix "o" = return (Just input_fn)+ fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn+ fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn+ fromSuffix _ = return (Just input_fn)++{-++Note [The Pipeline Monad]+~~~~~~~~~~~~~~~~~~~~~~~~~++The pipeline is represented as a free monad by the `TPipelineClass` type synonym,+which stipulates the general monadic interface for the pipeline and `MonadUse`, instantiated+to `TPhase`, which indicates the actions available in the pipeline.++The `TPhase` actions correspond to different compiled phases, they are executed by+the 'runPhase' function which interprets each action into IO.++The idea in the future is that we can now implement different instiations of+`TPipelineClass` to give different behaviours that the default `HookedPhase` implementation:++* Additional logging of different phases+* Automatic parrelism (in the style of shake)+* Easy consumption by external tools such as ghcide+* Easier to create your own pipeline and extend existing pipelines.++The structure of the code as a free monad also means that the return type of each+phase is a lot more flexible.+ -}
+ compiler/GHC/Driver/Pipeline.hs-boot view
@@ -0,0 +1,13 @@+module GHC.Driver.Pipeline where+++import GHC.Driver.Env.Types ( HscEnv )+import GHC.ForeignSrcLang ( ForeignSrcLang )+import GHC.Prelude (FilePath, IO)+import GHC.Unit.Module.Location (ModLocation)+import GHC.Unit.Module.Name (ModuleName)+import GHC.Driver.Session (DynFlags)++-- These are used in GHC.Driver.Pipeline.Execute, but defined in terms of runPipeline+compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath+compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
+ compiler/GHC/Driver/Pipeline/Execute.hs view
@@ -0,0 +1,1267 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GADTs #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+#include "ghcplatform.h"++{- Functions for providing the default interpretation of the 'TPhase' actions+-}+module GHC.Driver.Pipeline.Execute where++import GHC.Prelude+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Catch+import GHC.Driver.Hooks+import Control.Monad.Trans.Reader+import GHC.Driver.Pipeline.Monad+import GHC.Driver.Pipeline.Phases+import GHC.Driver.Env hiding (Hsc)+import GHC.Unit.Module.Location+import GHC.Driver.Phases+import GHC.Unit.Module.Name ( ModuleName )+import GHC.Unit.Types+import GHC.Types.SourceFile+import GHC.Unit.Module.Status+import GHC.Unit.Module.ModIface+import GHC.Linker.Types+import GHC.Driver.Backend+import GHC.Driver.Session+import GHC.Driver.CmdLine+import GHC.Unit.Module.ModSummary+import qualified GHC.LanguageExtensions as LangExt+import GHC.Types.SrcLoc+import GHC.Driver.Main+import GHC.Tc.Types+import GHC.Types.Error+import GHC.Driver.Errors.Types+import GHC.Fingerprint+import GHC.Utils.Logger+import GHC.Utils.TmpFs+import GHC.Platform+import Data.List (intercalate, isInfixOf)+import GHC.Unit.Env+import GHC.SysTools.Info+import GHC.Utils.Error+import Data.Maybe+import GHC.CmmToLlvm.Mangler+import GHC.SysTools+import GHC.Utils.Panic.Plain+import System.Directory+import System.FilePath+import GHC.Utils.Misc+import GHC.Utils.Outputable+import qualified Control.Exception as Exception+import GHC.Unit.Info+import GHC.Unit.State+import GHC.Unit.Home+import GHC.Data.Maybe+import GHC.Iface.Make+import Data.Time+import GHC.Driver.Config.Parser+import GHC.Parser.Header+import GHC.Data.StringBuffer+import GHC.Types.SourceError+import GHC.Unit.Finder+import GHC.Runtime.Loader+import Data.IORef+import GHC.Types.Name.Env+import GHC.Platform.Ways+import GHC.Platform.ArchOS+import GHC.CmmToLlvm.Base ( llvmVersionList )+import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub)+import GHC.Settings+import System.IO+import GHC.Linker.ExtraObj+import GHC.Linker.Dynamic+import Data.Version+import GHC.Utils.Panic++newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a }+ deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)++instance MonadUse TPhase HookedUse where+ use fa = HookedUse $ \(hooks, (PhaseHook k)) ->+ case runPhaseHook hooks of+ Nothing -> k fa+ Just (PhaseHook h) -> h fa++-- | The default mechanism to run a pipeline, see Note [The Pipeline Monad]+runPipeline :: Hooks -> HookedUse a -> IO a+runPipeline hooks pipeline = runHookedUse pipeline (hooks, PhaseHook runPhase)++-- | Default interpretation of each phase, in terms of IO.+runPhase :: TPhase out -> IO out+runPhase (T_Unlit pipe_env hsc_env inp_path) = do+ out_path <- phaseOutputFilenameNew (Cpp HsSrcFile) pipe_env hsc_env Nothing+ runUnlitPhase hsc_env inp_path out_path+runPhase (T_FileArgs hsc_env inp_path) = getFileArgs hsc_env inp_path+runPhase (T_Cpp pipe_env hsc_env inp_path) = do+ out_path <- phaseOutputFilenameNew (HsPp HsSrcFile) pipe_env hsc_env Nothing+ runCppPhase hsc_env inp_path out_path+runPhase (T_HsPp pipe_env hsc_env origin_path inp_path) = do+ out_path <- phaseOutputFilenameNew (Hsc HsSrcFile) pipe_env hsc_env Nothing+ runHsPpPhase hsc_env origin_path inp_path out_path+runPhase (T_HscRecomp pipe_env hsc_env fp hsc_src) = do+ runHscPhase pipe_env hsc_env fp hsc_src+runPhase (T_Hsc hsc_env mod_sum) = runHscTcPhase hsc_env mod_sum+runPhase (T_HscPostTc hsc_env ms fer m mfi) =+ runHscPostTcPhase hsc_env ms fer m mfi+runPhase (T_HscBackend pipe_env hsc_env mod_name hsc_src location x) = do+ runHscBackendPhase pipe_env hsc_env mod_name hsc_src location x+runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do+ output_fn <- phaseOutputFilenameNew Cmm pipe_env hsc_env Nothing+ doCpp (hsc_logger hsc_env)+ (hsc_tmpfs hsc_env)+ (hsc_dflags hsc_env)+ (hsc_unit_env hsc_env)+ False{-not raw-}+ input_fn output_fn+ return output_fn+runPhase (T_Cmm pipe_env hsc_env input_fn) = do+ let dflags = hsc_dflags hsc_env+ let next_phase = hscPostBackendPhase HsSrcFile (backend dflags)+ output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing+ mstub <- hscCompileCmmFile hsc_env input_fn output_fn+ stub_o <- mapM (compileStub hsc_env) mstub+ let foreign_os = (maybeToList stub_o)+ return (foreign_os, output_fn)++runPhase (T_Cc phase pipe_env hsc_env input_fn) = runCcPhase phase pipe_env hsc_env input_fn+runPhase (T_As cpp pipe_env hsc_env location input_fn) = do+ runAsPhase cpp pipe_env hsc_env location input_fn+runPhase (T_LlvmOpt pipe_env hsc_env input_fn) =+ runLlvmOptPhase pipe_env hsc_env input_fn+runPhase (T_LlvmLlc pipe_env hsc_env input_fn) =+ runLlvmLlcPhase pipe_env hsc_env input_fn+runPhase (T_LlvmMangle pipe_env hsc_env input_fn) =+ runLlvmManglePhase pipe_env hsc_env input_fn+runPhase (T_MergeForeign pipe_env hsc_env location input_fn fos) =+ runMergeForeign pipe_env hsc_env location input_fn fos++runLlvmManglePhase :: PipeEnv -> HscEnv -> FilePath -> IO [Char]+runLlvmManglePhase pipe_env hsc_env input_fn = do+ let next_phase = As False+ output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing+ let dflags = hsc_dflags hsc_env+ llvmFixupAsm (targetPlatform dflags) input_fn output_fn+ return output_fn++runMergeForeign :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> [FilePath] -> IO FilePath+runMergeForeign _pipe_env hsc_env _location input_fn foreign_os = do+ if null foreign_os+ then return input_fn+ else do+ -- Work around a binutil < 2.31 bug where you can't merge objects if the output file+ -- is one of the inputs+ new_o <- newTempName (hsc_logger hsc_env)+ (hsc_tmpfs hsc_env)+ (tmpDir (hsc_dflags hsc_env))+ TFL_CurrentModule "o"+ copyFile input_fn new_o+ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ let tmpfs = hsc_tmpfs hsc_env+ joinObjectFiles logger tmpfs dflags (new_o : foreign_os) input_fn+ return input_fn++runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath+runLlvmLlcPhase pipe_env hsc_env input_fn = do+ -- Note [Clamping of llc optimizations]+ --+ -- See #13724+ --+ -- we clamp the llc optimization between [1,2]. This is because passing -O0+ -- to llc 3.9 or llc 4.0, the naive register allocator can fail with+ --+ -- Error while trying to spill R1 from class GPR: Cannot scavenge register+ -- without an emergency spill slot!+ --+ -- Observed at least with target 'arm-unknown-linux-gnueabihf'.+ --+ --+ -- With LLVM4, llc -O3 crashes when ghc-stage1 tries to compile+ -- rts/HeapStackCheck.cmm+ --+ -- llc -O3 '-mtriple=arm-unknown-linux-gnueabihf' -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s+ -- 0 llc 0x0000000102ae63e8 llvm::sys::PrintStackTrace(llvm::raw_ostream&) + 40+ -- 1 llc 0x0000000102ae69a6 SignalHandler(int) + 358+ -- 2 libsystem_platform.dylib 0x00007fffc23f4b3a _sigtramp + 26+ -- 3 libsystem_c.dylib 0x00007fffc226498b __vfprintf + 17876+ -- 4 llc 0x00000001029d5123 llvm::SelectionDAGISel::LowerArguments(llvm::Function const&) + 5699+ -- 5 llc 0x0000000102a21a35 llvm::SelectionDAGISel::SelectAllBasicBlocks(llvm::Function const&) + 3381+ -- 6 llc 0x0000000102a202b1 llvm::SelectionDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 1457+ -- 7 llc 0x0000000101bdc474 (anonymous namespace)::ARMDAGToDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 20+ -- 8 llc 0x00000001025573a6 llvm::MachineFunctionPass::runOnFunction(llvm::Function&) + 134+ -- 9 llc 0x000000010274fb12 llvm::FPPassManager::runOnFunction(llvm::Function&) + 498+ -- 10 llc 0x000000010274fd23 llvm::FPPassManager::runOnModule(llvm::Module&) + 67+ -- 11 llc 0x00000001027501b8 llvm::legacy::PassManagerImpl::run(llvm::Module&) + 920+ -- 12 llc 0x000000010195f075 compileModule(char**, llvm::LLVMContext&) + 12133+ -- 13 llc 0x000000010195bf0b main + 491+ -- 14 libdyld.dylib 0x00007fffc21e5235 start + 1+ -- Stack dump:+ -- 0. Program arguments: llc -O3 -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s+ -- 1. Running pass 'Function Pass Manager' on module '/var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc'.+ -- 2. Running pass 'ARM Instruction Selection' on function '@"stg_gc_f1$def"'+ --+ -- Observed at least with -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa+ --+ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ llvmOpts = case optLevel dflags of+ 0 -> "-O1" -- required to get the non-naive reg allocator. Passing -regalloc=greedy is not sufficient.+ 1 -> "-O1"+ _ -> "-O2"++ defaultOptions = map GHC.SysTools.Option . concatMap words . snd+ $ unzip (llvmOptions dflags)+ optFlag = if null (getOpts dflags opt_lc)+ then map GHC.SysTools.Option $ words llvmOpts+ else []++ next_phase <- if -- hidden debugging flag '-dno-llvm-mangler' to skip mangling+ | gopt Opt_NoLlvmMangler dflags -> return (As False)+ | otherwise -> return LlvmMangle++ output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing++ GHC.SysTools.runLlvmLlc logger dflags+ ( optFlag+ ++ defaultOptions+ ++ [ GHC.SysTools.FileOption "" input_fn+ , GHC.SysTools.Option "-o"+ , GHC.SysTools.FileOption "" output_fn+ ]+ )++ return output_fn++runLlvmOptPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath+runLlvmOptPhase pipe_env hsc_env input_fn = do+ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ let -- we always (unless -optlo specified) run Opt since we rely on it to+ -- fix up some pretty big deficiencies in the code we generate+ optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2]+ llvmOpts = case lookup optIdx $ llvmPasses $ llvmConfig dflags of+ Just passes -> passes+ Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "+ ++ "is missing passes for level "+ ++ show optIdx)+ defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst+ $ unzip (llvmOptions dflags)++ -- don't specify anything if user has specified commands. We do this+ -- for opt but not llc since opt is very specifically for optimisation+ -- passes only, so if the user is passing us extra options we assume+ -- they know what they are doing and don't get in the way.+ optFlag = if null (getOpts dflags opt_lo)+ then map GHC.SysTools.Option $ words llvmOpts+ else []++ output_fn <- phaseOutputFilenameNew LlvmLlc pipe_env hsc_env Nothing++ GHC.SysTools.runLlvmOpt logger dflags+ ( optFlag+ ++ defaultOptions +++ [ GHC.SysTools.FileOption "" input_fn+ , GHC.SysTools.Option "-o"+ , GHC.SysTools.FileOption "" output_fn]+ )++ return output_fn+++runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath+runAsPhase with_cpp pipe_env hsc_env location input_fn = do+ let dflags = hsc_dflags hsc_env+ let logger = hsc_logger hsc_env+ let unit_env = hsc_unit_env hsc_env+ let platform = ue_platform unit_env++ -- LLVM from version 3.0 onwards doesn't support the OS X system+ -- assembler, so we use clang as the assembler instead. (#5636)+ let (as_prog, get_asm_info) | backend dflags == LLVM+ , platformOS platform == OSDarwin+ = (GHC.SysTools.runClang, pure Clang)+ | otherwise+ = (GHC.SysTools.runAs, getAssemblerInfo logger dflags)++ asmInfo <- get_asm_info++ let cmdline_include_paths = includePaths dflags+ let pic_c_flags = picCCOpts dflags++ output_fn <- phaseOutputFilenameNew StopLn pipe_env hsc_env location++ -- we create directories for the object file, because it+ -- might be a hierarchical module.+ createDirectoryIfMissing True (takeDirectory output_fn)++ let global_includes = [ GHC.SysTools.Option ("-I" ++ p)+ | p <- includePathsGlobal cmdline_include_paths ]+ let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)+ | p <- includePathsQuote cmdline_include_paths +++ includePathsQuoteImplicit cmdline_include_paths]+ let runAssembler inputFilename outputFilename+ = withAtomicRename outputFilename $ \temp_outputFilename ->+ as_prog+ logger dflags+ (local_includes ++ global_includes+ -- See Note [-fPIC for assembler]+ ++ map GHC.SysTools.Option pic_c_flags+ -- See Note [Produce big objects on Windows]+ ++ [ GHC.SysTools.Option "-Wa,-mbig-obj"+ | platformOS (targetPlatform dflags) == OSMinGW32+ , not $ target32Bit (targetPlatform dflags)+ ]++ -- We only support SparcV9 and better because V8 lacks an atomic CAS+ -- instruction so we have to make sure that the assembler accepts the+ -- instruction set. Note that the user can still override this+ -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag+ -- regardless of the ordering.+ --+ -- This is a temporary hack.+ ++ (if platformArch (targetPlatform dflags) == ArchSPARC+ then [GHC.SysTools.Option "-mcpu=v9"]+ else [])+ ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51]+ then [GHC.SysTools.Option "-Qunused-arguments"]+ else [])+ ++ [ GHC.SysTools.Option "-x"+ , if with_cpp+ then GHC.SysTools.Option "assembler-with-cpp"+ else GHC.SysTools.Option "assembler"+ , GHC.SysTools.Option "-c"+ , GHC.SysTools.FileOption "" inputFilename+ , GHC.SysTools.Option "-o"+ , GHC.SysTools.FileOption "" temp_outputFilename+ ])++ debugTraceMsg logger 4 (text "Running the assembler")+ runAssembler input_fn output_fn++ return output_fn+++runCcPhase :: Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath+runCcPhase cc_phase pipe_env hsc_env input_fn = do+ let dflags = hsc_dflags hsc_env+ let logger = hsc_logger hsc_env+ let unit_env = hsc_unit_env hsc_env+ let home_unit = hsc_home_unit hsc_env+ let tmpfs = hsc_tmpfs hsc_env+ let platform = ue_platform unit_env+ let hcc = cc_phase `eqPhase` HCc++ let cmdline_include_paths = includePaths dflags++ -- HC files have the dependent packages stamped into them+ pkgs <- if hcc then getHCFilePackages input_fn else return []++ -- add package include paths even if we're just compiling .c+ -- files; this is the Value Add(TM) that using ghc instead of+ -- gcc gives you :)+ ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env pkgs)+ let pkg_include_dirs = collectIncludeDirs ps+ let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []+ (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)+ let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []+ (includePathsQuote cmdline_include_paths +++ includePathsQuoteImplicit cmdline_include_paths)+ let include_paths = include_paths_quote ++ include_paths_global++ -- pass -D or -optP to preprocessor when compiling foreign C files+ -- (#16737). Doing it in this way is simpler and also enable the C+ -- compiler to perform preprocessing and parsing in a single pass,+ -- but it may introduce inconsistency if a different pgm_P is specified.+ let more_preprocessor_opts = concat+ [ ["-Xpreprocessor", i]+ | not hcc+ , i <- getOpts dflags opt_P+ ]++ let gcc_extra_viac_flags = extraGccViaCFlags dflags+ let pic_c_flags = picCCOpts dflags++ let verbFlags = getVerbFlags dflags++ -- cc-options are not passed when compiling .hc files. Our+ -- hc code doesn't not #include any header files anyway, so these+ -- options aren't necessary.+ let pkg_extra_cc_opts+ | hcc = []+ | otherwise = collectExtraCcOpts ps++ let framework_paths+ | platformUsesFrameworks platform+ = let pkgFrameworkPaths = collectFrameworksDirs ps+ cmdlineFrameworkPaths = frameworkPaths dflags+ in map ("-F"++) (cmdlineFrameworkPaths ++ pkgFrameworkPaths)+ | otherwise+ = []++ let cc_opt | optLevel dflags >= 2 = [ "-O2" ]+ | optLevel dflags >= 1 = [ "-O" ]+ | otherwise = []++ -- Decide next phase+ let next_phase = As False+ output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing++ let+ more_hcc_opts =+ -- on x86 the floating point regs have greater precision+ -- than a double, which leads to unpredictable results.+ -- By default, we turn this off with -ffloat-store unless+ -- the user specified -fexcess-precision.+ (if platformArch platform == ArchX86 &&+ not (gopt Opt_ExcessPrecision dflags)+ then [ "-ffloat-store" ]+ else []) ++++ -- gcc's -fstrict-aliasing allows two accesses to memory+ -- to be considered non-aliasing if they have different types.+ -- This interacts badly with the C code we generate, which is+ -- very weakly typed, being derived from C--.+ ["-fno-strict-aliasing"]++ ghcVersionH <- getGhcVersionPathName dflags unit_env++ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (+ [ GHC.SysTools.FileOption "" input_fn+ , GHC.SysTools.Option "-o"+ , GHC.SysTools.FileOption "" output_fn+ ]+ ++ map GHC.SysTools.Option (+ pic_c_flags++ -- Stub files generated for foreign exports references the runIO_closure+ -- and runNonIO_closure symbols, which are defined in the base package.+ -- These symbols are imported into the stub.c file via RtsAPI.h, and the+ -- way we do the import depends on whether we're currently compiling+ -- the base package or not.+ ++ (if platformOS platform == OSMinGW32 &&+ isHomeUnitId home_unit baseUnitId+ then [ "-DCOMPILING_BASE_PACKAGE" ]+ else [])++ -- We only support SparcV9 and better because V8 lacks an atomic CAS+ -- instruction. Note that the user can still override this+ -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag+ -- regardless of the ordering.+ --+ -- This is a temporary hack. See #2872, commit+ -- 5bd3072ac30216a505151601884ac88bf404c9f2+ ++ (if platformArch platform == ArchSPARC+ then ["-mcpu=v9"]+ else [])++ -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.+ ++ (if (cc_phase /= Ccxx && cc_phase /= Cobjcxx)+ then ["-Wimplicit"]+ else [])++ ++ (if hcc+ then gcc_extra_viac_flags ++ more_hcc_opts+ else [])+ ++ verbFlags+ ++ [ "-S" ]+ ++ cc_opt+ ++ [ "-include", ghcVersionH ]+ ++ framework_paths+ ++ include_paths+ ++ more_preprocessor_opts+ ++ pkg_extra_cc_opts+ ))++ return output_fn++-- This is where all object files get written from, for hs-boot and hsig files as well.+runHscBackendPhase :: PipeEnv+ -> HscEnv+ -> ModuleName+ -> HscSource+ -> ModLocation+ -> HscBackendAction+ -> IO ([FilePath], ModIface, Maybe Linkable, FilePath)+runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do+ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ o_file = ml_obj_file location -- The real object file+ next_phase = hscPostBackendPhase src_flavour (backend dflags)+ case result of+ HscUpdate iface ->+ do+ case src_flavour of+ HsigFile -> do+ -- We need to create a REAL but empty .o file+ -- because we are going to attempt to put it in a library+ let input_fn = expectJust "runPhase" (ml_hs_file location)+ basename = dropExtension input_fn+ compileEmptyStub dflags hsc_env basename location mod_name++ -- In the case of hs-boot files, generate a dummy .o-boot+ -- stamp file for the benefit of Make+ HsBootFile -> touchObjectFile logger dflags o_file+ HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"++ return ([], iface, Nothing, o_file)+ HscRecomp { hscs_guts = cgguts,+ hscs_mod_location = mod_location,+ hscs_partial_iface = partial_iface,+ hscs_old_iface_hash = mb_old_iface_hash+ }+ -> case backend dflags of+ NoBackend -> panic "HscRecomp not relevant for NoBackend"+ Interpreter -> do+ -- In interpreted mode the regular codeGen backend is not run so we+ -- generate a interface without codeGen info.+ final_iface <- mkFullIface hsc_env partial_iface Nothing+ hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location++ (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location++ stub_o <- case hasStub of+ Nothing -> return []+ Just stub_c -> do+ stub_o <- compileStub hsc_env stub_c+ return [DotO stub_o]++ let hs_unlinked = [BCOs comp_bc spt_entries]+ unlinked_time <- getCurrentTime+ let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name)+ (hs_unlinked ++ stub_o)+ return ([], final_iface, Just linkable, panic "interpreter")+ _ -> do+ output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location)+ (outputFilename, mStub, foreign_files, cg_infos) <-+ hscGenHardCode hsc_env cgguts mod_location output_fn+ final_iface <- mkFullIface hsc_env partial_iface (Just cg_infos)++ -- See Note [Writing interface files]+ hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location++ stub_o <- mapM (compileStub hsc_env) mStub+ foreign_os <-+ mapM (uncurry (compileForeign hsc_env)) foreign_files+ let fos = (maybe [] return stub_o ++ foreign_os)++ -- This is awkward, no linkable is produced here because we still+ -- have some way to do before the object file is produced+ -- In future we can split up the driver logic more so that this function+ -- is in TPipeline and in this branch we can invoke the rest of the backend phase.+ return (fos, final_iface, Nothing, outputFilename)+++runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath+runUnlitPhase hsc_env input_fn output_fn = do+ let+ -- escape the characters \, ", and ', but don't try to escape+ -- Unicode or anything else (so we don't use Util.charToC+ -- here). If we get this wrong, then in+ -- GHC.HsToCore.Coverage.isGoodTickSrcSpan where we check that the filename in+ -- a SrcLoc is the same as the source filenaame, the two will+ -- look bogusly different. See test:+ -- libraries/hpc/tests/function/subdir/tough2.hs+ escape ('\\':cs) = '\\':'\\': escape cs+ escape ('\"':cs) = '\\':'\"': escape cs+ escape ('\'':cs) = '\\':'\'': escape cs+ escape (c:cs) = c : escape cs+ escape [] = []++ let flags = [ -- The -h option passes the file name for unlit to+ -- put in a #line directive+ GHC.SysTools.Option "-h"+ -- See Note [Don't normalise input filenames].+ , GHC.SysTools.Option $ escape input_fn+ , GHC.SysTools.FileOption "" input_fn+ , GHC.SysTools.FileOption "" output_fn+ ]++ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ GHC.SysTools.runUnlit logger dflags flags++ return output_fn++getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [Warn]))+getFileArgs hsc_env input_fn = do+ let dflags0 = hsc_dflags hsc_env+ parser_opts = initParserOpts dflags0+ src_opts <- getOptionsFromFile parser_opts input_fn+ (dflags1, unhandled_flags, warns)+ <- parseDynamicFilePragma dflags0 src_opts+ checkProcessArgsResult unhandled_flags+ return (dflags1, warns)++runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath+runCppPhase hsc_env input_fn output_fn = do+ doCpp (hsc_logger hsc_env)+ (hsc_tmpfs hsc_env)+ (hsc_dflags hsc_env)+ (hsc_unit_env hsc_env)+ True{-raw-}+ input_fn output_fn+ return output_fn+++runHscPhase :: PipeEnv+ -> HscEnv+ -> FilePath+ -> HscSource+ -> IO (HscEnv, ModSummary, HscRecompStatus)+runHscPhase pipe_env hsc_env0 input_fn src_flavour = do+ let dflags0 = hsc_dflags hsc_env0+ PipeEnv{ src_basename=basename,+ src_suffix=suff } = pipe_env++ -- we add the current directory (i.e. the directory in which+ -- the .hs files resides) to the include path, since this is+ -- what gcc does, and it's probably what you want.+ let current_dir = takeDirectory basename+ new_includes = addImplicitQuoteInclude paths [current_dir]+ paths = includePaths dflags0+ dflags = dflags0 { includePaths = new_includes }+ hsc_env = hscSetFlags dflags hsc_env0++++ -- gather the imports and module name+ (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do+ buf <- hGetStringBuffer input_fn+ let imp_prelude = xopt LangExt.ImplicitPrelude dflags+ popts = initParserOpts dflags+ eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)+ case eimps of+ Left errs -> throwErrors (GhcPsMessage <$> errs)+ Right (src_imps,imps, ghc_prim_imp, L _ mod_name) -> return+ (Just buf, mod_name, imps, src_imps, ghc_prim_imp)++ -- Take -o into account if present+ -- Very like -ohi, but we must *only* do this if we aren't linking+ -- (If we're linking then the -o applies to the linked thing, not to+ -- the object file for one module.)+ -- Note the nasty duplication with the same computation in compileFile above+ location <- getLocation pipe_env dflags src_flavour mod_name+ let o_file = ml_obj_file location -- The real object file+ hi_file = ml_hi_file location+ hie_file = ml_hie_file location+ dyn_o_file = dynamicOutputFile dflags o_file++ src_hash <- getFileHash (basename <.> suff)+ hi_date <- modificationTimeIfExists hi_file+ hie_date <- modificationTimeIfExists hie_file+ o_mod <- modificationTimeIfExists o_file+ dyn_o_mod <- modificationTimeIfExists dyn_o_file++ -- Tell the finder cache about this module+ mod <- do+ let home_unit = hsc_home_unit hsc_env+ let fc = hsc_FC hsc_env+ addHomeModuleToFinder fc home_unit mod_name location++ -- Make the ModSummary to hand to hscMain+ let+ mod_summary = ModSummary { ms_mod = mod,+ ms_hsc_src = src_flavour,+ ms_hspp_file = input_fn,+ ms_hspp_opts = dflags,+ ms_hspp_buf = hspp_buf,+ ms_location = location,+ ms_hs_hash = src_hash,+ ms_obj_date = o_mod,+ ms_dyn_obj_date = dyn_o_mod,+ ms_parsed_mod = Nothing,+ ms_iface_date = hi_date,+ ms_hie_date = hie_date,+ ms_ghc_prim_import = ghc_prim_imp,+ ms_textual_imps = imps,+ ms_srcimps = src_imps }+++ -- run the compiler!+ let msg :: Messager+ msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what+ plugin_hsc_env' <- initializePlugins hsc_env (Just $ ms_mnwib mod_summary)++ -- Need to set the knot-tying mutable variable for interface+ -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.+ -- See also Note [hsc_type_env_var hack]+ type_env_var <- newIORef emptyNameEnv+ let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_var = Just (mod, type_env_var) }++ status <- hscRecompStatus (Just msg) plugin_hsc_env mod_summary+ Nothing Nothing (1, 1)++ return (plugin_hsc_env, mod_summary, status)++runHscTcPhase :: HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)+runHscTcPhase = hscTypecheckAndGetWarnings++runHscPostTcPhase ::+ HscEnv+ -> ModSummary+ -> FrontendResult+ -> Messages GhcMessage+ -> Maybe Fingerprint+ -> IO HscBackendAction+runHscPostTcPhase hsc_env mod_summary tc_result tc_warnings mb_old_hash = do+ runHsc hsc_env $ do+ hscDesugarAndSimplify mod_summary tc_result tc_warnings mb_old_hash+++runHsPpPhase :: HscEnv -> FilePath -> FilePath -> FilePath -> IO FilePath+runHsPpPhase hsc_env orig_fn input_fn output_fn = do+ let dflags = hsc_dflags hsc_env+ let logger = hsc_logger hsc_env+ GHC.SysTools.runPp logger dflags+ ( [ GHC.SysTools.Option orig_fn+ , GHC.SysTools.Option input_fn+ , GHC.SysTools.FileOption "" output_fn+ ] )+ return output_fn++phaseOutputFilenameNew :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath+phaseOutputFilenameNew next_phase pipe_env hsc_env maybe_loc = do+ let PipeEnv{stop_phase, src_basename, output_spec} = pipe_env+ let dflags = hsc_dflags hsc_env+ logger = hsc_logger hsc_env+ tmpfs = hsc_tmpfs hsc_env+ getOutputFilename logger tmpfs (stopPhaseToPhase stop_phase) output_spec+ src_basename dflags next_phase maybe_loc+++-- | Computes the next output filename for something in the compilation+-- pipeline. This is controlled by several variables:+--+-- 1. 'Phase': the last phase to be run (e.g. 'stopPhase'). This+-- is used to tell if we're in the last phase or not, because+-- in that case flags like @-o@ may be important.+-- 2. 'PipelineOutput': is this intended to be a 'Temporary' or+-- 'Persistent' build output? Temporary files just go in+-- a fresh temporary name.+-- 3. 'String': what was the basename of the original input file?+-- 4. 'DynFlags': the obvious thing+-- 5. 'Phase': the phase we want to determine the output filename of.+-- 6. @Maybe ModLocation@: the 'ModLocation' of the module we're+-- compiling; this can be used to override the default output+-- of an object file. (TODO: do we actually need this?)+getOutputFilename+ :: Logger+ -> TmpFs+ -> Phase+ -> PipelineOutput+ -> String+ -> DynFlags+ -> Phase -- next phase+ -> Maybe ModLocation+ -> IO FilePath+getOutputFilename logger tmpfs stop_phase output basename dflags next_phase maybe_location+ | is_last_phase, Persistent <- output = persistent_fn+ | is_last_phase, SpecificFile <- output = case outputFile dflags of+ Just f -> return f+ Nothing ->+ panic "SpecificFile: No filename"+ | keep_this_output = persistent_fn+ | Temporary lifetime <- output = newTempName logger tmpfs (tmpDir dflags) lifetime suffix+ | otherwise = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule+ suffix+ where+ hcsuf = hcSuf dflags+ odir = objectDir dflags+ osuf = objectSuf dflags+ keep_hc = gopt Opt_KeepHcFiles dflags+ keep_hscpp = gopt Opt_KeepHscppFiles dflags+ keep_s = gopt Opt_KeepSFiles dflags+ keep_bc = gopt Opt_KeepLlvmFiles dflags++ myPhaseInputExt HCc = hcsuf+ myPhaseInputExt MergeForeign = osuf+ myPhaseInputExt StopLn = osuf+ myPhaseInputExt other = phaseInputExt other++ is_last_phase = next_phase `eqPhase` stop_phase++ -- sometimes, we keep output from intermediate stages+ keep_this_output =+ case next_phase of+ As _ | keep_s -> True+ LlvmOpt | keep_bc -> True+ HCc | keep_hc -> True+ HsPp _ | keep_hscpp -> True -- See #10869+ _other -> False++ suffix = myPhaseInputExt next_phase++ -- persistent object files get put in odir+ persistent_fn+ | StopLn <- next_phase = return odir_persistent+ | otherwise = return persistent++ persistent = basename <.> suffix++ odir_persistent+ | Just loc <- maybe_location = ml_obj_file loc+ | Just d <- odir = (d </> persistent)+ | otherwise = persistent+++-- | LLVM Options. These are flags to be passed to opt and llc, to ensure+-- consistency we list them in pairs, so that they form groups.+llvmOptions :: DynFlags+ -> [(String, String)] -- ^ pairs of (opt, llc) arguments+llvmOptions dflags =+ [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ]+ ++ [("-relocation-model=" ++ rmodel+ ,"-relocation-model=" ++ rmodel) | not (null rmodel)]+ ++ [("-stack-alignment=" ++ (show align)+ ,"-stack-alignment=" ++ (show align)) | align > 0 ]++ -- Additional llc flags+ ++ [("", "-mcpu=" ++ mcpu) | not (null mcpu)+ , not (any (isInfixOf "-mcpu") (getOpts dflags opt_lc)) ]+ ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]+ ++ [("", "-target-abi=" ++ abi) | not (null abi) ]++ where target = platformMisc_llvmTarget $ platformMisc dflags+ Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)++ -- Relocation models+ rmodel | gopt Opt_PIC dflags = "pic"+ | positionIndependent dflags = "pic"+ | ways dflags `hasWay` WayDyn = "dynamic-no-pic"+ | otherwise = "static"++ platform = targetPlatform dflags++ align :: Int+ align = case platformArch platform of+ ArchX86_64 | isAvxEnabled dflags -> 32+ _ -> 0++ attrs :: String+ attrs = intercalate "," $ mattr+ ++ ["+sse42" | isSse4_2Enabled dflags ]+ ++ ["+sse2" | isSse2Enabled platform ]+ ++ ["+sse" | isSseEnabled platform ]+ ++ ["+avx512f" | isAvx512fEnabled dflags ]+ ++ ["+avx2" | isAvx2Enabled dflags ]+ ++ ["+avx" | isAvxEnabled dflags ]+ ++ ["+avx512cd"| isAvx512cdEnabled dflags ]+ ++ ["+avx512er"| isAvx512erEnabled dflags ]+ ++ ["+avx512pf"| isAvx512pfEnabled dflags ]+ ++ ["+bmi" | isBmiEnabled dflags ]+ ++ ["+bmi2" | isBmi2Enabled dflags ]++ abi :: String+ abi = case platformArch (targetPlatform dflags) of+ ArchRISCV64 -> "lp64d"+ _ -> ""++-- -----------------------------------------------------------------------------+-- Running CPP++-- | Run CPP+--+-- UnitEnv is needed to compute MIN_VERSION macros+doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> FilePath -> FilePath -> IO ()+doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do+ let hscpp_opts = picPOpts dflags+ let cmdline_include_paths = includePaths dflags+ let unit_state = ue_units unit_env+ pkg_include_dirs <- mayThrowUnitErr+ (collectIncludeDirs <$> preloadUnitsInfo unit_env)+ let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []+ (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)+ let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []+ (includePathsQuote cmdline_include_paths +++ includePathsQuoteImplicit cmdline_include_paths)+ let include_paths = include_paths_quote ++ include_paths_global++ let verbFlags = getVerbFlags dflags++ let cpp_prog args | raw = GHC.SysTools.runCpp logger dflags args+ | otherwise = GHC.SysTools.runCc Nothing logger tmpfs dflags+ (GHC.SysTools.Option "-E" : args)++ let platform = targetPlatform dflags+ targetArch = stringEncodeArch $ platformArch platform+ targetOS = stringEncodeOS $ platformOS platform+ isWindows = platformOS platform == OSMinGW32+ let target_defs =+ [ "-D" ++ HOST_OS ++ "_BUILD_OS",+ "-D" ++ HOST_ARCH ++ "_BUILD_ARCH",+ "-D" ++ targetOS ++ "_HOST_OS",+ "-D" ++ targetArch ++ "_HOST_ARCH" ]+ -- remember, in code we *compile*, the HOST is the same our TARGET,+ -- and BUILD is the same as our HOST.++ let io_manager_defs =+ [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] +++ [ "-D__IO_MANAGER_MIO__=1" ]++ let sse_defs =+ [ "-D__SSE__" | isSseEnabled platform ] +++ [ "-D__SSE2__" | isSse2Enabled platform ] +++ [ "-D__SSE4_2__" | isSse4_2Enabled dflags ]++ let avx_defs =+ [ "-D__AVX__" | isAvxEnabled dflags ] +++ [ "-D__AVX2__" | isAvx2Enabled dflags ] +++ [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] +++ [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] +++ [ "-D__AVX512F__" | isAvx512fEnabled dflags ] +++ [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]++ backend_defs <- getBackendDefs logger dflags++ let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]+ -- Default CPP defines in Haskell source+ ghcVersionH <- getGhcVersionPathName dflags unit_env+ let hsSourceCppOpts = [ "-include", ghcVersionH ]++ -- MIN_VERSION macros+ let uids = explicitUnits unit_state+ pkgs = catMaybes (map (lookupUnit unit_state) uids)+ mb_macro_include <-+ if not (null pkgs) && gopt Opt_VersionMacros dflags+ then do macro_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "h"+ writeFile macro_stub (generatePackageVersionMacros pkgs)+ -- Include version macros for every *exposed* package.+ -- Without -hide-all-packages and with a package database+ -- size of 1000 packages, it takes cpp an estimated 2+ -- milliseconds to process this file. See #10970+ -- comment 8.+ return [GHC.SysTools.FileOption "-include" macro_stub]+ else return []++ cpp_prog ( map GHC.SysTools.Option verbFlags+ ++ map GHC.SysTools.Option include_paths+ ++ map GHC.SysTools.Option hsSourceCppOpts+ ++ map GHC.SysTools.Option target_defs+ ++ map GHC.SysTools.Option backend_defs+ ++ map GHC.SysTools.Option th_defs+ ++ map GHC.SysTools.Option hscpp_opts+ ++ map GHC.SysTools.Option sse_defs+ ++ map GHC.SysTools.Option avx_defs+ ++ map GHC.SysTools.Option io_manager_defs+ ++ mb_macro_include+ -- Set the language mode to assembler-with-cpp when preprocessing. This+ -- alleviates some of the C99 macro rules relating to whitespace and the hash+ -- operator, which we tend to abuse. Clang in particular is not very happy+ -- about this.+ ++ [ GHC.SysTools.Option "-x"+ , GHC.SysTools.Option "assembler-with-cpp"+ , GHC.SysTools.Option input_fn+ -- We hackily use Option instead of FileOption here, so that the file+ -- name is not back-slashed on Windows. cpp is capable of+ -- dealing with / in filenames, so it works fine. Furthermore+ -- if we put in backslashes, cpp outputs #line directives+ -- with *double* backslashes. And that in turn means that+ -- our error messages get double backslashes in them.+ -- In due course we should arrange that the lexer deals+ -- with these \\ escapes properly.+ , GHC.SysTools.Option "-o"+ , GHC.SysTools.FileOption "" output_fn+ ])++getBackendDefs :: Logger -> DynFlags -> IO [String]+getBackendDefs logger dflags | backend dflags == LLVM = do+ llvmVer <- figureLlvmVersion logger dflags+ return $ case fmap llvmVersionList llvmVer of+ Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]+ Just (m:n:_) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]+ _ -> []+ where+ format (major, minor)+ | minor >= 100 = error "getBackendDefs: Unsupported minor version"+ | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int++getBackendDefs _ _ =+ return []++-- | What phase to run after one of the backend code generators has run+hscPostBackendPhase :: HscSource -> Backend -> Phase+hscPostBackendPhase HsBootFile _ = StopLn+hscPostBackendPhase HsigFile _ = StopLn+hscPostBackendPhase _ bcknd =+ case bcknd of+ ViaC -> HCc+ NCG -> As False+ LLVM -> LlvmOpt+ NoBackend -> StopLn+ Interpreter -> StopLn+++compileStub :: HscEnv -> FilePath -> IO FilePath+compileStub hsc_env stub_c = compileForeign hsc_env LangC stub_c+++-- ---------------------------------------------------------------------------+-- join object files into a single relocatable object file, using ld -r++{-+Note [Produce big objects on Windows]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The Windows Portable Executable object format has a limit of 32k sections, which+we tend to blow through pretty easily. Thankfully, there is a "big object"+extension, which raises this limit to 2^32. However, it must be explicitly+enabled in the toolchain:++ * the assembler accepts the -mbig-obj flag, which causes it to produce a+ bigobj-enabled COFF object.++ * the linker accepts the --oformat pe-bigobj-x86-64 flag. Despite what the name+ suggests, this tells the linker to produce a bigobj-enabled COFF object, no a+ PE executable.++We must enable bigobj output in a few places:++ * When merging object files (GHC.Driver.Pipeline.joinObjectFiles)++ * When assembling (GHC.Driver.Pipeline.runPhase (RealPhase As ...))++Unfortunately the big object format is not supported on 32-bit targets so+none of this can be used in that case.+++Note [Merging object files for GHCi]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHCi can usually loads standard linkable object files using GHC's linker+implementation. However, most users build their projects with -split-sections,+meaning that such object files can have an extremely high number of sections.+As the linker must map each of these sections individually, loading such object+files is very inefficient.++To avoid this inefficiency, we use the linker's `-r` flag and a linker script+to produce a merged relocatable object file. This file will contain a singe+text section section and can consequently be mapped far more efficiently. As+gcc tends to do unpredictable things to our linker command line, we opt to+invoke ld directly in this case, in contrast to our usual strategy of linking+via gcc.++-}++joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()+joinObjectFiles logger tmpfs dflags o_files output_fn = do+ let toolSettings' = toolSettings dflags+ ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'+ osInfo = platformOS (targetPlatform dflags)+ ld_r args = GHC.SysTools.runMergeObjects logger tmpfs dflags (+ -- See Note [Produce big objects on Windows]+ concat+ [ [GHC.SysTools.Option "--oformat", GHC.SysTools.Option "pe-bigobj-x86-64"]+ | OSMinGW32 == osInfo+ , not $ target32Bit (targetPlatform dflags)+ ]+ ++ map GHC.SysTools.Option ld_build_id+ ++ [ GHC.SysTools.Option "-o",+ GHC.SysTools.FileOption "" output_fn ]+ ++ args)++ -- suppress the generation of the .note.gnu.build-id section,+ -- which we don't need and sometimes causes ld to emit a+ -- warning:+ ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"]+ | otherwise = []++ if ldIsGnuLd+ then do+ script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript"+ cwd <- getCurrentDirectory+ let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files+ writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"+ ld_r [GHC.SysTools.FileOption "" script]+ else if toolSettings_ldSupportsFilelist toolSettings'+ then do+ filelist <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "filelist"+ writeFile filelist $ unlines o_files+ ld_r [GHC.SysTools.Option "-filelist",+ GHC.SysTools.FileOption "" filelist]+ else+ ld_r (map (GHC.SysTools.FileOption "") o_files)++-----------------------------------------------------------------------------+-- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file++getHCFilePackages :: FilePath -> IO [UnitId]+getHCFilePackages filename =+ Exception.bracket (openFile filename ReadMode) hClose $ \h -> do+ l <- hGetLine h+ case l of+ '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->+ return (map stringToUnitId (words rest))+ _other ->+ return []+++linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()+linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do+ when (haveRtsOptsFlags dflags) $+ logMsg logger MCInfo noSrcSpan+ $ withPprStyle defaultUserStyle+ (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$+ text " Call hs_init_ghc() from your main() function to set these options.")+ linkDynLib logger tmpfs dflags unit_env o_files dep_units++++-- ---------------------------------------------------------------------------+-- Macros (cribbed from Cabal)++generatePackageVersionMacros :: [UnitInfo] -> String+generatePackageVersionMacros pkgs = concat+ -- Do not add any C-style comments. See #3389.+ [ generateMacros "" pkgname version+ | pkg <- pkgs+ , let version = unitPackageVersion pkg+ pkgname = map fixchar (unitPackageNameString pkg)+ ]++fixchar :: Char -> Char+fixchar '-' = '_'+fixchar c = c++generateMacros :: String -> String -> Version -> String+generateMacros prefix name version =+ concat+ ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n"+ ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"+ ," (major1) < ",major1," || \\\n"+ ," (major1) == ",major1," && (major2) < ",major2," || \\\n"+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"+ ,"\n\n"+ ]+ where+ (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)+++-- -----------------------------------------------------------------------------+-- Misc.++++touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()+touchObjectFile logger dflags path = do+ createDirectoryIfMissing True $ takeDirectory path+ GHC.SysTools.touch logger dflags "Touching object file" path++-- | Find out path to @ghcversion.h@ file+getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath+getGhcVersionPathName dflags unit_env = do+ candidates <- case ghcVersionFile dflags of+ Just path -> return [path]+ Nothing -> do+ ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env [rtsUnitId])+ return ((</> "ghcversion.h") <$> collectIncludeDirs ps)++ found <- filterM doesFileExist candidates+ case found of+ [] -> throwGhcExceptionIO (InstallationError+ ("ghcversion.h missing; tried: "+ ++ intercalate ", " candidates))+ (x:_) -> return x++-- Note [-fPIC for assembler]+-- When compiling .c source file GHC's driver pipeline basically+-- does the following two things:+-- 1. ${CC} -S 'PIC_CFLAGS' source.c+-- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S+--+-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?+-- Because on some architectures (at least sparc32) assembler also chooses+-- the relocation type!+-- Consider the following C module:+--+-- /* pic-sample.c */+-- int v;+-- void set_v (int n) { v = n; }+-- int get_v (void) { return v; }+--+-- $ gcc -S -fPIC pic-sample.c+-- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary+-- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary+--+-- $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od+-- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od+-- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od+--+-- Most of architectures won't show any difference in this test, but on sparc32+-- the following assembly snippet:+--+-- sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7+--+-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:+--+-- 3c: 2f 00 00 00 sethi %hi(0), %l7+-- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8+-- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8++{- Note [Don't normalise input filenames]++Summary+ We used to normalise input filenames when starting the unlit phase. This+ broke hpc in `--make` mode with imported literate modules (#2991).++Introduction+ 1) --main+ When compiling a module with --main, GHC scans its imports to find out which+ other modules it needs to compile too. It turns out that there is a small+ difference between saying `ghc --make A.hs`, when `A` imports `B`, and+ specifying both modules on the command line with `ghc --make A.hs B.hs`. In+ the former case, the filename for B is inferred to be './B.hs' instead of+ 'B.hs'.++ 2) unlit+ When GHC compiles a literate haskell file, the source code first needs to go+ through unlit, which turns it into normal Haskell source code. At the start+ of the unlit phase, in `Driver.Pipeline.runPhase`, we call unlit with the+ option `-h` and the name of the original file. We used to normalise this+ filename using System.FilePath.normalise, which among other things removes+ an initial './'. unlit then uses that filename in #line directives that it+ inserts in the transformed source code.++ 3) SrcSpan+ A SrcSpan represents a portion of a source code file. It has fields+ linenumber, start column, end column, and also a reference to the file it+ originated from. The SrcSpans for a literate haskell file refer to the+ filename that was passed to unlit -h.++ 4) -fhpc+ At some point during compilation with -fhpc, in the function+ `GHC.HsToCore.Coverage.isGoodTickSrcSpan`, we compare the filename that a+ `SrcSpan` refers to with the name of the file we are currently compiling.+ For some reason I don't yet understand, they can sometimes legitimally be+ different, and then hpc ignores that SrcSpan.++Problem+ When running `ghc --make -fhpc A.hs`, where `A.hs` imports the literate+ module `B.lhs`, `B` is inferred to be in the file `./B.lhs` (1). At the+ start of the unlit phase, the name `./B.lhs` is normalised to `B.lhs` (2).+ Therefore the SrcSpans of `B` refer to the file `B.lhs` (3), but we are+ still compiling `./B.lhs`. Hpc thinks these two filenames are different (4),+ doesn't include ticks for B, and we have unhappy customers (#2991).++Solution+ Do not normalise `input_fn` when starting the unlit phase.++Alternative solution+ Another option would be to not compare the two filenames on equality, but to+ use System.FilePath.equalFilePath. That function first normalises its+ arguments. The problem is that by the time we need to do the comparison, the+ filenames have been turned into FastStrings, probably for performance+ reasons, so System.FilePath.equalFilePath can not be used directly.++Archeology+ The call to `normalise` was added in a commit called "Fix slash+ direction on Windows with the new filePath code" (c9b6b5e8). The problem+ that commit was addressing has since been solved in a different manner, in a+ commit called "Fix the filename passed to unlit" (1eedbc6b). So the+ `normalise` is no longer necessary.+-}
compiler/GHC/Hs/Syn/Type.hs view
@@ -5,7 +5,7 @@ -- this task, see #12706, #15320, #16804, and #17331. module GHC.Hs.Syn.Type ( -- * Extracting types from HsExpr- lhsExprType, hsExprType,+ lhsExprType, hsExprType, hsWrapperType, -- * Extracting types from HsSyn hsLitType, hsPatType, hsLPatType
compiler/GHC/HsToCore/Expr.hs view
@@ -30,6 +30,7 @@ import GHC.HsToCore.Monad import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs ) import GHC.HsToCore.Errors.Types+import GHC.Hs.Syn.Type ( hsExprType, hsWrapperType ) import GHC.Types.SourceText import GHC.Types.Name import GHC.Types.Name.Env@@ -302,7 +303,9 @@ dsExpr e@(HsApp _ fun arg) = do { fun' <- dsLExpr fun- ; dsWhenNoErrs (dsLExprNoLP arg)+ -- See Note [Desugaring representation-polymorphic applications]+ -- in GHC.HsToCore.Utils+ ; dsWhenNoErrs (hsExprType e) (dsLExprNoLP arg) (\arg' -> mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg') } dsExpr e@(HsAppType {}) = dsHsWrapped e@@ -325,7 +328,7 @@ converting to core it must become a CO. -} -dsExpr (ExplicitTuple _ tup_args boxity)+dsExpr e@(ExplicitTuple _ tup_args boxity) = do { let go (lam_vars, args) (Missing (Scaled mult ty)) -- For every missing expression, we need -- another lambda in the desugaring.@@ -337,15 +340,20 @@ = do { core_expr <- dsLExprNoLP expr ; return (lam_vars, core_expr : args) } - ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args))+ -- See Note [Desugaring representation-polymorphic applications]+ -- in GHC.HsToCore.Utils+ ; dsWhenNoErrs (hsExprType e) (foldM go ([], []) (reverse tup_args)) -- The reverse is because foldM goes left-to-right (\(lam_vars, args) -> mkCoreLams lam_vars $ mkCoreTupBoxity boxity args) } -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make -dsExpr (ExplicitSum types alt arity expr)- = dsWhenNoErrs (dsLExprNoLP expr) (mkCoreUbxSum arity alt types)+dsExpr e@(ExplicitSum types alt arity expr)+ -- See Note [Desugaring representation-polymorphic applications]+ -- in GHC.HsToCore.Utils+ = dsWhenNoErrs (hsExprType e) (dsLExprNoLP expr)+ (mkCoreUbxSum arity alt types) dsExpr (HsPragE _ prag expr) = ds_prag_expr prag expr@@ -796,10 +804,21 @@ ; core_arg_wraps <- mapM dsHsWrapper arg_wraps ; core_res_wrap <- dsHsWrapper res_wrap ; let wrapped_args = zipWithEqual "dsSyntaxExpr" ($) core_arg_wraps arg_exprs- ; dsWhenNoErrs (zipWithM_ dsNoLevPolyExpr wrapped_args [ mk_msg n | n <- [1..] ])- (\_ -> core_res_wrap (mkCoreApps fun wrapped_args)) }- -- Use mkCoreApps instead of mkApps:- -- unboxed types are possible with RebindableSyntax (#19883)+ -- We need to compute the type of the desugared expression without+ -- actually performing the desugaring, which could be problematic+ -- in the presence of representation polymorphism.+ -- See Note [Desugaring representation-polymorphic applications]+ -- in GHC.HsToCore.Utils+ expr_type = hsWrapperType res_wrap+ (applyTypeToArgs (ppr fun) (exprType fun) wrapped_args)+ ; dsWhenNoErrs expr_type+ (zipWithM_ dsNoLevPolyExpr wrapped_args [ mk_msg n | n <- [1..] ])+ (\_ -> core_res_wrap (mkCoreApps fun wrapped_args)) }+ -- Use mkCoreApps instead of mkApps:+ -- unboxed types are possible with RebindableSyntax (#19883)+ -- This won't be evaluated if there are any+ -- representation-polymorphic arguments.+ where mk_msg n = LevityCheckInSyntaxExpr (DsArgNum n) expr dsSyntaxExpr NoSyntaxExprTc _ = panic "dsSyntaxExpr"
compiler/GHC/HsToCore/Foreign/Call.hs view
@@ -224,17 +224,10 @@ -- another case, and a coercion.) -- The result is IO t, so wrap the result in an IO constructor = do { res <- resultWrapper io_res_ty- ; let extra_result_tys- = case res of- (Just ty,_)- | isUnboxedTupleType ty- -> let Just ls = tyConAppArgs_maybe ty in tail ls- _ -> []-- return_result state anss+ ; let return_result state anss = mkCoreUbxTup- (realWorldStatePrimTy : io_res_ty : extra_result_tys)- (state : anss)+ [realWorldStatePrimTy, io_res_ty]+ [state, anss] ; (ccall_res_ty, the_alt) <- mk_alt return_result res @@ -266,11 +259,10 @@ [the_alt] return (realWorldStatePrimTy `mkVisFunTyMany` ccall_res_ty, wrap) where- return_result _ [ans] = ans- return_result _ _ = panic "return_result: expected single result"+ return_result _ ans = ans -mk_alt :: (Expr Var -> [Expr Var] -> Expr Var)+mk_alt :: (Expr Var -> Expr Var -> Expr Var) -> (Maybe Type, Expr Var -> Expr Var) -> DsM (Type, CoreAlt) mk_alt return_result (Nothing, wrap_result)@@ -278,7 +270,7 @@ state_id <- newSysLocalDs Many realWorldStatePrimTy let the_rhs = return_result (Var state_id)- [wrap_result (panic "boxResult")]+ (wrap_result (panic "boxResult")) ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy] the_alt = Alt (DataAlt (tupleDataCon Unboxed 1)) [state_id] the_rhs@@ -292,7 +284,7 @@ do { result_id <- newSysLocalDs Many prim_res_ty ; state_id <- newSysLocalDs Many realWorldStatePrimTy ; let the_rhs = return_result (Var state_id)- [wrap_result (Var result_id)]+ (wrap_result (Var result_id)) ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy, prim_res_ty] the_alt = Alt (DataAlt (tupleDataCon Unboxed 2)) [state_id, result_id] the_rhs ; return (ccall_res_ty, the_alt) }
compiler/GHC/HsToCore/Monad.hs view
@@ -49,7 +49,7 @@ EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Representation polymorphism- dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,+ dsNoLevPoly, dsNoLevPolyExpr, -- Trace injection pprRuntimeTrace@@ -600,7 +600,7 @@ dsNoLevPoly :: Type -> LevityCheckProvenance -> DsM () -- See Note [Representation polymorphism checking] dsNoLevPoly ty provenance =- checkForLevPolyX (\ty -> failWithDs . DsLevityPolyInType ty) provenance ty+ checkForLevPolyX (\ty -> diagnosticDs . DsLevityPolyInType ty) provenance ty -- | Check an expression for representation polymorphism, failing if it is -- representation-polymorphic.@@ -609,20 +609,6 @@ dsNoLevPolyExpr e provenance | isExprLevPoly e = diagnosticDs (DsLevityPolyInExpr e provenance) | otherwise = return ()---- | Runs the thing_inside. If there are no errors, then returns the expr--- given. Otherwise, returns unitExpr. This is useful for doing a bunch--- of representation polymorphism checks and then avoiding making a core App.--- (If we make a core App on a representation-polymorphic argument, detecting--- how to handle the let/app invariant might call isUnliftedType, which panics--- on a representation-polymorphic type.)--- See #12709 for an example of why this machinery is necessary.-dsWhenNoErrs :: DsM a -> (a -> CoreExpr) -> DsM CoreExpr-dsWhenNoErrs thing_inside mk_expr- = do { (result, no_errs) <- askNoErrsDs thing_inside- ; return $ if no_errs- then mk_expr result- else unitExpr } -- | Inject a trace message into the compiled program. Whereas -- pprTrace prints out information *while compiling*, pprRuntimeTrace
compiler/GHC/HsToCore/Quote.hs view
@@ -305,7 +305,7 @@ ; inst_ds <- mapM repInstD instds ; deriv_ds <- mapM repStandaloneDerivD derivds ; fix_ds <- mapM repLFixD fixds- ; _ <- mapM no_default_decl defds+ ; def_ds <- mapM repDefD defds ; for_ds <- mapM repForD fords ; _ <- mapM no_warn (concatMap (wd_warnings . unLoc) warnds)@@ -319,6 +319,7 @@ val_ds ++ catMaybes tycl_ds ++ role_ds ++ kisig_ds ++ (concat fix_ds)+ ++ def_ds ++ inst_ds ++ rule_ds ++ for_ds ++ ann_ds ++ deriv_ds) }) ; @@ -332,8 +333,6 @@ where no_splice (L loc _) = notHandledL (locA loc) ThSplicesWithinDeclBrackets- no_default_decl (L loc decl)- = notHandledL (locA loc) (ThDefaultDeclarations decl) no_warn :: LWarnDecl GhcRn -> MetaM a no_warn (L loc (Warning _ thing _)) = notHandledL (locA loc) (ThWarningAndDeprecationPragmas thing)@@ -797,6 +796,12 @@ ; dec <- rep2 rep_fn [prec', name'] ; return (loc,dec) } ; mapM do_one names }++repDefD :: LDefaultDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))+repDefD (L loc (DefaultDecl _ tys)) = do { tys1 <- repLTys tys+ ; MkC tys2 <- coreListM typeTyConName tys1+ ; dec <- rep2 defaultDName [tys2]+ ; return (locA loc, dec)} repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec)) repRuleD (L loc (HsRule { rd_name = n
compiler/GHC/HsToCore/Utils.hs view
@@ -30,7 +30,7 @@ wrapBind, wrapBinds, mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs,- mkFailExpr,+ mkFailExpr, dsWhenNoErrs, seqVar, @@ -981,6 +981,69 @@ mk_fail_msg dflags ctx pat = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx <+> text "at" <+> ppr (getLocA pat)++{- Note [Desugaring representation-polymorphic applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To desugar a function application++> HsApp _ f e :: HsExpr GhcTc++into Core, we need to know whether the argument e is lifted or unlifted,+in order to respect the let/app invariant.+ (See Note [Core let/app invariant] in GHC.Core)++This causes a problem when e is representation-polymorphic, as we aren't able+to determine whether to build a Core application++> f_desugared e_desugared++or a strict binding:++> case e_desugared of { x -> f_desugared x }++See GHC.Core.Make.mkValApp, which will call isUnliftedType, which panics+on a representation-polymorphic type.++These representation-polymorphic applications are disallowed in source Haskell,+but we might want to continue desugaring as much as possible instead of+aborting as soon as we see such a problematic function application.++When desugaring an expression which might have problems (such as disallowed+representation polymorphism as above), we check for errors first, and then:++ - if no problems were detected, desugar normally,+ - if errors were found, we want to avoid desugaring, so we instead return+ a runtime error Core expression which has the right type.++This is what the function dsWhenNoErrs achieves:++> dsWhenNoErrs result_ty thing_inside mk_expr++We run thing_inside to check for errors. If there are no errors, we apply+mk_expr to desugar; otherwise, we construct a runtime error at type result_ty.++Note that result_ty is only used when there is an error, and isn't inspected+otherwise; this means it's OK to pass something that can be a bit expensive+to compute.++See #12709 for an example of why this machinery is necessary.+See also #14765 and #18149 for why it is important to return an expression+that has the proper type in case of an error.+-}++-- | Runs the thing_inside. If there are no errors, use the provided+-- function to construct a Core expression, and return it.+-- Otherwise, return a runtime error, of the given type.+-- This is useful for doing a bunch of representation polymorphism checks+-- and then avoiding making a Core App.+-- See Note [Desugaring representation-polymorphic applications]+dsWhenNoErrs :: Type -> DsM a -> (a -> CoreExpr) -> DsM CoreExpr+dsWhenNoErrs result_ty thing_inside mk_expr+ = do { (result, no_errs) <- askNoErrsDs thing_inside+ ; if no_errs+ then return $ mk_expr result+ else mkErrorAppDs rUNTIME_ERROR_ID result_ty+ (text "dsWhenNoErrs found errors") } {- ********************************************************************* * *
compiler/GHC/Iface/Load.hs view
@@ -43,6 +43,7 @@ ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst , tcIfaceAnnotations, tcIfaceCompleteMatches ) +import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Driver.Session@@ -318,9 +319,10 @@ = do hsc_env <- getTopEnv let fc = hsc_FC hsc_env let dflags = hsc_dflags hsc_env+ let fopts = initFinderOpts dflags let units = hsc_units hsc_env let home_unit = hsc_home_unit hsc_env- res <- liftIO $ findImportedModule fc units home_unit dflags mod maybe_pkg+ res <- liftIO $ findImportedModule fc fopts units home_unit mod maybe_pkg case res of Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) -- TODO: Make sure this error message is good@@ -879,8 +881,9 @@ Just h -> h return (Succeeded (iface, "<built in interface for GHC.Prim>")) else do+ let fopts = initFinderOpts dflags -- Look for the file- mb_found <- liftIO (findExactModule fc dflags unit_state home_unit mod)+ mb_found <- liftIO (findExactModule fc fopts unit_state home_unit mod) case mb_found of InstalledFound loc mod -> do -- Found file, so read it
compiler/GHC/Iface/Recomp.hs view
@@ -13,6 +13,7 @@ import GHC.Prelude import GHC.Driver.Backend+import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Ppr@@ -452,11 +453,11 @@ checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired checkDependencies hsc_env summary iface = do- res <- liftIO $ fmap sequence $ traverse (\(mb_pkg, L _ mod) ->+ res <- liftIO $ traverse (\(mb_pkg, L _ mod) -> let reason = moduleNameString mod ++ " changed"- in classify reason <$> findImportedModule fc units home_unit dflags mod (mb_pkg))+ in classify reason <$> findImportedModule fc fopts units home_unit mod (mb_pkg)) (ms_imps summary ++ ms_srcimps summary)- case res of+ case sequence (res ++ [Right (fake_ghc_prim_import)| ms_ghc_prim_import summary]) of Left recomp -> return recomp Right es -> do let (hs, ps) = partitionEithers es@@ -467,6 +468,7 @@ return (res1 `mappend` res2) where dflags = hsc_dflags hsc_env+ fopts = initFinderOpts dflags logger = hsc_logger hsc_env fc = hsc_FC hsc_env home_unit = hsc_home_unit hsc_env@@ -475,8 +477,14 @@ prev_dep_pkgs = sort (dep_direct_pkgs (mi_deps iface)) bkpk_units = map (("Signature",) . indefUnit . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface))) - implicit_deps = map ("Implicit",) (implicitPackageDeps dflags)++ -- GHC.Prim is very special and doesn't appear in ms_textual_imps but+ -- ghc-prim will appear in the package dependencies still. In order to not confuse+ -- the recompilation logic we need to not forget we imported GHC.Prim.+ fake_ghc_prim_import = if homeUnitId home_unit == primUnitId+ then Left (mkModuleName "GHC.Prim")+ else Right ("GHC.Prim", primUnitId) classify _ (Found _ mod)
compiler/GHC/Iface/Tidy.hs view
@@ -437,7 +437,7 @@ ; local_ccs- | WayProf `S.member` ways dflags+ | ways dflags `hasWay` WayProf = collectCostCentres mod all_tidy_binds tidy_rules | otherwise = S.empty
compiler/GHC/Linker/Dynamic.hs view
@@ -23,7 +23,6 @@ import GHC.Utils.Logger import GHC.Utils.TmpFs -import qualified Data.Set as Set import System.FilePath linkDynLib :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()@@ -55,7 +54,7 @@ | osElfTarget os || osMachOTarget os , dynLibLoader dflags == SystemDependent , -- Only if we want dynamic libraries- WayDyn `Set.member` ways dflags+ ways dflags `hasWay` WayDyn -- Only use RPath if we explicitly asked for it , useXLinkerRPath dflags os = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
compiler/GHC/Linker/ExtraObj.hs view
@@ -49,8 +49,8 @@ mkExtraObj :: Logger -> TmpFs -> DynFlags -> UnitState -> Suffix -> String -> IO FilePath mkExtraObj logger tmpfs dflags unit_state extn xs- = do cFile <- newTempName logger tmpfs dflags TFL_CurrentModule extn- oFile <- newTempName logger tmpfs dflags TFL_GhcSession "o"+ = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn+ oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags
compiler/GHC/Linker/Loader.hs view
@@ -46,6 +46,7 @@ import GHC.Driver.Ppr import GHC.Driver.Config import GHC.Driver.Config.Diagnostic+import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad @@ -638,8 +639,8 @@ text " with" <+> compWay <+> text "using -osuf to set a different object file suffix." where compWay- | WayDyn `elem` ways dflags = text "-dynamic"- | WayProf `elem` ways dflags = text "-prof"+ | ways dflags `hasWay` WayDyn = text "-dynamic"+ | ways dflags `hasWay` WayProf = text "-prof" | otherwise = text "normal" ghciWay | hostIsDynamic = text "with -dynamic"@@ -754,7 +755,8 @@ let fc = hsc_FC hsc_env let home_unit = hsc_home_unit hsc_env let dflags = hsc_dflags hsc_env- mb_stuff <- findHomeModule fc home_unit dflags mod_name+ let fopts = initFinderOpts dflags+ mb_stuff <- findHomeModule fc fopts home_unit mod_name case mb_stuff of Found loc mod -> found loc mod _ -> no_obj mod_name@@ -797,13 +799,13 @@ ********************************************************************* -} -loadDecls :: Interp -> HscEnv -> (SrcSpan, Maybe ModuleNameWithIsBoot) -> CompiledByteCode -> IO ()+loadDecls :: Interp -> HscEnv -> (SrcSpan, Maybe ModuleNameWithIsBoot) -> CompiledByteCode -> IO [(Name, ForeignHValue)] loadDecls interp hsc_env span cbc@CompiledByteCode{..} = do -- Initialise the linker (if it's not been done already) initLoaderState interp hsc_env -- Take lock for the actual work.- modifyLoaderState_ interp $ \pls0 -> do+ modifyLoaderState interp $ \pls0 -> do -- Link the packages and modules required (pls, ok) <- loadDependencies interp hsc_env pls0 span needed_mods if failed ok@@ -819,7 +821,7 @@ nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let pls2 = pls { closure_env = extendClosureEnv ce nms_fhvs , itbl_env = ie }- return pls2+ return (pls2, nms_fhvs) where free_names = uniqDSetToList $ foldr (unionUniqDSets . bcoFreeNames) emptyUniqDSet bc_bcos@@ -952,7 +954,7 @@ let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ] (soFile, libPath , libName) <-- newTempLibName logger tmpfs dflags TFL_CurrentModule (platformSOExt platform)+ newTempLibName logger tmpfs (tmpDir dflags) TFL_CurrentModule (platformSOExt platform) let dflags2 = dflags { -- We don't want the original ldInputs in
compiler/GHC/Linker/Static.hs view
@@ -89,7 +89,7 @@ get_pkg_lib_path_opts l | osElfTarget (platformOS platform) && dynLibLoader dflags == SystemDependent &&- WayDyn `elem` ways dflags+ ways dflags `hasWay` WayDyn = let libpath = if gopt Opt_RelativeDynlibPaths dflags then "$ORIGIN" </> (l `makeRelativeTo` full_output_fn)@@ -110,7 +110,7 @@ in ["-L" ++ l] ++ rpathlink ++ rpath | osMachOTarget (platformOS platform) && dynLibLoader dflags == SystemDependent &&- WayDyn `elem` ways dflags &&+ ways dflags `hasWay` WayDyn && useXLinkerRPath dflags (platformOS platform) = let libpath = if gopt Opt_RelativeDynlibPaths dflags then "@loader_path" </>@@ -123,7 +123,7 @@ if gopt Opt_SingleLibFolder dflags then do libs <- getLibs dflags unit_env dep_units- tmpDir <- newTempDir logger tmpfs dflags+ tmpDir <- newTempDir logger tmpfs (tmpDir dflags) sequence_ [ copyFile lib (tmpDir </> basename) | (lib, basename) <- libs] return [ "-L" ++ tmpDir ]
compiler/GHC/Linker/Unit.hs view
@@ -50,7 +50,7 @@ -- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way. libraryDirsForWay :: Ways -> UnitInfo -> [String] libraryDirsForWay ws- | WayDyn `elem` ws = map ST.unpack . unitLibraryDynDirs+ | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs | otherwise = map ST.unpack . unitLibraryDirs getLibs :: DynFlags -> UnitEnv -> [UnitId] -> IO [(String,String)]
compiler/GHC/Linker/Windows.hs view
@@ -45,9 +45,9 @@ if not (gopt Opt_EmbedManifest dflags) then return [] else do- rc_filename <- newTempName logger tmpfs dflags TFL_CurrentModule "rc"+ rc_filename <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rc" rc_obj_filename <-- newTempName logger tmpfs dflags TFL_GhcSession (objectSuf dflags)+ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags) writeFile rc_filename $ "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
compiler/GHC/Rename/Bind.hs view
@@ -455,10 +455,7 @@ ; return (PatSynBind x psb{ psb_ext = noAnn, psb_id = name }) } where localPatternSynonymErr :: TcRnMessage- localPatternSynonymErr- = TcRnUnknownMessage $ mkPlainError noHints $- hang (text "Illegal pattern synonym declaration for" <+> quotes (ppr rdrname))- 2 (text "Pattern synonym declarations are only valid at top level")+ localPatternSynonymErr = TcRnIllegalPatSynDecl rdrname rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
compiler/GHC/Rename/Expr.hs view
@@ -448,7 +448,7 @@ addErr $ TcRnUnknownMessage $ mkPlainError noHints $ text "RebindableSyntax is required if OverloadedRecordUpdate is enabled." ; let punnedFields = [fld | (L _ fld) <- flds, hfbPun fld]- ; punsEnabled <-xoptM LangExt.RecordPuns+ ; punsEnabled <-xoptM LangExt.NamedFieldPuns ; unless (null punnedFields || punsEnabled) $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $ text "For this to work enable NamedFieldPuns."
compiler/GHC/Rename/Module.hs view
@@ -270,7 +270,7 @@ rnSrcWarnDecls bndr_set decls' = do { -- check for duplicates ; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = dups- in addErrAt (locA loc) (dupWarnDecl lrdr' rdr))+ in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr)) warn_rdr_dups ; pairs_s <- mapM (addLocMA rn_deprec) decls ; return (WarnSome ((concat pairs_s))) }@@ -296,13 +296,6 @@ -- look for duplicates among the OccNames; -- we check that the names are defined above -- invt: the lists returned by findDupsEq always have at least two elements--dupWarnDecl :: LocatedN RdrName -> RdrName -> TcRnMessage--- Located RdrName -> DeprecDecl RdrName -> SDoc-dupWarnDecl d rdr_name- = TcRnUnknownMessage $ mkPlainError noHints $- vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name),- text "also at " <+> ppr (getLocA d)] {- *********************************************************
compiler/GHC/Rename/Names.hs view
@@ -571,9 +571,9 @@ Just (False, _) -> True _ -> False bad_import =- mod `elemModuleSet` qualifiedMods- && not is_qual+ not is_qual && not has_import_list+ && mod `elemModuleSet` qualifiedMods warning = vcat [ text "To ensure compatibility with future core libraries changes"@@ -860,9 +860,12 @@ ; traceRn "getLocalNonValBinders 2" (ppr avails) ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env + -- Force the field access so that tcg_env is not retained. The+ -- selector thunk optimisation doesn't kick-in, see #20139+ ; let !old_field_env = tcg_field_env tcg_env -- Extend tcg_field_env with new fields (this used to be the -- work of extendRecordFieldEnv)- ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds+ field_env = extendNameEnvList old_field_env flds envs = (tcg_env { tcg_field_env = field_env }, tcl_env) ; traceRn "getLocalNonValBinders 3" (vcat [ppr flds, ppr field_env])
compiler/GHC/Rename/Pat.hs view
@@ -36,9 +36,6 @@ -- Literals rnLit, rnOverLit,-- -- Pattern Error message that is also used elsewhere- patSigErr ) where -- ENH: thin imports to only what is necessary for patterns@@ -558,7 +555,7 @@ rnPatAndThen mk p@(ViewPat _ expr pat) = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns- ; checkErr vp_flag (badViewPat p) }+ ; checkErr vp_flag (TcRnIllegalViewPattern p) } -- Because of the way we're arranging the recursive calls, -- this will be in the right context ; expr' <- liftCpsFV $ rnLExpr expr@@ -757,7 +754,7 @@ -- This is used for record construction and pattern-matching, but not updates. rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })- = do { pun_ok <- xoptM LangExt.RecordPuns+ = do { pun_ok <- xoptM LangExt.NamedFieldPuns ; disambig_ok <- xoptM LangExt.DisambiguateRecordFields ; let parent = guard disambig_ok >> mb_con ; flds1 <- mapM (rn_fld pun_ok parent) flds@@ -782,7 +779,7 @@ , hfbPun = pun })) = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent lbl ; arg' <- if pun- then do { checkErr pun_ok (badPun (L loc lbl))+ then do { checkErr pun_ok (TcRnIllegalFieldPunning (L loc lbl)) -- Discard any module qualifier (#11662) ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl) ; return (L (noAnnSrcSpan loc) (mk_arg loc arg_rdr)) }@@ -809,7 +806,7 @@ ; checkErr dd_flag (needFlagDotDot ctxt) ; (rdr_env, lcl_env) <- getRdrEnvs ; con_fields <- lookupConstructorFields con- ; when (null con_fields) (addErr (badDotDotCon con))+ ; when (null con_fields) (addErr (TcRnIllegalWildcardsInConstructor con)) ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds) -- For constructor uses (but not patterns)@@ -866,14 +863,14 @@ :: [LHsRecUpdField GhcPs] -> RnM ([LHsRecUpdField GhcRn], FreeVars) rnHsRecUpdFields flds- = do { pun_ok <- xoptM LangExt.RecordPuns+ = do { pun_ok <- xoptM LangExt.NamedFieldPuns ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok dup_fields_ok) flds ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds -- Check for an empty record update e {} -- NB: don't complain about e { .. }, because rn_dotdot has done that already- ; when (null flds) $ addErr emptyUpdateErr+ ; when (null flds) $ addErr TcRnEmptyRecordUpdate ; return (flds1, plusFVs fvss) } where@@ -888,7 +885,7 @@ -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head lookupRecFieldOcc_update dup_fields_ok lbl ; arg' <- if pun- then do { checkErr pun_ok (badPun (L loc lbl))+ then do { checkErr pun_ok (TcRnIllegalFieldPunning (L loc lbl)) -- Discard any module qualifier (#11662) ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl) ; return (L (noAnnSrcSpan loc) (HsVar noExtField@@ -925,35 +922,15 @@ getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) flds needFlagDotDot :: HsRecFieldContext -> TcRnMessage-needFlagDotDot ctxt = TcRnUnknownMessage $ mkPlainError noHints $- vcat [text "Illegal `..' in record" <+> pprRFC ctxt,- text "Use RecordWildCards to permit this"]--badDotDotCon :: Name -> TcRnMessage-badDotDotCon con- = TcRnUnknownMessage $ mkPlainError noHints $- vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con)- , nest 2 (text "The constructor has no labelled fields") ]--emptyUpdateErr :: TcRnMessage-emptyUpdateErr = TcRnUnknownMessage $ mkPlainError noHints $ text "Empty record update"--badPun :: Located RdrName -> TcRnMessage-badPun fld = TcRnUnknownMessage $ mkPlainError noHints $- vcat [text "Illegal use of punning for field" <+> quotes (ppr fld),- text "Use NamedFieldPuns to permit this"]+needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage-dupFieldErr ctxt dups- = TcRnUnknownMessage $ mkPlainError noHints $- hsep [text "duplicate field name",- quotes (ppr (NE.head dups)),- text "in record", pprRFC ctxt]+dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt) -pprRFC :: HsRecFieldContext -> SDoc-pprRFC (HsRecFieldCon {}) = text "construction"-pprRFC (HsRecFieldPat {}) = text "pattern"-pprRFC (HsRecFieldUpd {}) = text "update"+toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart+toRecordFieldPart (HsRecFieldCon n) = RecordFieldConstructor n+toRecordFieldPart (HsRecFieldPat n) = RecordFieldPattern n+toRecordFieldPart (HsRecFieldUpd {}) = RecordFieldUpdate {- ************************************************************************@@ -968,7 +945,7 @@ -} rnLit :: HsLit p -> RnM ()-rnLit (HsChar _ c) = checkErr (inCharRange c) (bogusCharError c)+rnLit (HsChar _ c) = checkErr (inCharRange c) (TcRnCharLiteralOutOfRange c) rnLit _ = return () -- | Turn a Fractional-looking literal which happens to be an integer into an@@ -1022,26 +999,3 @@ ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name) , fvs1 `plusFV` fvs2) } else return ((lit', Nothing), fvs1) }--{--************************************************************************-* *-\subsubsection{Errors}-* *-************************************************************************--}--patSigErr :: Outputable a => a -> SDoc-patSigErr ty- = (text "Illegal signature in pattern:" <+> ppr ty)- $$ nest 4 (text "Use ScopedTypeVariables to permit it")--bogusCharError :: Char -> TcRnMessage-bogusCharError c- = TcRnUnknownMessage $ mkPlainError noHints $- text "character literal out of range: '\\" <> char c <> char '\''--badViewPat :: Pat GhcPs -> TcRnMessage-badViewPat pat = TcRnUnknownMessage $ mkPlainError noHints $- vcat [text "Illegal view pattern: " <+> ppr pat,- text "Use ViewPatterns to enable view patterns"]
compiler/GHC/Rename/Utils.hs view
@@ -163,9 +163,9 @@ check_shadow n | startsWithUnderscore occ = return () -- Do not report shadowing for "_x" -- See #3262- | Just n <- mb_local = complain [text "bound at" <+> ppr (nameSrcLoc n)]+ | Just n <- mb_local = complain (ShadowedNameProvenanceLocal (nameSrcLoc n)) | otherwise = do { gres' <- filterM is_shadowed_gre gres- ; complain (map pprNameProvenance gres') }+ ; when (not . null $ gres') $ complain (ShadowedNameProvenanceGlobal gres') } where (loc,occ) = get_loc_occ n mb_local = lookupLocalRdrOcc local_env occ@@ -173,19 +173,14 @@ -- Make an Unqualified RdrName and look that up, so that -- we don't find any GREs that are in scope qualified-only - complain [] = return ()- complain pp_locs = do- let msg = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnNameShadowing)- noHints- (shadowedNameWarn occ pp_locs)- addDiagnosticAt loc msg+ complain provenance = addDiagnosticAt loc (TcRnShadowedName occ provenance) is_shadowed_gre :: GlobalRdrElt -> RnM Bool -- Returns False for record selectors that are shadowed, when -- punning or wild-cards are on (cf #2723) is_shadowed_gre gre | isRecFldGRE gre = do { dflags <- getDynFlags- ; return $ not (xopt LangExt.RecordPuns dflags+ ; return $ not (xopt LangExt.NamedFieldPuns dflags || xopt LangExt.RecordWildCards dflags) } is_shadowed_gre _other = return True @@ -589,13 +584,6 @@ (flds, non_flds) = NE.partition isRecFldGRE gres num_flds = length flds num_non_flds = length non_flds---shadowedNameWarn :: OccName -> [SDoc] -> SDoc-shadowedNameWarn occ shadowed_locs- = sep [text "This binding for" <+> quotes (ppr occ)- <+> text "shadows the existing binding" <> plural shadowed_locs,- nest 2 (vcat shadowed_locs)] unknownSubordinateErr :: SDoc -> RdrName -> SDoc
compiler/GHC/Runtime/Loader.hs view
@@ -51,6 +51,7 @@ , greMangledName, mkRdrQual ) import GHC.Unit.Finder ( findPluginModule, FindResult(..) )+import GHC.Driver.Config.Finder ( initFinderOpts ) import GHC.Unit.Module ( Module, ModuleName ) import GHC.Unit.Module.ModIface @@ -258,11 +259,12 @@ -> IO (Maybe (Name, ModIface)) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do let dflags = hsc_dflags hsc_env+ let fopts = initFinderOpts dflags let fc = hsc_FC hsc_env let units = hsc_units hsc_env let home_unit = hsc_home_unit hsc_env -- First find the unit the module resides in by searching exposed units and home modules- found_module <- findPluginModule fc units home_unit dflags mod_name+ found_module <- findPluginModule fc fopts units home_unit mod_name case found_module of Found _ mod -> do -- Find the exports of the module
compiler/GHC/StgToByteCode.hs view
@@ -11,7 +11,7 @@ -- -- | GHC.StgToByteCode: Generate bytecode from STG-module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen, stgExprToBCOs ) where+module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen) where import GHC.Prelude @@ -176,48 +176,6 @@ BcM and used when generating code for variable references. -} --- -------------------------------------------------------------------------------- Generating byte code for an expression---- Returns: the root BCO for this expression-stgExprToBCOs :: HscEnv- -> Module- -> Type- -> StgRhs- -> IO UnlinkedBCO-stgExprToBCOs hsc_env this_mod expr_ty expr- = withTiming logger- (text "GHC.StgToByteCode"<+>brackets (ppr this_mod))- (const ()) $ do-- -- the uniques are needed to generate fresh variables when we introduce new- -- let bindings for ticked expressions- us <- mkSplitUniqSupply 'y'- (BcM_State _dflags _us _this_mod _final_ctr mallocd _ _ _, proto_bco)- <- runBc hsc_env us this_mod Nothing emptyVarEnv $ do- prepd_expr <- annBindingFreeVars <$>- bcPrepBind (StgNonRec dummy_id expr)- case prepd_expr of- (StgNonRec _ cg_expr) -> schemeR [] (idName dummy_id, cg_expr)- _ ->- panic "GHC.StgByteCode.stgExprToBCOs"-- when (notNull mallocd)- (panic "GHC.StgToByteCode.stgExprToBCOs: missing final emitBc?")-- putDumpFileMaybe logger Opt_D_dump_BCOs "Proto-BCOs" FormatByteCode- (ppr proto_bco)-- assembleOneBCO interp profile proto_bco- where dflags = hsc_dflags hsc_env- logger = hsc_logger hsc_env- profile = targetProfile dflags- interp = hscInterp hsc_env- -- we need an otherwise unused Id for bytecode generation- dummy_id = mkSysLocal (fsLit "BCO_toplevel")- (mkPseudoUniqueE 0)- Many- expr_ty {- Prepare the STG for bytecode generation: @@ -439,7 +397,10 @@ -- by just re-using the single top-level definition. So -- for the worker itself, we must allocate it directly. -- ioToBc (putStrLn $ "top level BCO")- emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, ENTER])+ let enter = if isUnliftedTypeKind (tyConResKind (dataConTyCon data_con))+ then RETURN_UNLIFTED P+ else ENTER+ emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, enter]) (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) | otherwise@@ -575,36 +536,36 @@ -- Returning an unlifted value. -- Heave it on the stack, SLIDE, and RETURN.-returnUnboxedAtom+returnUnliftedAtom :: StackDepth -> Sequel -> BCEnv -> StgArg -> BcM BCInstrList-returnUnboxedAtom d s p e = do+returnUnliftedAtom d s p e = do let reps = case e of StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e- ret <- returnUnboxedReps d s szb reps+ ret <- returnUnliftedReps d s szb reps return (push `appOL` ret) --- return an unboxed value from the top of the stack-returnUnboxedReps+-- return an unlifted value from the top of the stack+returnUnliftedReps :: StackDepth -> Sequel -> ByteOff -- size of the thing we're returning -> [PrimRep] -- representations -> BcM BCInstrList-returnUnboxedReps d s szb reps = do+returnUnliftedReps d s szb reps = do profile <- getProfile let platform = profilePlatform profile non_void VoidRep = False non_void _ = True ret <- case filter non_void reps of -- use RETURN_UBX for unary representations- [] -> return (unitOL $ RETURN_UBX V)- [rep] -> return (unitOL $ RETURN_UBX (toArgRep platform rep))+ [] -> return (unitOL $ RETURN_UNLIFTED V)+ [rep] -> return (unitOL $ RETURN_UNLIFTED (toArgRep platform rep)) -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (tuple_info, args_offsets) = layoutTuple profile 0 (primRepCmmType platform) nv_reps@@ -633,19 +594,19 @@ massert (off == dd + szb) go (dd + szb) (push:pushes) cs pushes <- go d [] tuple_components- ret <- returnUnboxedReps d- s- (wordsToBytes platform $ tupleSize tuple_info)- (map atomPrimRep es)+ ret <- returnUnliftedReps d+ s+ (wordsToBytes platform $ tupleSize tuple_info)+ (map atomPrimRep es) return (mconcat pushes `appOL` ret) -- Compile code to apply the given expression to the remaining args -- on the stack, returning a HNF. schemeE :: StackDepth -> Sequel -> BCEnv -> CgStgExpr -> BcM BCInstrList-schemeE d s p (StgLit lit) = returnUnboxedAtom d s p (StgLitArg lit)+schemeE d s p (StgLit lit) = returnUnliftedAtom d s p (StgLitArg lit) schemeE d s p (StgApp x [])- | isUnliftedType (idType x) = returnUnboxedAtom d s p (StgVarArg x)+ | isUnliftedType (idType x) = returnUnliftedAtom d s p (StgVarArg x) -- Delegate tail-calls to schemeT. schemeE d s p e@(StgApp {}) = schemeT d s p e schemeE d s p e@(StgConApp {}) = schemeT d s p e@@ -884,7 +845,9 @@ platform <- profilePlatform <$> getProfile return (alloc_con `appOL` mkSlideW 1 (bytesToWords platform $ d - s) `snocOL`- ENTER)+ if isUnliftedTypeKind (tyConResKind (dataConTyCon con))+ then RETURN_UNLIFTED P+ else ENTER) -- Case 4: Tail call of function schemeT d s p (StgApp fn args)@@ -952,7 +915,10 @@ platform <- profilePlatform <$> getProfile assert (sz == wordSize platform ) return () let slide = mkSlideB platform (d - init_d + wordSize platform) (init_d - s)- return (push_fn `appOL` (slide `appOL` unitOL ENTER))+ enter = if isUnliftedType (idType fn)+ then RETURN_UNLIFTED P+ else ENTER+ return (push_fn `appOL` (slide `appOL` unitOL enter)) do_pushes !d args reps = do let (push_apply, n, rest_of_reps) = findPushSeq reps (these_args, rest_of_args) = splitAt n args@@ -1049,9 +1015,9 @@ -- An unlifted value gets an extra info table pushed on top -- when it is returned. unlifted_itbl_size_b :: StackDepth- unlifted_itbl_size_b | isAlgCase = 0- | ubx_tuple_frame = 3 * wordSize platform- | otherwise = wordSize platform+ unlifted_itbl_size_b | ubx_tuple_frame = 3 * wordSize platform+ | not (isUnliftedType bndr_ty) = 0+ | otherwise = wordSize platform (bndr_size, tuple_info, args_offsets) | ubx_tuple_frame =@@ -1072,7 +1038,7 @@ d_bndr = d + ret_frame_size_b + bndr_size - -- depth of stack after the extra info table for an unboxed return+ -- depth of stack after the extra info table for an unlifted return -- has been pushed, if any. This is the stack depth at the -- continuation. d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b@@ -1082,7 +1048,7 @@ p_alts = Map.insert bndr d_bndr p bndr_ty = idType bndr- isAlgCase = not (isUnliftedType bndr_ty)+ isAlgCase = isAlgType bndr_ty -- given an alt, return a discr and code for it. codeAlt (DEFAULT, _, rhs)@@ -1131,11 +1097,17 @@ [ (arg, stack_bot - ByteOff offset) | (NonVoid arg, offset) <- args_offsets ] p_alts++ -- unlifted datatypes have an infotable word on top+ unpack = if isUnliftedType bndr_ty+ then PUSH_L 1 `consOL`+ UNPACK (trunc16W size) `consOL`+ unitOL (SLIDE (trunc16W size) 1)+ else unitOL (UNPACK (trunc16W size)) in do massert isAlgCase rhs_code <- schemeE stack_bot s p' rhs- return (my_discr alt,- unitOL (UNPACK (trunc16W size)) `appOL` rhs_code)+ return (my_discr alt, unpack `appOL` rhs_code) where real_bndrs = filterOut isTyVar bndrs @@ -1224,7 +1196,7 @@ return (PUSH_ALTS_TUPLE alt_bco' tuple_info tuple_bco `consOL` scrut_code) else let push_alts- | isAlgCase+ | not (isUnliftedType bndr_ty) = PUSH_ALTS alt_bco' | otherwise = let unlifted_rep =@@ -1619,7 +1591,7 @@ -- slide and return d_after_r_min_s = bytesToWords platform (d_after_r - s) wrapup = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW)- `snocOL` RETURN_UBX (toArgRep platform r_rep)+ `snocOL` RETURN_UNLIFTED (toArgRep platform r_rep) --trace (show (arg1_offW, args_offW , (map argRepSizeW a_reps) )) $ return ( push_args `appOL`
compiler/GHC/StgToCmm.hs view
@@ -206,7 +206,7 @@ (lit,decl) = if not isNCG || asString then mkByteStringCLit label str else mkFileEmbedLit label $ unsafePerformIO $ do- bFile <- newTempName logger tmpfs dflags TFL_CurrentModule ".dat"+ bFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule ".dat" BS.writeFile bFile str return bFile emitDecl decl
compiler/GHC/StgToCmm/Closure.hs view
@@ -318,6 +318,10 @@ -- x86-32 and 3 bits on x86-64. -- -- Also see Note [Tagging big families] in GHC.StgToCmm.Expr+--+-- The interpreter also needs to be updated if we change the+-- tagging strategy. See Note [Data constructor dynamic tags] in+-- rts/Interpreter.c isSmallFamily :: Platform -> Int -> Bool isSmallFamily platform fam_size = fam_size <= mAX_PTR_TAG platform
compiler/GHC/StgToCmm/Prim.hs view
@@ -1,4 +1,4 @@-+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}@@ -16,6 +16,8 @@ shouldInlinePrimOp ) where +#include "MachDeps.h"+ import GHC.Prelude hiding ((<*>)) import GHC.Platform@@ -340,6 +342,8 @@ StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform)) + EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)+ ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq platform) [arg1,arg2]) @@ -1080,6 +1084,10 @@ Word16ToInt16Op -> \args -> opNop args Int32ToWord32Op -> \args -> opNop args Word32ToInt32Op -> \args -> opNop args+#if WORD_SIZE_IN_BITS < 64+ Int64ToWord64Op -> \args -> opNop args+ Word64ToInt64Op -> \args -> opNop args+#endif IntToWordOp -> \args -> opNop args WordToIntOp -> \args -> opNop args IntToAddrOp -> \args -> opNop args@@ -1332,6 +1340,54 @@ Word32LtOp -> \args -> opTranslate args (MO_U_Lt W32) Word32NeOp -> \args -> opTranslate args (MO_Ne W32) +#if WORD_SIZE_IN_BITS < 64+-- Int64# signed ops++ Int64ToIntOp -> \args -> opTranslate64 args (\w -> MO_SS_Conv w (wordWidth platform)) MO_I64_ToI+ IntToInt64Op -> \args -> opTranslate64 args (\w -> MO_SS_Conv (wordWidth platform) w) MO_I64_FromI+ Int64NegOp -> \args -> opTranslate64 args MO_S_Neg MO_x64_Neg+ Int64AddOp -> \args -> opTranslate64 args MO_Add MO_x64_Add+ Int64SubOp -> \args -> opTranslate64 args MO_Sub MO_x64_Sub+ Int64MulOp -> \args -> opTranslate64 args MO_Mul MO_x64_Mul+ Int64QuotOp -> \args -> opTranslate64 args MO_S_Quot MO_I64_Quot+ Int64RemOp -> \args -> opTranslate64 args MO_S_Rem MO_I64_Rem++ Int64SllOp -> \args -> opTranslate64 args MO_Shl MO_x64_Shl+ Int64SraOp -> \args -> opTranslate64 args MO_S_Shr MO_I64_Shr+ Int64SrlOp -> \args -> opTranslate64 args MO_U_Shr MO_W64_Shr++ Int64EqOp -> \args -> opTranslate64 args MO_Eq MO_x64_Eq+ Int64GeOp -> \args -> opTranslate64 args MO_S_Ge MO_I64_Ge+ Int64GtOp -> \args -> opTranslate64 args MO_S_Gt MO_I64_Gt+ Int64LeOp -> \args -> opTranslate64 args MO_S_Le MO_I64_Le+ Int64LtOp -> \args -> opTranslate64 args MO_S_Lt MO_I64_Lt+ Int64NeOp -> \args -> opTranslate64 args MO_Ne MO_x64_Ne++-- Word64# unsigned ops++ Word64ToWordOp -> \args -> opTranslate64 args (\w -> MO_UU_Conv w (wordWidth platform)) MO_W64_ToW+ WordToWord64Op -> \args -> opTranslate64 args (\w -> MO_UU_Conv (wordWidth platform) w) MO_W64_FromW+ Word64AddOp -> \args -> opTranslate64 args MO_Add MO_x64_Add+ Word64SubOp -> \args -> opTranslate64 args MO_Sub MO_x64_Sub+ Word64MulOp -> \args -> opTranslate64 args MO_Mul MO_x64_Mul+ Word64QuotOp -> \args -> opTranslate64 args MO_U_Quot MO_W64_Quot+ Word64RemOp -> \args -> opTranslate64 args MO_U_Rem MO_W64_Rem++ Word64AndOp -> \args -> opTranslate64 args MO_And MO_x64_And+ Word64OrOp -> \args -> opTranslate64 args MO_Or MO_x64_Or+ Word64XorOp -> \args -> opTranslate64 args MO_Xor MO_x64_Xor+ Word64NotOp -> \args -> opTranslate64 args MO_Not MO_x64_Not+ Word64SllOp -> \args -> opTranslate64 args MO_Shl MO_x64_Shl+ Word64SrlOp -> \args -> opTranslate64 args MO_U_Shr MO_W64_Shr++ Word64EqOp -> \args -> opTranslate64 args MO_Eq MO_x64_Eq+ Word64GeOp -> \args -> opTranslate64 args MO_U_Ge MO_W64_Ge+ Word64GtOp -> \args -> opTranslate64 args MO_U_Gt MO_W64_Gt+ Word64LeOp -> \args -> opTranslate64 args MO_U_Le MO_W64_Le+ Word64LtOp -> \args -> opTranslate64 args MO_U_Lt MO_W64_Lt+ Word64NeOp -> \args -> opTranslate64 args MO_Ne MO_x64_Ne+#endif+ -- Char# ops CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth platform))@@ -1408,20 +1464,6 @@ FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) --- Word comparisons masquerading as more exotic things.-- SameMutVarOp -> \args -> opTranslate args (mo_wordEq platform)- SameMVarOp -> \args -> opTranslate args (mo_wordEq platform)- SameIOPortOp -> \args -> opTranslate args (mo_wordEq platform)- SameMutableArrayOp -> \args -> opTranslate args (mo_wordEq platform)- SameMutableByteArrayOp -> \args -> opTranslate args (mo_wordEq platform)- SameMutableArrayArrayOp -> \args -> opTranslate args (mo_wordEq platform)- SameSmallMutableArrayOp -> \args -> opTranslate args (mo_wordEq platform)- SameTVarOp -> \args -> opTranslate args (mo_wordEq platform)- EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)--- See Note [Comparing stable names]- EqStableNameOp -> \args -> opTranslate args (mo_wordEq platform)- IntQuotRemOp -> \args -> opCallishHandledLater args $ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args) then Left (MO_S_QuotRem (wordWidth platform))@@ -1649,6 +1691,18 @@ let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) emit stmt +#if WORD_SIZE_IN_BITS < 64+ opTranslate64+ :: [CmmExpr]+ -> (Width -> MachOp)+ -> CallishMachOp+ -> PrimopCmmEmit+ opTranslate64 args mkMop callish =+ case platformWordSize platform of+ PW4 -> opCallish args callish+ PW8 -> opTranslate args $ mkMop W64+#endif+ -- | Basically a "manual" case, rather than one of the common repetitive forms -- above. The results are a parameter to the returned function so we know the -- choice of variant never depends on them.@@ -2025,17 +2079,6 @@ emit =<< mkCmmIfThenElse (eq aa zero) g1 g4 genericFabsOp _ _ _ = panic "genericFabsOp"---- Note [Comparing stable names]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ A StableName# is actually a pointer to a stable name object (SNO)--- containing an index into the stable name table (SNT). We--- used to compare StableName#s by following the pointers to the--- SNOs and checking whether they held the same SNT indices. However,--- this is not necessary: there is a one-to-one correspondence--- between SNOs and entries in the SNT, so simple pointer equality--- does the trick. ------------------------------------------------------------------------------ -- Helpers for translating various minor variants of array indexing.
compiler/GHC/SysTools/Process.hs view
@@ -168,7 +168,7 @@ return (r,()) where getResponseFile args = do- fp <- newTempName logger tmpfs dflags TFL_CurrentModule "rsp"+ fp <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rsp" withFile fp WriteMode $ \h -> do #if defined(mingw32_HOST_OS) hSetEncoding h latin1
compiler/GHC/Tc/Deriv/Generate.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -39,6 +40,8 @@ getPossibleDataCons, tyConInstArgTys ) where +#include "MachDeps.h"+ import GHC.Prelude import GHC.Tc.Utils.Monad@@ -1490,10 +1493,12 @@ eqInt8_RDR , ltInt8_RDR , geInt8_RDR , gtInt8_RDR , leInt8_RDR , eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR , eqInt32_RDR , ltInt32_RDR , geInt32_RDR , gtInt32_RDR , leInt32_RDR ,+ eqInt64_RDR , ltInt64_RDR , geInt64_RDR , gtInt64_RDR , leInt64_RDR , eqWord_RDR , ltWord_RDR , geWord_RDR , gtWord_RDR , leWord_RDR , eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR , eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR, eqWord32_RDR, ltWord32_RDR, geWord32_RDR, gtWord32_RDR, leWord32_RDR,+ eqWord64_RDR, ltWord64_RDR, geWord64_RDR, gtWord64_RDR, leWord64_RDR, eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR , eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR , eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,@@ -1547,6 +1552,12 @@ gtInt32_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt32#" ) geInt32_RDR = varQual_RDR gHC_PRIM (fsLit "geInt32#") +eqInt64_RDR = varQual_RDR gHC_PRIM (fsLit "eqInt64#")+ltInt64_RDR = varQual_RDR gHC_PRIM (fsLit "ltInt64#" )+leInt64_RDR = varQual_RDR gHC_PRIM (fsLit "leInt64#")+gtInt64_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt64#" )+geInt64_RDR = varQual_RDR gHC_PRIM (fsLit "geInt64#")+ eqWord_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord#") ltWord_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord#") leWord_RDR = varQual_RDR gHC_PRIM (fsLit "leWord#")@@ -1571,6 +1582,12 @@ gtWord32_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord32#" ) geWord32_RDR = varQual_RDR gHC_PRIM (fsLit "geWord32#") +eqWord64_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord64#")+ltWord64_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord64#" )+leWord64_RDR = varQual_RDR gHC_PRIM (fsLit "leWord64#")+gtWord64_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord64#" )+geWord64_RDR = varQual_RDR gHC_PRIM (fsLit "geWord64#")+ eqAddr_RDR = varQual_RDR gHC_PRIM (fsLit "eqAddr#") ltAddr_RDR = varQual_RDR gHC_PRIM (fsLit "ltAddr#") leAddr_RDR = varQual_RDR gHC_PRIM (fsLit "leAddr#")@@ -1598,7 +1615,6 @@ word32ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word32ToWord#") int32ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int32ToInt#") - {- ************************************************************************ * *@@ -2345,6 +2361,8 @@ , eqInt16_RDR , geInt16_RDR , gtInt16_RDR )) ,(int32PrimTy , (ltInt32_RDR , leInt32_RDR , eqInt32_RDR , geInt32_RDR , gtInt32_RDR ))+ ,(int64PrimTy , (ltInt64_RDR , leInt64_RDR+ , eqInt64_RDR , geInt64_RDR , gtInt64_RDR )) ,(wordPrimTy , (ltWord_RDR , leWord_RDR , eqWord_RDR , geWord_RDR , gtWord_RDR )) ,(word8PrimTy , (ltWord8_RDR , leWord8_RDR@@ -2353,6 +2371,8 @@ , eqWord16_RDR, geWord16_RDR, gtWord16_RDR )) ,(word32PrimTy, (ltWord32_RDR, leWord32_RDR , eqWord32_RDR, geWord32_RDR, gtWord32_RDR ))+ ,(word64PrimTy, (ltWord64_RDR, leWord64_RDR+ , eqWord64_RDR, geWord64_RDR, gtWord64_RDR )) ,(addrPrimTy , (ltAddr_RDR , leAddr_RDR , eqAddr_RDR , geAddr_RDR , gtAddr_RDR )) ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR
compiler/GHC/Tc/Errors.hs view
@@ -74,6 +74,7 @@ import GHC.Data.Bag import GHC.Data.FastString+import GHC.Utils.Trace (pprTraceUserWarning) import GHC.Data.List.SetOps ( equivClasses ) import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict@@ -2521,8 +2522,8 @@ = vcat [ ppWhen lead_with_ambig $ text "Probable fix: use a type annotation to specify what" <+> pprQuotedList ambig_tvs <+> text "should be."- , text "These potential instance" <> plural unifiers- <+> text "exist:"]+ , thisOrThese unifiers <+> text "potential instance" <> plural unifiers+ <+> text "exist" <> singular unifiers <> text ":"] mb_patsyn_prov :: Maybe SDoc mb_patsyn_prov@@ -2944,8 +2945,11 @@ = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs)) where pp_one (UnkSkol, tvs)- = hang (pprQuotedList tvs)- 2 (is_or_are tvs "an" "unknown")+ = vcat [ hang (pprQuotedList tvs)+ 2 (is_or_are tvs "a" "(rigid, skolem)")+ , nest 2 (text "of unknown origin")+ , nest 2 (text "bound at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs)))+ ] pp_one (RuntimeUnkSkol, tvs) = hang (pprQuotedList tvs) 2 (is_or_are tvs "an" "unknown runtime")@@ -2979,7 +2983,13 @@ getSkolemInfo [] tvs | all isRuntimeUnkSkol tvs = [(RuntimeUnkSkol, tvs)] -- #14628- | otherwise = pprPanic "No skolem info:" (ppr tvs)+ | otherwise = -- See https://gitlab.haskell.org/ghc/ghc/-/issues?label_name[]=No%20skolem%20info+ pprTraceUserWarning msg [(UnkSkol,tvs)]+ where+ msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr tvs+ $$ text "This should not happen, please report it as a bug following the instructions at:"+ $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug"+ getSkolemInfo (implic:implics) tvs | null tvs_here = getSkolemInfo implics tvs
compiler/GHC/Tc/Gen/Arrow.hs view
@@ -185,10 +185,10 @@ ; let r_ty = mkTyVarTy r_tv ; checkTc (not (r_tv `elemVarSet` tyCoVarsOfType pred_ty)) (TcRnUnknownMessage $ mkPlainError noHints $ text "Predicate type of `ifThenElse' depends on result type")- ; (pred', fun')- <- tcSyntaxOp IfOrigin fun (map synKnownType [pred_ty, r_ty, r_ty])- (mkCheckExpType r_ty) $ \ _ _ ->- tcCheckMonoExpr pred pred_ty+ ; (pred', fun') <- tcSyntaxOp IfThenElseOrigin fun+ (map synKnownType [pred_ty, r_ty, r_ty])+ (mkCheckExpType r_ty) $ \ _ _ ->+ tcCheckMonoExpr pred pred_ty ; b1' <- tcCmd env b1 res_ty ; b2' <- tcCmd env b2 res_ty
compiler/GHC/Tc/Gen/Splice.hs view
@@ -39,6 +39,7 @@ import GHC.Driver.Env import GHC.Driver.Hooks import GHC.Driver.Config.Diagnostic+import GHC.Driver.Config.Finder import GHC.Hs @@ -1211,7 +1212,7 @@ dflags <- getDynFlags logger <- getLogger tmpfs <- hsc_tmpfs <$> getTopEnv- liftIO $ newTempName logger tmpfs dflags TFL_GhcSession suffix+ liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix qAddTopDecls thds = do l <- getSrcSpanM@@ -1264,7 +1265,8 @@ let fc = hsc_FC hsc_env let home_unit = hsc_home_unit hsc_env let dflags = hsc_dflags hsc_env- r <- liftIO $ findHomeModule fc home_unit dflags (mkModuleName plugin)+ let fopts = initFinderOpts dflags+ r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) let err = hang (text "addCorePlugin: invalid plugin module " <+> text (show plugin)
compiler/GHC/Tc/Plugin.hs view
@@ -77,6 +77,7 @@ import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Class+import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Utils.Outputable import GHC.Core.Type@@ -102,7 +103,8 @@ let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env- tcPluginIO $ Finder.findImportedModule fc units home_unit dflags mod_name mb_pkg+ let fopts = initFinderOpts dflags+ tcPluginIO $ Finder.findImportedModule fc fopts units home_unit mod_name mb_pkg lookupOrig :: Module -> OccName -> TcPluginM Name lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod
compiler/GHC/Tc/Solver.hs view
@@ -1795,12 +1795,7 @@ -- Typically if we blow the limit we are going to report some other error -- (an unsolved constraint), and we don't want that error to suppress -- the iteration limit warning!- addErrTcS $ TcRnUnknownMessage $ mkPlainError noHints $- (hang (text "solveWanteds: too many iterations"- <+> parens (text "limit =" <+> ppr limit))- 2 (vcat [ text "Unsolved:" <+> ppr wc- , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"- ]))+ addErrTcS $ TcRnSimplifierTooManyIterations limit wc ; return wc } | unif_happened
compiler/GHC/Tc/Solver/Canonical.hs view
@@ -153,7 +153,7 @@ | isWanted ev , Just ip_name <- isCallStackPred cls tys- , OccurrenceOf func <- ctLocOrigin loc+ , isPushCallStackOrigin orig -- If we're given a CallStack constraint that arose from a function -- call, we need to push the current call-site onto the stack instead -- of solving it directly from a given.@@ -170,7 +170,8 @@ -- Then we solve the wanted by pushing the call-site -- onto the newly emitted CallStack- ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvExpr new_ev)+ ; let ev_cs = EvCsPushCall (callStackOriginFS orig)+ (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs ; canClass new_ev cls tys@@ -184,6 +185,7 @@ where has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev+ orig = ctLocOrigin loc pred = ctEvPred ev fds = classHasFds cls
compiler/GHC/Tc/TyCl/Instance.hs view
@@ -1981,7 +1981,8 @@ ; return (poly_meth_id, local_meth_id) } where sel_name = idName sel_id- sel_occ = nameOccName sel_name+ -- Force so that a thunk doesn't end up in a Name (#19619)+ !sel_occ = nameOccName sel_name local_meth_ty = instantiateMethod clas sel_id inst_tys poly_meth_ty = mkSpecSigmaTy tyvars theta local_meth_ty theta = map idType dfun_ev_vars
compiler/GHC/Tc/TyCl/PatSyn.hs view
@@ -23,7 +23,7 @@ import GHC.Hs import GHC.Tc.Gen.Pat import GHC.Core.Multiplicity-import GHC.Core.Type ( tidyTyCoVarBinders, tidyTypes, tidyType )+import GHC.Core.Type ( tidyTyCoVarBinders, tidyTypes, tidyType, isManyDataConTy ) import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad@@ -389,6 +389,10 @@ univ_tvs = binderVars univ_bndrs ex_tvs = binderVars ex_bndrs + -- Pattern synonyms currently cannot be linear (#18806)+ ; checkTc (all (isManyDataConTy . scaledMult) arg_tys) $+ TcRnLinearPatSyn sig_body_ty+ -- Skolemise the quantified type variables. This is necessary -- in order to check the actual pattern type against the -- expected type. Even though the tyvars in the type are@@ -513,8 +517,8 @@ GHC.Tc.Utils.Instantiate.tcInstSkolTyVarsX except that the latter does cloning. -[Pattern synonyms and higher rank types]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Pattern synonyms and higher rank types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT (forall a. a->a)
compiler/GHC/Tc/Types/EvTerm.hs view
@@ -21,7 +21,6 @@ import GHC.Core.Utils import GHC.Types.SrcLoc-import GHC.Types.Name import GHC.Types.TyThing -- Used with Opt_DeferTypeErrors@@ -71,5 +70,5 @@ return (pushCS nameExpr locExpr (Cast tm ip_co)) case cs of- EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm- EvCsEmpty -> return emptyCS+ EvCsPushCall fs loc tm -> mkPush fs loc tm+ EvCsEmpty -> return emptyCS
compiler/GHC/Tc/Utils/Backpack.hs view
@@ -19,6 +19,8 @@ import GHC.Prelude ++import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session@@ -322,7 +324,7 @@ implicitRequirements' hsc_env normal_imports = fmap concat $ forM normal_imports $ \(mb_pkg, L _ imp) -> do- found <- findImportedModule fc units home_unit dflags imp mb_pkg+ found <- findImportedModule fc fopts units home_unit imp mb_pkg case found of Found _ mod | not (isHomeModule home_unit mod) -> return (uniqDSetToList (moduleFreeHoles mod))@@ -332,6 +334,7 @@ home_unit = hsc_home_unit hsc_env units = hsc_units hsc_env dflags = hsc_dflags hsc_env+ fopts = initFinderOpts dflags -- | Like @implicitRequirements'@, but returns either the module name, if it is -- a free hole, or the instantiated unit the imported module is from, so that@@ -347,10 +350,11 @@ home_unit = hsc_home_unit hsc_env units = hsc_units hsc_env dflags = hsc_dflags hsc_env+ fopts = initFinderOpts dflags go acc [] = pure acc go (accL, accR) ((mb_pkg, L _ imp):imports) = do- found <- findImportedModule fc units home_unit dflags imp mb_pkg+ found <- findImportedModule fc fopts units home_unit imp mb_pkg let acc' = case found of Found _ mod | not (isHomeModule home_unit mod) -> case moduleUnit mod of
compiler/GHC/Tc/Utils/Instantiate.hs view
@@ -588,7 +588,10 @@ = do { loc <- getSrcSpanM ; uniq <- newUnique ; let old_name = tyVarName tycovar- new_name = mkInternalName uniq (getOccName old_name) loc+ -- Force so we don't retain reference to the old name and id+ -- See (#19619) for more discussion+ !old_occ_name = getOccName old_name+ new_name = mkInternalName uniq old_occ_name loc new_kind = substTyUnchecked subst (tyVarKind tycovar) new_tcv = mk_tcv new_name new_kind subst1 = extendTCvSubstWithClone subst tycovar new_tcv@@ -844,8 +847,15 @@ tcExtendLocalInstEnv dfuns thing_inside = do { traceDFuns dfuns ; env <- getGblEnv+ -- Force the access to the TcgEnv so it isn't retained.+ -- During auditing it is much easier to observe in -hi profiles if+ -- there are a very small number of TcGblEnv. Keeping a TcGblEnv+ -- alive is quite dangerous because it contains reference to many+ -- large data structures.+ ; let !init_inst_env = tcg_inst_env env+ !init_insts = tcg_insts env ; (inst_env', cls_insts') <- foldlM addLocalInst- (tcg_inst_env env, tcg_insts env)+ (init_inst_env, init_insts) dfuns ; let env' = env { tcg_insts = cls_insts' , tcg_inst_env = inst_env' }
compiler/GHC/Tc/Utils/Monad.hs view
@@ -711,29 +711,41 @@ ************************************************************************ -} --- Note [INLINE conditional tracing utilities]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~--- In general we want to optimise for the case where tracing is not enabled.--- To ensure this happens, we ensure that traceTc and friends are inlined; this--- ensures that the allocation of the document can be pushed into the tracing--- path, keeping the non-traced path free of this extraneous work. For--- instance, instead of------ let thunk = ...--- in if doTracing--- then emitTraceMsg thunk--- else return ()------ where the conditional is buried in a non-inlined utility function (e.g.--- traceTc), we would rather have:------ if doTracing--- then let thunk = ...--- in emitTraceMsg thunk--- else return ()------ See #18168.---+{- Note [INLINE conditional tracing utilities]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In general we want to optimise for the case where tracing is not enabled.+To ensure this happens, we ensure that traceTc and friends are inlined; this+ensures that the allocation of the document can be pushed into the tracing+path, keeping the non-traced path free of this extraneous work. For+instance, if we don't inline traceTc, we'll get++ let stuff_to_print = ...+ in traceTc "wombat" stuff_to_print++and the stuff_to_print thunk will be allocated in the "hot path", regardless+of tracing. But if we INLINE traceTc we get++ let stuff_to_print = ...+ in if doTracing+ then emitTraceMsg "wombat" stuff_to_print+ else return ()++and then we float in:++ if doTracing+ then let stuff_to_print = ...+ in emitTraceMsg "wombat" stuff_to_print+ else return ()++Now stuff_to_print is allocated only in the "cold path".++Moreover, on the "cold" path, after the conditional, we want to inline+as /little/ as possible. Performance doesn't matter here, and we'd like+to bloat the caller's code as little as possible. So we put a NOINLINE+on 'emitTraceMsg'++See #18168.+-} -- Typechecker trace traceTc :: String -> SDoc -> TcRn ()
compiler/GHC/ThToHs.hs view
@@ -226,6 +226,10 @@ ; returnJustLA (Hs.SigD noExtField (FixSig noAnn (FixitySig noExtField [nm'] (cvtFixity fx)))) } +cvtDec (TH.DefaultD tys)+ = do { tys' <- traverse cvtType tys+ ; returnJustLA (Hs.DefD noExtField $ DefaultDecl noAnn tys') }+ cvtDec (PragmaD prag) = cvtPragmaD prag
− compiler/GHC/Unit/Finder.hs
@@ -1,625 +0,0 @@-{--(c) The University of Glasgow, 2000-2006---}---{-# LANGUAGE FlexibleContexts #-}---- | Module finder-module GHC.Unit.Finder (- FindResult(..),- InstalledFindResult(..),- FinderCache,- initFinderCache,- flushFinderCaches,- findImportedModule,- findPluginModule,- findExactModule,- findHomeModule,- findExposedPackageModule,- mkHomeModLocation,- mkHomeModLocation2,- mkHiOnlyModLocation,- mkHiPath,- mkObjPath,- addHomeModuleToFinder,- uncacheModule,- mkStubPaths,-- findObjectLinkableMaybe,- findObjectLinkable,-- -- Hash cache- lookupFileCache-- ) where--import GHC.Prelude--import GHC.Driver.Session--import GHC.Platform.Ways--import GHC.Builtin.Names ( gHC_PRIM )--import GHC.Unit.Types-import GHC.Unit.Module-import GHC.Unit.Home-import GHC.Unit.State-import GHC.Unit.Finder.Types--import GHC.Data.FastString-import GHC.Data.Maybe ( expectJust )-import qualified GHC.Data.ShortText as ST--import GHC.Utils.Misc-import GHC.Utils.Outputable as Outputable-import GHC.Utils.Panic--import GHC.Linker.Types--import GHC.Fingerprint-import Data.IORef-import System.Directory-import System.FilePath-import Control.Monad-import Data.Time-import qualified Data.Map as M---type FileExt = String -- Filename extension-type BaseName = String -- Basename of file---- -------------------------------------------------------------------------------- The Finder---- The Finder provides a thin filesystem abstraction to the rest of--- the compiler. For a given module, it can tell you where the--- source, interface, and object files for that module live.---- It does *not* know which particular package a module lives in. Use--- Packages.lookupModuleInAllUnits for that.---- -------------------------------------------------------------------------------- The finder's cache---initFinderCache :: IO FinderCache-initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv- <*> newIORef M.empty---- remove all the home modules from the cache; package modules are--- assumed to not move around during a session; also flush the file hash--- cache-flushFinderCaches :: FinderCache -> HomeUnit -> IO ()-flushFinderCaches (FinderCache ref file_ref) home_unit = do- atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())- atomicModifyIORef' file_ref $ \_ -> (M.empty, ())- where- is_ext mod _ = not (isHomeInstalledModule home_unit mod)--addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()-addToFinderCache (FinderCache ref _) key val =- atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())--removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()-removeFromFinderCache (FinderCache ref _) key =- atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())--lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)-lookupFinderCache (FinderCache ref _) key = do- c <- readIORef ref- return $! lookupInstalledModuleEnv c key--lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint-lookupFileCache (FinderCache _ ref) key = do- c <- readIORef ref- case M.lookup key c of- Nothing -> do- hash <- getFileHash key- atomicModifyIORef' ref $ \c -> (M.insert key hash c, ())- return hash- Just fp -> return fp---- -------------------------------------------------------------------------------- The three external entry points---- | Locate a module that was imported by the user. We have the--- module's name, and possibly a package name. Without a package--- name, this function will use the search path and the known exposed--- packages to find the module, if a package is specified then only--- that package is searched for the module.--findImportedModule- :: FinderCache- -> UnitState- -> HomeUnit- -> DynFlags- -> ModuleName- -> Maybe FastString- -> IO FindResult-findImportedModule fc units home_unit dflags mod_name mb_pkg =- case mb_pkg of- Nothing -> unqual_import- Just pkg | pkg == fsLit "this" -> home_import -- "this" is special- | otherwise -> pkg_import- where- home_import = findHomeModule fc home_unit dflags mod_name-- pkg_import = findExposedPackageModule fc units dflags mod_name mb_pkg-- unqual_import = home_import- `orIfNotFound`- findExposedPackageModule fc units dflags mod_name Nothing---- | Locate a plugin module requested by the user, for a compiler--- plugin. This consults the same set of exposed packages as--- 'findImportedModule', unless @-hide-all-plugin-packages@ or--- @-plugin-package@ are specified.-findPluginModule :: FinderCache -> UnitState -> HomeUnit -> DynFlags -> ModuleName -> IO FindResult-findPluginModule fc units home_unit dflags mod_name =- findHomeModule fc home_unit dflags mod_name- `orIfNotFound`- findExposedPluginPackageModule fc units dflags mod_name---- | Locate a specific 'Module'. The purpose of this function is to--- create a 'ModLocation' for a given 'Module', that is to find out--- where the files associated with this module live. It is used when--- reading the interface for a module mentioned by another interface,--- for example (a "system import").--findExactModule :: FinderCache -> DynFlags -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult-findExactModule fc dflags unit_state home_unit mod = do- if isHomeInstalledModule home_unit mod- then findInstalledHomeModule fc dflags home_unit (moduleName mod)- else findPackageModule fc unit_state dflags mod---- -------------------------------------------------------------------------------- Helpers---- | Given a monadic actions @this@ and @or_this@, first execute--- @this@. If the returned 'FindResult' is successful, return--- it; otherwise, execute @or_this@. If both failed, this function--- also combines their failure messages in a reasonable way.-orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult-orIfNotFound this or_this = do- res <- this- case res of- NotFound { fr_paths = paths1, fr_mods_hidden = mh1- , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }- -> do res2 <- or_this- case res2 of- NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2- , fr_pkgs_hidden = ph2, fr_unusables = u2- , fr_suggestions = s2 }- -> return (NotFound { fr_paths = paths1 ++ paths2- , fr_pkg = mb_pkg2 -- snd arg is the package search- , fr_mods_hidden = mh1 ++ mh2- , fr_pkgs_hidden = ph1 ++ ph2- , fr_unusables = u1 ++ u2- , fr_suggestions = s1 ++ s2 })- _other -> return res2- _other -> return res---- | Helper function for 'findHomeModule': this function wraps an IO action--- which would look up @mod_name@ in the file system (the home package),--- and first consults the 'hsc_FC' cache to see if the lookup has already--- been done. Otherwise, do the lookup (with the IO action) and save--- the result in the finder cache and the module location cache (if it--- was successful.)-homeSearchCache :: FinderCache -> HomeUnit -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult-homeSearchCache fc home_unit mod_name do_this = do- let mod = mkHomeInstalledModule home_unit mod_name- modLocationCache fc mod do_this--findExposedPackageModule :: FinderCache -> UnitState -> DynFlags -> ModuleName -> Maybe FastString -> IO FindResult-findExposedPackageModule fc units dflags mod_name mb_pkg =- findLookupResult fc dflags- $ lookupModuleWithSuggestions units mod_name mb_pkg--findExposedPluginPackageModule :: FinderCache -> UnitState -> DynFlags -> ModuleName -> IO FindResult-findExposedPluginPackageModule fc units dflags mod_name =- findLookupResult fc dflags- $ lookupPluginModuleWithSuggestions units mod_name Nothing--findLookupResult :: FinderCache -> DynFlags -> LookupResult -> IO FindResult-findLookupResult fc dflags r = case r of- LookupFound m pkg_conf -> do- let im = fst (getModuleInstantiation m)- r' <- findPackageModule_ fc dflags im pkg_conf- case r' of- -- TODO: ghc -M is unlikely to do the right thing- -- with just the location of the thing that was- -- instantiated; you probably also need all of the- -- implicit locations from the instances- InstalledFound loc _ -> return (Found loc m)- InstalledNoPackage _ -> return (NoPackage (moduleUnit m))- InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)- , fr_pkgs_hidden = []- , fr_mods_hidden = []- , fr_unusables = []- , fr_suggestions = []})- LookupMultiple rs ->- return (FoundMultiple rs)- LookupHidden pkg_hiddens mod_hiddens ->- return (NotFound{ fr_paths = [], fr_pkg = Nothing- , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens- , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens- , fr_unusables = []- , fr_suggestions = [] })- LookupUnusable unusable ->- let unusables' = map get_unusable unusable- get_unusable (m, ModUnusable r) = (moduleUnit m, r)- get_unusable (_, r) =- pprPanic "findLookupResult: unexpected origin" (ppr r)- in return (NotFound{ fr_paths = [], fr_pkg = Nothing- , fr_pkgs_hidden = []- , fr_mods_hidden = []- , fr_unusables = unusables'- , fr_suggestions = [] })- LookupNotFound suggest -> do- let suggest'- | gopt Opt_HelpfulErrors dflags = suggest- | otherwise = []- return (NotFound{ fr_paths = [], fr_pkg = Nothing- , fr_pkgs_hidden = []- , fr_mods_hidden = []- , fr_unusables = []- , fr_suggestions = suggest' })--modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult-modLocationCache fc mod do_this = do- m <- lookupFinderCache fc mod- case m of- Just result -> return result- Nothing -> do- result <- do_this- addToFinderCache fc mod result- return result---- This returns a module because it's more convenient for users-addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module-addHomeModuleToFinder fc home_unit mod_name loc = do- let mod = mkHomeInstalledModule home_unit mod_name- addToFinderCache fc mod (InstalledFound loc mod)- return (mkHomeModule home_unit mod_name)--uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()-uncacheModule fc home_unit mod_name = do- let mod = mkHomeInstalledModule home_unit mod_name- removeFromFinderCache fc mod---- -------------------------------------------------------------------------------- The internal workers--findHomeModule :: FinderCache -> HomeUnit -> DynFlags -> ModuleName -> IO FindResult-findHomeModule fc home_unit dflags mod_name = do- let uid = homeUnitAsUnit home_unit- r <- findInstalledHomeModule fc dflags home_unit mod_name- return $ case r of- InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name)- InstalledNoPackage _ -> NoPackage uid -- impossible- InstalledNotFound fps _ -> NotFound {- fr_paths = fps,- fr_pkg = Just uid,- fr_mods_hidden = [],- fr_pkgs_hidden = [],- fr_unusables = [],- fr_suggestions = []- }---- | Implements the search for a module name in the home package only. Calling--- this function directly is usually *not* what you want; currently, it's used--- as a building block for the following operations:------ 1. When you do a normal package lookup, we first check if the module--- is available in the home module, before looking it up in the package--- database.------ 2. When you have a package qualified import with package name "this",--- we shortcut to the home module.------ 3. When we look up an exact 'Module', if the unit id associated with--- the module is the current home module do a look up in the home module.------ 4. Some special-case code in GHCi (ToDo: Figure out why that needs to--- call this.)-findInstalledHomeModule :: FinderCache -> DynFlags -> HomeUnit -> ModuleName -> IO InstalledFindResult-findInstalledHomeModule fc dflags home_unit mod_name = do- homeSearchCache fc home_unit mod_name $- let- home_path = importPaths dflags- hisuf = hiSuf dflags- mod = mkHomeInstalledModule home_unit mod_name-- source_exts =- [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")- , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")- , ("hsig", mkHomeModLocationSearched dflags mod_name "hsig")- , ("lhsig", mkHomeModLocationSearched dflags mod_name "lhsig")- ]-- -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that- -- when hiDir field is set in dflags, we know to look there (see #16500)- hi_exts = [ (hisuf, mkHomeModHiOnlyLocation dflags mod_name)- , (addBootSuffix hisuf, mkHomeModHiOnlyLocation dflags mod_name)- ]-- -- In compilation manager modes, we look for source files in the home- -- package because we can compile these automatically. In one-shot- -- compilation mode we look for .hi and .hi-boot files only.- exts | isOneShot (ghcMode dflags) = hi_exts- | otherwise = source_exts- in-- -- special case for GHC.Prim; we won't find it in the filesystem.- -- This is important only when compiling the base package (where GHC.Prim- -- is a home module).- if mod `installedModuleEq` gHC_PRIM- then return (InstalledFound (error "GHC.Prim ModLocation") mod)- else searchPathExts home_path mod exts----- | Search for a module in external packages only.-findPackageModule :: FinderCache -> UnitState -> DynFlags -> InstalledModule -> IO InstalledFindResult-findPackageModule fc unit_state dflags mod = do- let pkg_id = moduleUnit mod- case lookupUnitId unit_state pkg_id of- Nothing -> return (InstalledNoPackage pkg_id)- Just u -> findPackageModule_ fc dflags mod u---- | Look up the interface file associated with module @mod@. This function--- requires a few invariants to be upheld: (1) the 'Module' in question must--- be the module identifier of the *original* implementation of a module,--- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2)--- the 'UnitInfo' must be consistent with the unit id in the 'Module'.--- The redundancy is to avoid an extra lookup in the package state--- for the appropriate config.-findPackageModule_ :: FinderCache -> DynFlags -> InstalledModule -> UnitInfo -> IO InstalledFindResult-findPackageModule_ fc dflags mod pkg_conf = do- massertPpr (moduleUnit mod == unitId pkg_conf)- (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf))- modLocationCache fc mod $-- -- special case for GHC.Prim; we won't find it in the filesystem.- if mod `installedModuleEq` gHC_PRIM- then return (InstalledFound (error "GHC.Prim ModLocation") mod)- else-- let- tag = waysBuildTag (ways dflags)-- -- hi-suffix for packages depends on the build tag.- package_hisuf | null tag = "hi"- | otherwise = tag ++ "_hi"-- mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf-- import_dirs = map ST.unpack $ unitImportDirs pkg_conf- -- we never look for a .hi-boot file in an external package;- -- .hi-boot files only make sense for the home package.- in- case import_dirs of- [one] | MkDepend <- ghcMode dflags -> do- -- there's only one place that this .hi file can be, so- -- don't bother looking for it.- let basename = moduleNameSlashes (moduleName mod)- loc <- mk_hi_loc one basename- return (InstalledFound loc mod)- _otherwise ->- searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]---- -------------------------------------------------------------------------------- General path searching--searchPathExts :: [FilePath] -- paths to search- -> InstalledModule -- module name- -> [ (- FileExt, -- suffix- FilePath -> BaseName -> IO ModLocation -- action- )- ]- -> IO InstalledFindResult--searchPathExts paths mod exts = search to_search- where- basename = moduleNameSlashes (moduleName mod)-- to_search :: [(FilePath, IO ModLocation)]- to_search = [ (file, fn path basename)- | path <- paths,- (ext,fn) <- exts,- let base | path == "." = basename- | otherwise = path </> basename- file = base <.> ext- ]-- search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))-- search ((file, mk_result) : rest) = do- b <- doesFileExist file- if b- then do { loc <- mk_result; return (InstalledFound loc mod) }- else search rest--mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt- -> FilePath -> BaseName -> IO ModLocation-mkHomeModLocationSearched dflags mod suff path basename =- mkHomeModLocation2 dflags mod (path </> basename) suff---- -------------------------------------------------------------------------------- Constructing a home module location---- This is where we construct the ModLocation for a module in the home--- package, for which we have a source file. It is called from three--- places:------ (a) Here in the finder, when we are searching for a module to import,--- using the search path (-i option).------ (b) The compilation manager, when constructing the ModLocation for--- a "root" module (a source file named explicitly on the command line--- or in a :load command in GHCi).------ (c) The driver in one-shot mode, when we need to construct a--- ModLocation for a source file named on the command-line.------ Parameters are:------ mod--- The name of the module------ path--- (a): The search path component where the source file was found.--- (b) and (c): "."------ src_basename--- (a): (moduleNameSlashes mod)--- (b) and (c): The filename of the source file, minus its extension------ ext--- The filename extension of the source file (usually "hs" or "lhs").--mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation-mkHomeModLocation dflags mod src_filename = do- let (basename,extension) = splitExtension src_filename- mkHomeModLocation2 dflags mod basename extension--mkHomeModLocation2 :: DynFlags- -> ModuleName- -> FilePath -- Of source module, without suffix- -> String -- Suffix- -> IO ModLocation-mkHomeModLocation2 dflags mod src_basename ext = do- let mod_basename = moduleNameSlashes mod-- obj_fn = mkObjPath dflags src_basename mod_basename- hi_fn = mkHiPath dflags src_basename mod_basename- hie_fn = mkHiePath dflags src_basename mod_basename-- return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),- ml_hi_file = hi_fn,- ml_obj_file = obj_fn,- ml_hie_file = hie_fn })--mkHomeModHiOnlyLocation :: DynFlags- -> ModuleName- -> FilePath- -> BaseName- -> IO ModLocation-mkHomeModHiOnlyLocation dflags mod path basename = do- loc <- mkHomeModLocation2 dflags mod (path </> basename) ""- return loc { ml_hs_file = Nothing }--mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String- -> IO ModLocation-mkHiOnlyModLocation dflags hisuf path basename- = do let full_basename = path </> basename- obj_fn = mkObjPath dflags full_basename basename- hie_fn = mkHiePath dflags full_basename basename- return ModLocation{ ml_hs_file = Nothing,- ml_hi_file = full_basename <.> hisuf,- -- Remove the .hi-boot suffix from- -- hi_file, if it had one. We always- -- want the name of the real .hi file- -- in the ml_hi_file field.- ml_obj_file = obj_fn,- ml_hie_file = hie_fn- }---- | Constructs the filename of a .o file for a given source file.--- Does /not/ check whether the .o file exists-mkObjPath- :: DynFlags- -> FilePath -- the filename of the source file, minus the extension- -> String -- the module name with dots replaced by slashes- -> FilePath-mkObjPath dflags basename mod_basename = obj_basename <.> osuf- where- odir = objectDir dflags- osuf = objectSuf dflags-- obj_basename | Just dir <- odir = dir </> mod_basename- | otherwise = basename----- | Constructs the filename of a .hi file for a given source file.--- Does /not/ check whether the .hi file exists-mkHiPath- :: DynFlags- -> FilePath -- the filename of the source file, minus the extension- -> String -- the module name with dots replaced by slashes- -> FilePath-mkHiPath dflags basename mod_basename = hi_basename <.> hisuf- where- hidir = hiDir dflags- hisuf = hiSuf dflags-- hi_basename | Just dir <- hidir = dir </> mod_basename- | otherwise = basename---- | Constructs the filename of a .hie file for a given source file.--- Does /not/ check whether the .hie file exists-mkHiePath- :: DynFlags- -> FilePath -- the filename of the source file, minus the extension- -> String -- the module name with dots replaced by slashes- -> FilePath-mkHiePath dflags basename mod_basename = hie_basename <.> hiesuf- where- hiedir = hieDir dflags- hiesuf = hieSuf dflags-- hie_basename | Just dir <- hiedir = dir </> mod_basename- | otherwise = basename------ -------------------------------------------------------------------------------- Filenames of the stub files---- We don't have to store these in ModLocations, because they can be derived--- from other available information, and they're only rarely needed.--mkStubPaths- :: DynFlags- -> ModuleName- -> ModLocation- -> FilePath--mkStubPaths dflags mod location- = let- stubdir = stubDir dflags-- mod_basename = moduleNameSlashes mod- src_basename = dropExtension $ expectJust "mkStubPaths"- (ml_hs_file location)-- stub_basename0- | Just dir <- stubdir = dir </> mod_basename- | otherwise = src_basename-- stub_basename = stub_basename0 ++ "_stub"- in- stub_basename <.> "h"---- -------------------------------------------------------------------------------- findLinkable isn't related to the other stuff in here,--- but there's no other obvious place for it--findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)-findObjectLinkableMaybe mod locn- = do let obj_fn = ml_obj_file locn- maybe_obj_time <- modificationTimeIfExists obj_fn- case maybe_obj_time of- Nothing -> return Nothing- Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)---- Make an object linkable when we know the object file exists, and we know--- its modification time.-findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable-findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])- -- We used to look for _stub.o files here, but that was a bug (#706)- -- Now GHC merges the stub.o into the main .o (#3687)-
ghc-lib.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-version: 0.20210701+version: 0.20210801 license: BSD3 license-file: LICENSE category: Development@@ -61,7 +61,6 @@ else build-depends: Win32 build-depends:- rts, ghc-prim > 0.2 && < 0.8, base >= 4.14 && < 4.17, containers >= 0.5 && < 0.7,@@ -75,10 +74,11 @@ time >= 1.4 && < 1.10, transformers == 0.5.*, process >= 1 && < 1.7,- hpc == 0.6.*, exceptions == 0.10.*, parsec,- ghc-lib-parser == 0.20210701+ rts,+ hpc == 0.6.*,+ ghc-lib-parser == 0.20210801 build-tools: alex >= 3.1, happy >= 1.19.4 other-extensions: BangPatterns@@ -218,6 +218,7 @@ GHC.Driver.CmdLine, GHC.Driver.Config, GHC.Driver.Config.Diagnostic,+ GHC.Driver.Config.Finder, GHC.Driver.Config.Logger, GHC.Driver.Config.Parser, GHC.Driver.Env,@@ -230,6 +231,7 @@ GHC.Driver.Monad, GHC.Driver.Phases, GHC.Driver.Pipeline.Monad,+ GHC.Driver.Pipeline.Phases, GHC.Driver.Plugins, GHC.Driver.Ppr, GHC.Driver.Session,@@ -279,6 +281,7 @@ GHC.Parser, GHC.Parser.Annotation, GHC.Parser.CharClass,+ GHC.Parser.Errors.Basic, GHC.Parser.Errors.Ppr, GHC.Parser.Errors.Types, GHC.Parser.Header,@@ -383,6 +386,7 @@ GHC.Unit.Database, GHC.Unit.Env, GHC.Unit.External,+ GHC.Unit.Finder, GHC.Unit.Finder.Types, GHC.Unit.Home, GHC.Unit.Home.ModInfo,@@ -608,6 +612,7 @@ GHC.Driver.Make GHC.Driver.MakeFile GHC.Driver.Pipeline+ GHC.Driver.Pipeline.Execute GHC.HandleEncoding GHC.Hs.Stats GHC.Hs.Syn.Type@@ -773,7 +778,6 @@ GHC.ThToHs GHC.Types.Name.Shape GHC.Types.TyThing.Ppr- GHC.Unit.Finder GHC.Utils.Asm GHC.Utils.Monad.State.Lazy GHCi.CreateBCO
ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl view
@@ -288,7 +288,6 @@ | FloatToDoubleOp | FloatDecode_IntOp | NewArrayOp- | SameMutableArrayOp | ReadArrayOp | WriteArrayOp | SizeofArrayOp@@ -304,7 +303,6 @@ | ThawArrayOp | CasArrayOp | NewSmallArrayOp- | SameSmallMutableArrayOp | ShrinkSmallMutableArrayOp_Char | ReadSmallArrayOp | WriteSmallArrayOp@@ -328,7 +326,6 @@ | ByteArrayIsPinnedOp | ByteArrayContents_Char | MutableByteArrayContents_Char- | SameMutableByteArrayOp | ShrinkMutableByteArrayOp_Char | ResizeMutableByteArrayOp_Char | UnsafeFreezeByteArrayOp@@ -442,7 +439,6 @@ | FetchOrByteArrayOp_Int | FetchXorByteArrayOp_Int | NewArrayArrayOp- | SameMutableArrayArrayOp | UnsafeFreezeArrayArrayOp | SizeofArrayArrayOp | SizeofMutableArrayArrayOp@@ -532,7 +528,6 @@ | NewMutVarOp | ReadMutVarOp | WriteMutVarOp- | SameMutVarOp | AtomicModifyMutVar2Op | AtomicModifyMutVar_Op | CasMutVarOp@@ -551,7 +546,6 @@ | ReadTVarOp | ReadTVarIOOp | WriteTVarOp- | SameTVarOp | NewMVarOp | TakeMVarOp | TryTakeMVarOp@@ -559,12 +553,10 @@ | TryPutMVarOp | ReadMVarOp | TryReadMVarOp- | SameMVarOp | IsEmptyMVarOp | NewIOPortrOp | ReadIOPortOp | WriteIOPortOp- | SameIOPortOp | DelayOp | WaitReadOp | WaitWriteOp@@ -587,7 +579,6 @@ | DeRefStablePtrOp | EqStablePtrOp | MakeStableNameOp- | EqStableNameOp | StableNameToIntOp | CompactNewOp | CompactResizeOp
ghc-lib/stage0/compiler/build/primop-list.hs-incl view
@@ -287,7 +287,6 @@ , FloatToDoubleOp , FloatDecode_IntOp , NewArrayOp- , SameMutableArrayOp , ReadArrayOp , WriteArrayOp , SizeofArrayOp@@ -303,7 +302,6 @@ , ThawArrayOp , CasArrayOp , NewSmallArrayOp- , SameSmallMutableArrayOp , ShrinkSmallMutableArrayOp_Char , ReadSmallArrayOp , WriteSmallArrayOp@@ -327,7 +325,6 @@ , ByteArrayIsPinnedOp , ByteArrayContents_Char , MutableByteArrayContents_Char- , SameMutableByteArrayOp , ShrinkMutableByteArrayOp_Char , ResizeMutableByteArrayOp_Char , UnsafeFreezeByteArrayOp@@ -441,7 +438,6 @@ , FetchOrByteArrayOp_Int , FetchXorByteArrayOp_Int , NewArrayArrayOp- , SameMutableArrayArrayOp , UnsafeFreezeArrayArrayOp , SizeofArrayArrayOp , SizeofMutableArrayArrayOp@@ -531,7 +527,6 @@ , NewMutVarOp , ReadMutVarOp , WriteMutVarOp- , SameMutVarOp , AtomicModifyMutVar2Op , AtomicModifyMutVar_Op , CasMutVarOp@@ -550,7 +545,6 @@ , ReadTVarOp , ReadTVarIOOp , WriteTVarOp- , SameTVarOp , NewMVarOp , TakeMVarOp , TryTakeMVarOp@@ -558,12 +552,10 @@ , TryPutMVarOp , ReadMVarOp , TryReadMVarOp- , SameMVarOp , IsEmptyMVarOp , NewIOPortrOp , ReadIOPortOp , WriteIOPortOp- , SameIOPortOp , DelayOp , WaitReadOp , WaitWriteOp@@ -586,7 +578,6 @@ , DeRefStablePtrOp , EqStablePtrOp , MakeStableNameOp- , EqStableNameOp , StableNameToIntOp , CompactNewOp , CompactResizeOp
ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl view
@@ -287,7 +287,6 @@ primOpInfo FloatToDoubleOp = mkGenPrimOp (fsLit "float2Double#") [] [floatPrimTy] (doublePrimTy) primOpInfo FloatDecode_IntOp = mkGenPrimOp (fsLit "decodeFloat_Int#") [] [floatPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy])) primOpInfo NewArrayOp = mkGenPrimOp (fsLit "newArray#") [alphaTyVarSpec, deltaTyVarSpec] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy]))-primOpInfo SameMutableArrayOp = mkGenPrimOp (fsLit "sameMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo ReadArrayOp = mkGenPrimOp (fsLit "readArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteArrayOp = mkGenPrimOp (fsLit "writeArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo SizeofArrayOp = mkGenPrimOp (fsLit "sizeofArray#") [alphaTyVarSpec] [mkArrayPrimTy alphaTy] (intPrimTy)@@ -303,7 +302,6 @@ primOpInfo ThawArrayOp = mkGenPrimOp (fsLit "thawArray#") [alphaTyVarSpec, deltaTyVarSpec] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) primOpInfo CasArrayOp = mkGenPrimOp (fsLit "casArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) primOpInfo NewSmallArrayOp = mkGenPrimOp (fsLit "newSmallArray#") [alphaTyVarSpec, deltaTyVarSpec] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy]))-primOpInfo SameSmallMutableArrayOp = mkGenPrimOp (fsLit "sameSmallMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo ShrinkSmallMutableArrayOp_Char = mkGenPrimOp (fsLit "shrinkSmallMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ReadSmallArrayOp = mkGenPrimOp (fsLit "readSmallArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteSmallArrayOp = mkGenPrimOp (fsLit "writeSmallArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)@@ -327,7 +325,6 @@ primOpInfo ByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isByteArrayPinned#") [] [byteArrayPrimTy] (intPrimTy) primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#") [] [byteArrayPrimTy] (addrPrimTy) primOpInfo MutableByteArrayContents_Char = mkGenPrimOp (fsLit "mutableByteArrayContents#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy] (addrPrimTy)-primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy) primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ResizeMutableByteArrayOp_Char = mkGenPrimOp (fsLit "resizeMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) primOpInfo UnsafeFreezeByteArrayOp = mkGenPrimOp (fsLit "unsafeFreezeByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, byteArrayPrimTy]))@@ -441,7 +438,6 @@ primOpInfo FetchOrByteArrayOp_Int = mkGenPrimOp (fsLit "fetchOrIntArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo FetchXorByteArrayOp_Int = mkGenPrimOp (fsLit "fetchXorIntArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo NewArrayArrayOp = mkGenPrimOp (fsLit "newArrayArray#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy]))-primOpInfo SameMutableArrayArrayOp = mkGenPrimOp (fsLit "sameMutableArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) primOpInfo UnsafeFreezeArrayArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) primOpInfo SizeofArrayArrayOp = mkGenPrimOp (fsLit "sizeofArrayArray#") [] [mkArrayArrayPrimTy] (intPrimTy) primOpInfo SizeofMutableArrayArrayOp = mkGenPrimOp (fsLit "sizeofMutableArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy] (intPrimTy)@@ -531,7 +527,6 @@ primOpInfo NewMutVarOp = mkGenPrimOp (fsLit "newMutVar#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutVarPrimTy deltaTy alphaTy])) primOpInfo ReadMutVarOp = mkGenPrimOp (fsLit "readMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteMutVarOp = mkGenPrimOp (fsLit "writeMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)-primOpInfo SameMutVarOp = mkGenPrimOp (fsLit "sameMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, mkMutVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo AtomicModifyMutVar2Op = mkGenPrimOp (fsLit "atomicModifyMutVar2#") [deltaTyVarSpec, alphaTyVarSpec, gammaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTyMany (alphaTy) (gammaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, gammaTy])) primOpInfo AtomicModifyMutVar_Op = mkGenPrimOp (fsLit "atomicModifyMutVar_#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTyMany (alphaTy) (alphaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, alphaTy])) primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))@@ -550,7 +545,6 @@ primOpInfo ReadTVarOp = mkGenPrimOp (fsLit "readTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo ReadTVarIOOp = mkGenPrimOp (fsLit "readTVarIO#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteTVarOp = mkGenPrimOp (fsLit "writeTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)-primOpInfo SameTVarOp = mkGenPrimOp (fsLit "sameTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkTVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo NewMVarOp = mkGenPrimOp (fsLit "newMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMVarPrimTy deltaTy alphaTy])) primOpInfo TakeMVarOp = mkGenPrimOp (fsLit "takeMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo TryTakeMVarOp = mkGenPrimOp (fsLit "tryTakeMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))@@ -558,12 +552,10 @@ primOpInfo TryPutMVarOp = mkGenPrimOp (fsLit "tryPutMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo ReadMVarOp = mkGenPrimOp (fsLit "readMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo TryReadMVarOp = mkGenPrimOp (fsLit "tryReadMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))-primOpInfo SameMVarOp = mkGenPrimOp (fsLit "sameMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkMVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo IsEmptyMVarOp = mkGenPrimOp (fsLit "isEmptyMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo NewIOPortrOp = mkGenPrimOp (fsLit "newIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkIOPortPrimTy deltaTy alphaTy])) primOpInfo ReadIOPortOp = mkGenPrimOp (fsLit "readIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteIOPortOp = mkGenPrimOp (fsLit "writeIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))-primOpInfo SameIOPortOp = mkGenPrimOp (fsLit "sameIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, mkIOPortPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo DelayOp = mkGenPrimOp (fsLit "delay#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo WaitReadOp = mkGenPrimOp (fsLit "waitRead#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo WaitWriteOp = mkGenPrimOp (fsLit "waitWrite#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)@@ -576,17 +568,16 @@ primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [deltaTyVarSpec] [mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#") [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy]))-primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [levity1TyVarInf, levPolyTyVar1Spec, betaTyVarSpec, gammaTyVarSpec] [levPolyTy1, betaTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))-primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [levity1TyVarInf, levPolyTyVar1Spec, betaTyVarSpec] [levPolyTy1, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))+primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [levity1TyVarInf, levPolyAlphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec] [levPolyAlphaTy, betaTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))+primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [levity1TyVarInf, levPolyAlphaTyVarSpec, betaTyVarSpec] [levPolyAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) primOpInfo AddCFinalizerToWeakOp = mkGenPrimOp (fsLit "addCFinalizerToWeak#") [betaTyVarSpec] [addrPrimTy, addrPrimTy, intPrimTy, addrPrimTy, mkWeakPrimTy betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) primOpInfo DeRefWeakOp = mkGenPrimOp (fsLit "deRefWeak#") [alphaTyVarSpec] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, alphaTy])) primOpInfo FinalizeWeakOp = mkGenPrimOp (fsLit "finalizeWeak#") [alphaTyVarSpec, betaTyVarSpec] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, betaTy])))]))-primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [levity1TyVarInf, levPolyTyVar1Spec] [levPolyTy1, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [levity1TyVarInf, levPolyAlphaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) primOpInfo MakeStablePtrOp = mkGenPrimOp (fsLit "makeStablePtr#") [alphaTyVarSpec] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStablePtrPrimTy alphaTy])) primOpInfo DeRefStablePtrOp = mkGenPrimOp (fsLit "deRefStablePtr#") [alphaTyVarSpec] [mkStablePtrPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#") [alphaTyVarSpec] [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy alphaTy] (intPrimTy) primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#") [alphaTyVarSpec] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy]))-primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#") [alphaTyVarSpec, betaTyVarSpec] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy) primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#") [alphaTyVarSpec] [mkStableNamePrimTy alphaTy] (intPrimTy) primOpInfo CompactNewOp = mkGenPrimOp (fsLit "compactNew#") [] [wordPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy])) primOpInfo CompactResizeOp = mkGenPrimOp (fsLit "compactResize#") [] [compactPrimTy, wordPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)@@ -599,13 +590,13 @@ primOpInfo CompactAdd = mkGenPrimOp (fsLit "compactAdd#") [alphaTyVarSpec] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo CompactAddWithSharing = mkGenPrimOp (fsLit "compactAddWithSharing#") [alphaTyVarSpec] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo CompactSize = mkGenPrimOp (fsLit "compactSize#") [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, wordPrimTy]))-primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [alphaTyVarSpec] [alphaTy, alphaTy] (intPrimTy)+primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [levity1TyVarInf, levPolyAlphaTyVarSpec, levity2TyVarInf, levPolyBetaTyVarSpec] [levPolyAlphaTy, levPolyBetaTy] (intPrimTy) primOpInfo ParOp = mkGenPrimOp (fsLit "par#") [alphaTyVarSpec] [alphaTy] (intPrimTy) primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#") [deltaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))-primOpInfo KeepAliveOp = mkGenPrimOp (fsLit "keepAlive#") [levity1TyVarInf, levPolyTyVar1Spec, runtimeRep2TyVarInf, openBetaTyVarSpec] [levPolyTy1, mkStatePrimTy realWorldTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) (openBetaTy))] (openBetaTy)+primOpInfo KeepAliveOp = mkGenPrimOp (fsLit "keepAlive#") [levity1TyVarInf, levPolyAlphaTyVarSpec, runtimeRep2TyVarInf, openBetaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy realWorldTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) (openBetaTy))] (openBetaTy) primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#") [alphaTyVarSpec] [alphaTy] (intPrimTy) primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#") [alphaTyVarSpec] [intPrimTy] (alphaTy) primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#") [alphaTyVarSpec] [addrPrimTy] ((mkTupleTy Unboxed [alphaTy]))
ghc-lib/stage0/compiler/build/primop-tag.hs-incl view
@@ -1,1286 +1,1277 @@ maxPrimOpTag :: Int-maxPrimOpTag = 1283-primOpTag :: PrimOp -> Int-primOpTag CharGtOp = 1-primOpTag CharGeOp = 2-primOpTag CharEqOp = 3-primOpTag CharNeOp = 4-primOpTag CharLtOp = 5-primOpTag CharLeOp = 6-primOpTag OrdOp = 7-primOpTag Int8ToIntOp = 8-primOpTag IntToInt8Op = 9-primOpTag Int8NegOp = 10-primOpTag Int8AddOp = 11-primOpTag Int8SubOp = 12-primOpTag Int8MulOp = 13-primOpTag Int8QuotOp = 14-primOpTag Int8RemOp = 15-primOpTag Int8QuotRemOp = 16-primOpTag Int8SllOp = 17-primOpTag Int8SraOp = 18-primOpTag Int8SrlOp = 19-primOpTag Int8ToWord8Op = 20-primOpTag Int8EqOp = 21-primOpTag Int8GeOp = 22-primOpTag Int8GtOp = 23-primOpTag Int8LeOp = 24-primOpTag Int8LtOp = 25-primOpTag Int8NeOp = 26-primOpTag Word8ToWordOp = 27-primOpTag WordToWord8Op = 28-primOpTag Word8AddOp = 29-primOpTag Word8SubOp = 30-primOpTag Word8MulOp = 31-primOpTag Word8QuotOp = 32-primOpTag Word8RemOp = 33-primOpTag Word8QuotRemOp = 34-primOpTag Word8AndOp = 35-primOpTag Word8OrOp = 36-primOpTag Word8XorOp = 37-primOpTag Word8NotOp = 38-primOpTag Word8SllOp = 39-primOpTag Word8SrlOp = 40-primOpTag Word8ToInt8Op = 41-primOpTag Word8EqOp = 42-primOpTag Word8GeOp = 43-primOpTag Word8GtOp = 44-primOpTag Word8LeOp = 45-primOpTag Word8LtOp = 46-primOpTag Word8NeOp = 47-primOpTag Int16ToIntOp = 48-primOpTag IntToInt16Op = 49-primOpTag Int16NegOp = 50-primOpTag Int16AddOp = 51-primOpTag Int16SubOp = 52-primOpTag Int16MulOp = 53-primOpTag Int16QuotOp = 54-primOpTag Int16RemOp = 55-primOpTag Int16QuotRemOp = 56-primOpTag Int16SllOp = 57-primOpTag Int16SraOp = 58-primOpTag Int16SrlOp = 59-primOpTag Int16ToWord16Op = 60-primOpTag Int16EqOp = 61-primOpTag Int16GeOp = 62-primOpTag Int16GtOp = 63-primOpTag Int16LeOp = 64-primOpTag Int16LtOp = 65-primOpTag Int16NeOp = 66-primOpTag Word16ToWordOp = 67-primOpTag WordToWord16Op = 68-primOpTag Word16AddOp = 69-primOpTag Word16SubOp = 70-primOpTag Word16MulOp = 71-primOpTag Word16QuotOp = 72-primOpTag Word16RemOp = 73-primOpTag Word16QuotRemOp = 74-primOpTag Word16AndOp = 75-primOpTag Word16OrOp = 76-primOpTag Word16XorOp = 77-primOpTag Word16NotOp = 78-primOpTag Word16SllOp = 79-primOpTag Word16SrlOp = 80-primOpTag Word16ToInt16Op = 81-primOpTag Word16EqOp = 82-primOpTag Word16GeOp = 83-primOpTag Word16GtOp = 84-primOpTag Word16LeOp = 85-primOpTag Word16LtOp = 86-primOpTag Word16NeOp = 87-primOpTag Int32ToIntOp = 88-primOpTag IntToInt32Op = 89-primOpTag Int32NegOp = 90-primOpTag Int32AddOp = 91-primOpTag Int32SubOp = 92-primOpTag Int32MulOp = 93-primOpTag Int32QuotOp = 94-primOpTag Int32RemOp = 95-primOpTag Int32QuotRemOp = 96-primOpTag Int32SllOp = 97-primOpTag Int32SraOp = 98-primOpTag Int32SrlOp = 99-primOpTag Int32ToWord32Op = 100-primOpTag Int32EqOp = 101-primOpTag Int32GeOp = 102-primOpTag Int32GtOp = 103-primOpTag Int32LeOp = 104-primOpTag Int32LtOp = 105-primOpTag Int32NeOp = 106-primOpTag Word32ToWordOp = 107-primOpTag WordToWord32Op = 108-primOpTag Word32AddOp = 109-primOpTag Word32SubOp = 110-primOpTag Word32MulOp = 111-primOpTag Word32QuotOp = 112-primOpTag Word32RemOp = 113-primOpTag Word32QuotRemOp = 114-primOpTag Word32AndOp = 115-primOpTag Word32OrOp = 116-primOpTag Word32XorOp = 117-primOpTag Word32NotOp = 118-primOpTag Word32SllOp = 119-primOpTag Word32SrlOp = 120-primOpTag Word32ToInt32Op = 121-primOpTag Word32EqOp = 122-primOpTag Word32GeOp = 123-primOpTag Word32GtOp = 124-primOpTag Word32LeOp = 125-primOpTag Word32LtOp = 126-primOpTag Word32NeOp = 127-primOpTag IntAddOp = 128-primOpTag IntSubOp = 129-primOpTag IntMulOp = 130-primOpTag IntMul2Op = 131-primOpTag IntMulMayOfloOp = 132-primOpTag IntQuotOp = 133-primOpTag IntRemOp = 134-primOpTag IntQuotRemOp = 135-primOpTag IntAndOp = 136-primOpTag IntOrOp = 137-primOpTag IntXorOp = 138-primOpTag IntNotOp = 139-primOpTag IntNegOp = 140-primOpTag IntAddCOp = 141-primOpTag IntSubCOp = 142-primOpTag IntGtOp = 143-primOpTag IntGeOp = 144-primOpTag IntEqOp = 145-primOpTag IntNeOp = 146-primOpTag IntLtOp = 147-primOpTag IntLeOp = 148-primOpTag ChrOp = 149-primOpTag IntToWordOp = 150-primOpTag IntToFloatOp = 151-primOpTag IntToDoubleOp = 152-primOpTag WordToFloatOp = 153-primOpTag WordToDoubleOp = 154-primOpTag IntSllOp = 155-primOpTag IntSraOp = 156-primOpTag IntSrlOp = 157-primOpTag WordAddOp = 158-primOpTag WordAddCOp = 159-primOpTag WordSubCOp = 160-primOpTag WordAdd2Op = 161-primOpTag WordSubOp = 162-primOpTag WordMulOp = 163-primOpTag WordMul2Op = 164-primOpTag WordQuotOp = 165-primOpTag WordRemOp = 166-primOpTag WordQuotRemOp = 167-primOpTag WordQuotRem2Op = 168-primOpTag WordAndOp = 169-primOpTag WordOrOp = 170-primOpTag WordXorOp = 171-primOpTag WordNotOp = 172-primOpTag WordSllOp = 173-primOpTag WordSrlOp = 174-primOpTag WordToIntOp = 175-primOpTag WordGtOp = 176-primOpTag WordGeOp = 177-primOpTag WordEqOp = 178-primOpTag WordNeOp = 179-primOpTag WordLtOp = 180-primOpTag WordLeOp = 181-primOpTag PopCnt8Op = 182-primOpTag PopCnt16Op = 183-primOpTag PopCnt32Op = 184-primOpTag PopCnt64Op = 185-primOpTag PopCntOp = 186-primOpTag Pdep8Op = 187-primOpTag Pdep16Op = 188-primOpTag Pdep32Op = 189-primOpTag Pdep64Op = 190-primOpTag PdepOp = 191-primOpTag Pext8Op = 192-primOpTag Pext16Op = 193-primOpTag Pext32Op = 194-primOpTag Pext64Op = 195-primOpTag PextOp = 196-primOpTag Clz8Op = 197-primOpTag Clz16Op = 198-primOpTag Clz32Op = 199-primOpTag Clz64Op = 200-primOpTag ClzOp = 201-primOpTag Ctz8Op = 202-primOpTag Ctz16Op = 203-primOpTag Ctz32Op = 204-primOpTag Ctz64Op = 205-primOpTag CtzOp = 206-primOpTag BSwap16Op = 207-primOpTag BSwap32Op = 208-primOpTag BSwap64Op = 209-primOpTag BSwapOp = 210-primOpTag BRev8Op = 211-primOpTag BRev16Op = 212-primOpTag BRev32Op = 213-primOpTag BRev64Op = 214-primOpTag BRevOp = 215-primOpTag Narrow8IntOp = 216-primOpTag Narrow16IntOp = 217-primOpTag Narrow32IntOp = 218-primOpTag Narrow8WordOp = 219-primOpTag Narrow16WordOp = 220-primOpTag Narrow32WordOp = 221-primOpTag DoubleGtOp = 222-primOpTag DoubleGeOp = 223-primOpTag DoubleEqOp = 224-primOpTag DoubleNeOp = 225-primOpTag DoubleLtOp = 226-primOpTag DoubleLeOp = 227-primOpTag DoubleAddOp = 228-primOpTag DoubleSubOp = 229-primOpTag DoubleMulOp = 230-primOpTag DoubleDivOp = 231-primOpTag DoubleNegOp = 232-primOpTag DoubleFabsOp = 233-primOpTag DoubleToIntOp = 234-primOpTag DoubleToFloatOp = 235-primOpTag DoubleExpOp = 236-primOpTag DoubleExpM1Op = 237-primOpTag DoubleLogOp = 238-primOpTag DoubleLog1POp = 239-primOpTag DoubleSqrtOp = 240-primOpTag DoubleSinOp = 241-primOpTag DoubleCosOp = 242-primOpTag DoubleTanOp = 243-primOpTag DoubleAsinOp = 244-primOpTag DoubleAcosOp = 245-primOpTag DoubleAtanOp = 246-primOpTag DoubleSinhOp = 247-primOpTag DoubleCoshOp = 248-primOpTag DoubleTanhOp = 249-primOpTag DoubleAsinhOp = 250-primOpTag DoubleAcoshOp = 251-primOpTag DoubleAtanhOp = 252-primOpTag DoublePowerOp = 253-primOpTag DoubleDecode_2IntOp = 254-primOpTag DoubleDecode_Int64Op = 255-primOpTag FloatGtOp = 256-primOpTag FloatGeOp = 257-primOpTag FloatEqOp = 258-primOpTag FloatNeOp = 259-primOpTag FloatLtOp = 260-primOpTag FloatLeOp = 261-primOpTag FloatAddOp = 262-primOpTag FloatSubOp = 263-primOpTag FloatMulOp = 264-primOpTag FloatDivOp = 265-primOpTag FloatNegOp = 266-primOpTag FloatFabsOp = 267-primOpTag FloatToIntOp = 268-primOpTag FloatExpOp = 269-primOpTag FloatExpM1Op = 270-primOpTag FloatLogOp = 271-primOpTag FloatLog1POp = 272-primOpTag FloatSqrtOp = 273-primOpTag FloatSinOp = 274-primOpTag FloatCosOp = 275-primOpTag FloatTanOp = 276-primOpTag FloatAsinOp = 277-primOpTag FloatAcosOp = 278-primOpTag FloatAtanOp = 279-primOpTag FloatSinhOp = 280-primOpTag FloatCoshOp = 281-primOpTag FloatTanhOp = 282-primOpTag FloatAsinhOp = 283-primOpTag FloatAcoshOp = 284-primOpTag FloatAtanhOp = 285-primOpTag FloatPowerOp = 286-primOpTag FloatToDoubleOp = 287-primOpTag FloatDecode_IntOp = 288-primOpTag NewArrayOp = 289-primOpTag SameMutableArrayOp = 290-primOpTag ReadArrayOp = 291-primOpTag WriteArrayOp = 292-primOpTag SizeofArrayOp = 293-primOpTag SizeofMutableArrayOp = 294-primOpTag IndexArrayOp = 295-primOpTag UnsafeFreezeArrayOp = 296-primOpTag UnsafeThawArrayOp = 297-primOpTag CopyArrayOp = 298-primOpTag CopyMutableArrayOp = 299-primOpTag CloneArrayOp = 300-primOpTag CloneMutableArrayOp = 301-primOpTag FreezeArrayOp = 302-primOpTag ThawArrayOp = 303-primOpTag CasArrayOp = 304-primOpTag NewSmallArrayOp = 305-primOpTag SameSmallMutableArrayOp = 306-primOpTag ShrinkSmallMutableArrayOp_Char = 307-primOpTag ReadSmallArrayOp = 308-primOpTag WriteSmallArrayOp = 309-primOpTag SizeofSmallArrayOp = 310-primOpTag SizeofSmallMutableArrayOp = 311-primOpTag GetSizeofSmallMutableArrayOp = 312-primOpTag IndexSmallArrayOp = 313-primOpTag UnsafeFreezeSmallArrayOp = 314-primOpTag UnsafeThawSmallArrayOp = 315-primOpTag CopySmallArrayOp = 316-primOpTag CopySmallMutableArrayOp = 317-primOpTag CloneSmallArrayOp = 318-primOpTag CloneSmallMutableArrayOp = 319-primOpTag FreezeSmallArrayOp = 320-primOpTag ThawSmallArrayOp = 321-primOpTag CasSmallArrayOp = 322-primOpTag NewByteArrayOp_Char = 323-primOpTag NewPinnedByteArrayOp_Char = 324-primOpTag NewAlignedPinnedByteArrayOp_Char = 325-primOpTag MutableByteArrayIsPinnedOp = 326-primOpTag ByteArrayIsPinnedOp = 327-primOpTag ByteArrayContents_Char = 328-primOpTag MutableByteArrayContents_Char = 329-primOpTag SameMutableByteArrayOp = 330-primOpTag ShrinkMutableByteArrayOp_Char = 331-primOpTag ResizeMutableByteArrayOp_Char = 332-primOpTag UnsafeFreezeByteArrayOp = 333-primOpTag SizeofByteArrayOp = 334-primOpTag SizeofMutableByteArrayOp = 335-primOpTag GetSizeofMutableByteArrayOp = 336-primOpTag IndexByteArrayOp_Char = 337-primOpTag IndexByteArrayOp_WideChar = 338-primOpTag IndexByteArrayOp_Int = 339-primOpTag IndexByteArrayOp_Word = 340-primOpTag IndexByteArrayOp_Addr = 341-primOpTag IndexByteArrayOp_Float = 342-primOpTag IndexByteArrayOp_Double = 343-primOpTag IndexByteArrayOp_StablePtr = 344-primOpTag IndexByteArrayOp_Int8 = 345-primOpTag IndexByteArrayOp_Int16 = 346-primOpTag IndexByteArrayOp_Int32 = 347-primOpTag IndexByteArrayOp_Int64 = 348-primOpTag IndexByteArrayOp_Word8 = 349-primOpTag IndexByteArrayOp_Word16 = 350-primOpTag IndexByteArrayOp_Word32 = 351-primOpTag IndexByteArrayOp_Word64 = 352-primOpTag IndexByteArrayOp_Word8AsChar = 353-primOpTag IndexByteArrayOp_Word8AsWideChar = 354-primOpTag IndexByteArrayOp_Word8AsInt = 355-primOpTag IndexByteArrayOp_Word8AsWord = 356-primOpTag IndexByteArrayOp_Word8AsAddr = 357-primOpTag IndexByteArrayOp_Word8AsFloat = 358-primOpTag IndexByteArrayOp_Word8AsDouble = 359-primOpTag IndexByteArrayOp_Word8AsStablePtr = 360-primOpTag IndexByteArrayOp_Word8AsInt16 = 361-primOpTag IndexByteArrayOp_Word8AsInt32 = 362-primOpTag IndexByteArrayOp_Word8AsInt64 = 363-primOpTag IndexByteArrayOp_Word8AsWord16 = 364-primOpTag IndexByteArrayOp_Word8AsWord32 = 365-primOpTag IndexByteArrayOp_Word8AsWord64 = 366-primOpTag ReadByteArrayOp_Char = 367-primOpTag ReadByteArrayOp_WideChar = 368-primOpTag ReadByteArrayOp_Int = 369-primOpTag ReadByteArrayOp_Word = 370-primOpTag ReadByteArrayOp_Addr = 371-primOpTag ReadByteArrayOp_Float = 372-primOpTag ReadByteArrayOp_Double = 373-primOpTag ReadByteArrayOp_StablePtr = 374-primOpTag ReadByteArrayOp_Int8 = 375-primOpTag ReadByteArrayOp_Int16 = 376-primOpTag ReadByteArrayOp_Int32 = 377-primOpTag ReadByteArrayOp_Int64 = 378-primOpTag ReadByteArrayOp_Word8 = 379-primOpTag ReadByteArrayOp_Word16 = 380-primOpTag ReadByteArrayOp_Word32 = 381-primOpTag ReadByteArrayOp_Word64 = 382-primOpTag ReadByteArrayOp_Word8AsChar = 383-primOpTag ReadByteArrayOp_Word8AsWideChar = 384-primOpTag ReadByteArrayOp_Word8AsInt = 385-primOpTag ReadByteArrayOp_Word8AsWord = 386-primOpTag ReadByteArrayOp_Word8AsAddr = 387-primOpTag ReadByteArrayOp_Word8AsFloat = 388-primOpTag ReadByteArrayOp_Word8AsDouble = 389-primOpTag ReadByteArrayOp_Word8AsStablePtr = 390-primOpTag ReadByteArrayOp_Word8AsInt16 = 391-primOpTag ReadByteArrayOp_Word8AsInt32 = 392-primOpTag ReadByteArrayOp_Word8AsInt64 = 393-primOpTag ReadByteArrayOp_Word8AsWord16 = 394-primOpTag ReadByteArrayOp_Word8AsWord32 = 395-primOpTag ReadByteArrayOp_Word8AsWord64 = 396-primOpTag WriteByteArrayOp_Char = 397-primOpTag WriteByteArrayOp_WideChar = 398-primOpTag WriteByteArrayOp_Int = 399-primOpTag WriteByteArrayOp_Word = 400-primOpTag WriteByteArrayOp_Addr = 401-primOpTag WriteByteArrayOp_Float = 402-primOpTag WriteByteArrayOp_Double = 403-primOpTag WriteByteArrayOp_StablePtr = 404-primOpTag WriteByteArrayOp_Int8 = 405-primOpTag WriteByteArrayOp_Int16 = 406-primOpTag WriteByteArrayOp_Int32 = 407-primOpTag WriteByteArrayOp_Int64 = 408-primOpTag WriteByteArrayOp_Word8 = 409-primOpTag WriteByteArrayOp_Word16 = 410-primOpTag WriteByteArrayOp_Word32 = 411-primOpTag WriteByteArrayOp_Word64 = 412-primOpTag WriteByteArrayOp_Word8AsChar = 413-primOpTag WriteByteArrayOp_Word8AsWideChar = 414-primOpTag WriteByteArrayOp_Word8AsInt = 415-primOpTag WriteByteArrayOp_Word8AsWord = 416-primOpTag WriteByteArrayOp_Word8AsAddr = 417-primOpTag WriteByteArrayOp_Word8AsFloat = 418-primOpTag WriteByteArrayOp_Word8AsDouble = 419-primOpTag WriteByteArrayOp_Word8AsStablePtr = 420-primOpTag WriteByteArrayOp_Word8AsInt16 = 421-primOpTag WriteByteArrayOp_Word8AsInt32 = 422-primOpTag WriteByteArrayOp_Word8AsInt64 = 423-primOpTag WriteByteArrayOp_Word8AsWord16 = 424-primOpTag WriteByteArrayOp_Word8AsWord32 = 425-primOpTag WriteByteArrayOp_Word8AsWord64 = 426-primOpTag CompareByteArraysOp = 427-primOpTag CopyByteArrayOp = 428-primOpTag CopyMutableByteArrayOp = 429-primOpTag CopyByteArrayToAddrOp = 430-primOpTag CopyMutableByteArrayToAddrOp = 431-primOpTag CopyAddrToByteArrayOp = 432-primOpTag SetByteArrayOp = 433-primOpTag AtomicReadByteArrayOp_Int = 434-primOpTag AtomicWriteByteArrayOp_Int = 435-primOpTag CasByteArrayOp_Int = 436-primOpTag FetchAddByteArrayOp_Int = 437-primOpTag FetchSubByteArrayOp_Int = 438-primOpTag FetchAndByteArrayOp_Int = 439-primOpTag FetchNandByteArrayOp_Int = 440-primOpTag FetchOrByteArrayOp_Int = 441-primOpTag FetchXorByteArrayOp_Int = 442-primOpTag NewArrayArrayOp = 443-primOpTag SameMutableArrayArrayOp = 444-primOpTag UnsafeFreezeArrayArrayOp = 445-primOpTag SizeofArrayArrayOp = 446-primOpTag SizeofMutableArrayArrayOp = 447-primOpTag IndexArrayArrayOp_ByteArray = 448-primOpTag IndexArrayArrayOp_ArrayArray = 449-primOpTag ReadArrayArrayOp_ByteArray = 450-primOpTag ReadArrayArrayOp_MutableByteArray = 451-primOpTag ReadArrayArrayOp_ArrayArray = 452-primOpTag ReadArrayArrayOp_MutableArrayArray = 453-primOpTag WriteArrayArrayOp_ByteArray = 454-primOpTag WriteArrayArrayOp_MutableByteArray = 455-primOpTag WriteArrayArrayOp_ArrayArray = 456-primOpTag WriteArrayArrayOp_MutableArrayArray = 457-primOpTag CopyArrayArrayOp = 458-primOpTag CopyMutableArrayArrayOp = 459-primOpTag AddrAddOp = 460-primOpTag AddrSubOp = 461-primOpTag AddrRemOp = 462-primOpTag AddrToIntOp = 463-primOpTag IntToAddrOp = 464-primOpTag AddrGtOp = 465-primOpTag AddrGeOp = 466-primOpTag AddrEqOp = 467-primOpTag AddrNeOp = 468-primOpTag AddrLtOp = 469-primOpTag AddrLeOp = 470-primOpTag IndexOffAddrOp_Char = 471-primOpTag IndexOffAddrOp_WideChar = 472-primOpTag IndexOffAddrOp_Int = 473-primOpTag IndexOffAddrOp_Word = 474-primOpTag IndexOffAddrOp_Addr = 475-primOpTag IndexOffAddrOp_Float = 476-primOpTag IndexOffAddrOp_Double = 477-primOpTag IndexOffAddrOp_StablePtr = 478-primOpTag IndexOffAddrOp_Int8 = 479-primOpTag IndexOffAddrOp_Int16 = 480-primOpTag IndexOffAddrOp_Int32 = 481-primOpTag IndexOffAddrOp_Int64 = 482-primOpTag IndexOffAddrOp_Word8 = 483-primOpTag IndexOffAddrOp_Word16 = 484-primOpTag IndexOffAddrOp_Word32 = 485-primOpTag IndexOffAddrOp_Word64 = 486-primOpTag ReadOffAddrOp_Char = 487-primOpTag ReadOffAddrOp_WideChar = 488-primOpTag ReadOffAddrOp_Int = 489-primOpTag ReadOffAddrOp_Word = 490-primOpTag ReadOffAddrOp_Addr = 491-primOpTag ReadOffAddrOp_Float = 492-primOpTag ReadOffAddrOp_Double = 493-primOpTag ReadOffAddrOp_StablePtr = 494-primOpTag ReadOffAddrOp_Int8 = 495-primOpTag ReadOffAddrOp_Int16 = 496-primOpTag ReadOffAddrOp_Int32 = 497-primOpTag ReadOffAddrOp_Int64 = 498-primOpTag ReadOffAddrOp_Word8 = 499-primOpTag ReadOffAddrOp_Word16 = 500-primOpTag ReadOffAddrOp_Word32 = 501-primOpTag ReadOffAddrOp_Word64 = 502-primOpTag WriteOffAddrOp_Char = 503-primOpTag WriteOffAddrOp_WideChar = 504-primOpTag WriteOffAddrOp_Int = 505-primOpTag WriteOffAddrOp_Word = 506-primOpTag WriteOffAddrOp_Addr = 507-primOpTag WriteOffAddrOp_Float = 508-primOpTag WriteOffAddrOp_Double = 509-primOpTag WriteOffAddrOp_StablePtr = 510-primOpTag WriteOffAddrOp_Int8 = 511-primOpTag WriteOffAddrOp_Int16 = 512-primOpTag WriteOffAddrOp_Int32 = 513-primOpTag WriteOffAddrOp_Int64 = 514-primOpTag WriteOffAddrOp_Word8 = 515-primOpTag WriteOffAddrOp_Word16 = 516-primOpTag WriteOffAddrOp_Word32 = 517-primOpTag WriteOffAddrOp_Word64 = 518-primOpTag InterlockedExchange_Addr = 519-primOpTag InterlockedExchange_Word = 520-primOpTag CasAddrOp_Addr = 521-primOpTag CasAddrOp_Word = 522-primOpTag FetchAddAddrOp_Word = 523-primOpTag FetchSubAddrOp_Word = 524-primOpTag FetchAndAddrOp_Word = 525-primOpTag FetchNandAddrOp_Word = 526-primOpTag FetchOrAddrOp_Word = 527-primOpTag FetchXorAddrOp_Word = 528-primOpTag AtomicReadAddrOp_Word = 529-primOpTag AtomicWriteAddrOp_Word = 530-primOpTag NewMutVarOp = 531-primOpTag ReadMutVarOp = 532-primOpTag WriteMutVarOp = 533-primOpTag SameMutVarOp = 534-primOpTag AtomicModifyMutVar2Op = 535-primOpTag AtomicModifyMutVar_Op = 536-primOpTag CasMutVarOp = 537-primOpTag CatchOp = 538-primOpTag RaiseOp = 539-primOpTag RaiseIOOp = 540-primOpTag MaskAsyncExceptionsOp = 541-primOpTag MaskUninterruptibleOp = 542-primOpTag UnmaskAsyncExceptionsOp = 543-primOpTag MaskStatus = 544-primOpTag AtomicallyOp = 545-primOpTag RetryOp = 546-primOpTag CatchRetryOp = 547-primOpTag CatchSTMOp = 548-primOpTag NewTVarOp = 549-primOpTag ReadTVarOp = 550-primOpTag ReadTVarIOOp = 551-primOpTag WriteTVarOp = 552-primOpTag SameTVarOp = 553-primOpTag NewMVarOp = 554-primOpTag TakeMVarOp = 555-primOpTag TryTakeMVarOp = 556-primOpTag PutMVarOp = 557-primOpTag TryPutMVarOp = 558-primOpTag ReadMVarOp = 559-primOpTag TryReadMVarOp = 560-primOpTag SameMVarOp = 561-primOpTag IsEmptyMVarOp = 562-primOpTag NewIOPortrOp = 563-primOpTag ReadIOPortOp = 564-primOpTag WriteIOPortOp = 565-primOpTag SameIOPortOp = 566-primOpTag DelayOp = 567-primOpTag WaitReadOp = 568-primOpTag WaitWriteOp = 569-primOpTag ForkOp = 570-primOpTag ForkOnOp = 571-primOpTag KillThreadOp = 572-primOpTag YieldOp = 573-primOpTag MyThreadIdOp = 574-primOpTag LabelThreadOp = 575-primOpTag IsCurrentThreadBoundOp = 576-primOpTag NoDuplicateOp = 577-primOpTag ThreadStatusOp = 578-primOpTag MkWeakOp = 579-primOpTag MkWeakNoFinalizerOp = 580-primOpTag AddCFinalizerToWeakOp = 581-primOpTag DeRefWeakOp = 582-primOpTag FinalizeWeakOp = 583-primOpTag TouchOp = 584-primOpTag MakeStablePtrOp = 585-primOpTag DeRefStablePtrOp = 586-primOpTag EqStablePtrOp = 587-primOpTag MakeStableNameOp = 588-primOpTag EqStableNameOp = 589-primOpTag StableNameToIntOp = 590-primOpTag CompactNewOp = 591-primOpTag CompactResizeOp = 592-primOpTag CompactContainsOp = 593-primOpTag CompactContainsAnyOp = 594-primOpTag CompactGetFirstBlockOp = 595-primOpTag CompactGetNextBlockOp = 596-primOpTag CompactAllocateBlockOp = 597-primOpTag CompactFixupPointersOp = 598-primOpTag CompactAdd = 599-primOpTag CompactAddWithSharing = 600-primOpTag CompactSize = 601-primOpTag ReallyUnsafePtrEqualityOp = 602-primOpTag ParOp = 603-primOpTag SparkOp = 604-primOpTag SeqOp = 605-primOpTag GetSparkOp = 606-primOpTag NumSparks = 607-primOpTag KeepAliveOp = 608-primOpTag DataToTagOp = 609-primOpTag TagToEnumOp = 610-primOpTag AddrToAnyOp = 611-primOpTag AnyToAddrOp = 612-primOpTag MkApUpd0_Op = 613-primOpTag NewBCOOp = 614-primOpTag UnpackClosureOp = 615-primOpTag ClosureSizeOp = 616-primOpTag GetApStackValOp = 617-primOpTag GetCCSOfOp = 618-primOpTag GetCurrentCCSOp = 619-primOpTag ClearCCSOp = 620-primOpTag WhereFromOp = 621-primOpTag TraceEventOp = 622-primOpTag TraceEventBinaryOp = 623-primOpTag TraceMarkerOp = 624-primOpTag SetThreadAllocationCounter = 625-primOpTag (VecBroadcastOp IntVec 16 W8) = 626-primOpTag (VecBroadcastOp IntVec 8 W16) = 627-primOpTag (VecBroadcastOp IntVec 4 W32) = 628-primOpTag (VecBroadcastOp IntVec 2 W64) = 629-primOpTag (VecBroadcastOp IntVec 32 W8) = 630-primOpTag (VecBroadcastOp IntVec 16 W16) = 631-primOpTag (VecBroadcastOp IntVec 8 W32) = 632-primOpTag (VecBroadcastOp IntVec 4 W64) = 633-primOpTag (VecBroadcastOp IntVec 64 W8) = 634-primOpTag (VecBroadcastOp IntVec 32 W16) = 635-primOpTag (VecBroadcastOp IntVec 16 W32) = 636-primOpTag (VecBroadcastOp IntVec 8 W64) = 637-primOpTag (VecBroadcastOp WordVec 16 W8) = 638-primOpTag (VecBroadcastOp WordVec 8 W16) = 639-primOpTag (VecBroadcastOp WordVec 4 W32) = 640-primOpTag (VecBroadcastOp WordVec 2 W64) = 641-primOpTag (VecBroadcastOp WordVec 32 W8) = 642-primOpTag (VecBroadcastOp WordVec 16 W16) = 643-primOpTag (VecBroadcastOp WordVec 8 W32) = 644-primOpTag (VecBroadcastOp WordVec 4 W64) = 645-primOpTag (VecBroadcastOp WordVec 64 W8) = 646-primOpTag (VecBroadcastOp WordVec 32 W16) = 647-primOpTag (VecBroadcastOp WordVec 16 W32) = 648-primOpTag (VecBroadcastOp WordVec 8 W64) = 649-primOpTag (VecBroadcastOp FloatVec 4 W32) = 650-primOpTag (VecBroadcastOp FloatVec 2 W64) = 651-primOpTag (VecBroadcastOp FloatVec 8 W32) = 652-primOpTag (VecBroadcastOp FloatVec 4 W64) = 653-primOpTag (VecBroadcastOp FloatVec 16 W32) = 654-primOpTag (VecBroadcastOp FloatVec 8 W64) = 655-primOpTag (VecPackOp IntVec 16 W8) = 656-primOpTag (VecPackOp IntVec 8 W16) = 657-primOpTag (VecPackOp IntVec 4 W32) = 658-primOpTag (VecPackOp IntVec 2 W64) = 659-primOpTag (VecPackOp IntVec 32 W8) = 660-primOpTag (VecPackOp IntVec 16 W16) = 661-primOpTag (VecPackOp IntVec 8 W32) = 662-primOpTag (VecPackOp IntVec 4 W64) = 663-primOpTag (VecPackOp IntVec 64 W8) = 664-primOpTag (VecPackOp IntVec 32 W16) = 665-primOpTag (VecPackOp IntVec 16 W32) = 666-primOpTag (VecPackOp IntVec 8 W64) = 667-primOpTag (VecPackOp WordVec 16 W8) = 668-primOpTag (VecPackOp WordVec 8 W16) = 669-primOpTag (VecPackOp WordVec 4 W32) = 670-primOpTag (VecPackOp WordVec 2 W64) = 671-primOpTag (VecPackOp WordVec 32 W8) = 672-primOpTag (VecPackOp WordVec 16 W16) = 673-primOpTag (VecPackOp WordVec 8 W32) = 674-primOpTag (VecPackOp WordVec 4 W64) = 675-primOpTag (VecPackOp WordVec 64 W8) = 676-primOpTag (VecPackOp WordVec 32 W16) = 677-primOpTag (VecPackOp WordVec 16 W32) = 678-primOpTag (VecPackOp WordVec 8 W64) = 679-primOpTag (VecPackOp FloatVec 4 W32) = 680-primOpTag (VecPackOp FloatVec 2 W64) = 681-primOpTag (VecPackOp FloatVec 8 W32) = 682-primOpTag (VecPackOp FloatVec 4 W64) = 683-primOpTag (VecPackOp FloatVec 16 W32) = 684-primOpTag (VecPackOp FloatVec 8 W64) = 685-primOpTag (VecUnpackOp IntVec 16 W8) = 686-primOpTag (VecUnpackOp IntVec 8 W16) = 687-primOpTag (VecUnpackOp IntVec 4 W32) = 688-primOpTag (VecUnpackOp IntVec 2 W64) = 689-primOpTag (VecUnpackOp IntVec 32 W8) = 690-primOpTag (VecUnpackOp IntVec 16 W16) = 691-primOpTag (VecUnpackOp IntVec 8 W32) = 692-primOpTag (VecUnpackOp IntVec 4 W64) = 693-primOpTag (VecUnpackOp IntVec 64 W8) = 694-primOpTag (VecUnpackOp IntVec 32 W16) = 695-primOpTag (VecUnpackOp IntVec 16 W32) = 696-primOpTag (VecUnpackOp IntVec 8 W64) = 697-primOpTag (VecUnpackOp WordVec 16 W8) = 698-primOpTag (VecUnpackOp WordVec 8 W16) = 699-primOpTag (VecUnpackOp WordVec 4 W32) = 700-primOpTag (VecUnpackOp WordVec 2 W64) = 701-primOpTag (VecUnpackOp WordVec 32 W8) = 702-primOpTag (VecUnpackOp WordVec 16 W16) = 703-primOpTag (VecUnpackOp WordVec 8 W32) = 704-primOpTag (VecUnpackOp WordVec 4 W64) = 705-primOpTag (VecUnpackOp WordVec 64 W8) = 706-primOpTag (VecUnpackOp WordVec 32 W16) = 707-primOpTag (VecUnpackOp WordVec 16 W32) = 708-primOpTag (VecUnpackOp WordVec 8 W64) = 709-primOpTag (VecUnpackOp FloatVec 4 W32) = 710-primOpTag (VecUnpackOp FloatVec 2 W64) = 711-primOpTag (VecUnpackOp FloatVec 8 W32) = 712-primOpTag (VecUnpackOp FloatVec 4 W64) = 713-primOpTag (VecUnpackOp FloatVec 16 W32) = 714-primOpTag (VecUnpackOp FloatVec 8 W64) = 715-primOpTag (VecInsertOp IntVec 16 W8) = 716-primOpTag (VecInsertOp IntVec 8 W16) = 717-primOpTag (VecInsertOp IntVec 4 W32) = 718-primOpTag (VecInsertOp IntVec 2 W64) = 719-primOpTag (VecInsertOp IntVec 32 W8) = 720-primOpTag (VecInsertOp IntVec 16 W16) = 721-primOpTag (VecInsertOp IntVec 8 W32) = 722-primOpTag (VecInsertOp IntVec 4 W64) = 723-primOpTag (VecInsertOp IntVec 64 W8) = 724-primOpTag (VecInsertOp IntVec 32 W16) = 725-primOpTag (VecInsertOp IntVec 16 W32) = 726-primOpTag (VecInsertOp IntVec 8 W64) = 727-primOpTag (VecInsertOp WordVec 16 W8) = 728-primOpTag (VecInsertOp WordVec 8 W16) = 729-primOpTag (VecInsertOp WordVec 4 W32) = 730-primOpTag (VecInsertOp WordVec 2 W64) = 731-primOpTag (VecInsertOp WordVec 32 W8) = 732-primOpTag (VecInsertOp WordVec 16 W16) = 733-primOpTag (VecInsertOp WordVec 8 W32) = 734-primOpTag (VecInsertOp WordVec 4 W64) = 735-primOpTag (VecInsertOp WordVec 64 W8) = 736-primOpTag (VecInsertOp WordVec 32 W16) = 737-primOpTag (VecInsertOp WordVec 16 W32) = 738-primOpTag (VecInsertOp WordVec 8 W64) = 739-primOpTag (VecInsertOp FloatVec 4 W32) = 740-primOpTag (VecInsertOp FloatVec 2 W64) = 741-primOpTag (VecInsertOp FloatVec 8 W32) = 742-primOpTag (VecInsertOp FloatVec 4 W64) = 743-primOpTag (VecInsertOp FloatVec 16 W32) = 744-primOpTag (VecInsertOp FloatVec 8 W64) = 745-primOpTag (VecAddOp IntVec 16 W8) = 746-primOpTag (VecAddOp IntVec 8 W16) = 747-primOpTag (VecAddOp IntVec 4 W32) = 748-primOpTag (VecAddOp IntVec 2 W64) = 749-primOpTag (VecAddOp IntVec 32 W8) = 750-primOpTag (VecAddOp IntVec 16 W16) = 751-primOpTag (VecAddOp IntVec 8 W32) = 752-primOpTag (VecAddOp IntVec 4 W64) = 753-primOpTag (VecAddOp IntVec 64 W8) = 754-primOpTag (VecAddOp IntVec 32 W16) = 755-primOpTag (VecAddOp IntVec 16 W32) = 756-primOpTag (VecAddOp IntVec 8 W64) = 757-primOpTag (VecAddOp WordVec 16 W8) = 758-primOpTag (VecAddOp WordVec 8 W16) = 759-primOpTag (VecAddOp WordVec 4 W32) = 760-primOpTag (VecAddOp WordVec 2 W64) = 761-primOpTag (VecAddOp WordVec 32 W8) = 762-primOpTag (VecAddOp WordVec 16 W16) = 763-primOpTag (VecAddOp WordVec 8 W32) = 764-primOpTag (VecAddOp WordVec 4 W64) = 765-primOpTag (VecAddOp WordVec 64 W8) = 766-primOpTag (VecAddOp WordVec 32 W16) = 767-primOpTag (VecAddOp WordVec 16 W32) = 768-primOpTag (VecAddOp WordVec 8 W64) = 769-primOpTag (VecAddOp FloatVec 4 W32) = 770-primOpTag (VecAddOp FloatVec 2 W64) = 771-primOpTag (VecAddOp FloatVec 8 W32) = 772-primOpTag (VecAddOp FloatVec 4 W64) = 773-primOpTag (VecAddOp FloatVec 16 W32) = 774-primOpTag (VecAddOp FloatVec 8 W64) = 775-primOpTag (VecSubOp IntVec 16 W8) = 776-primOpTag (VecSubOp IntVec 8 W16) = 777-primOpTag (VecSubOp IntVec 4 W32) = 778-primOpTag (VecSubOp IntVec 2 W64) = 779-primOpTag (VecSubOp IntVec 32 W8) = 780-primOpTag (VecSubOp IntVec 16 W16) = 781-primOpTag (VecSubOp IntVec 8 W32) = 782-primOpTag (VecSubOp IntVec 4 W64) = 783-primOpTag (VecSubOp IntVec 64 W8) = 784-primOpTag (VecSubOp IntVec 32 W16) = 785-primOpTag (VecSubOp IntVec 16 W32) = 786-primOpTag (VecSubOp IntVec 8 W64) = 787-primOpTag (VecSubOp WordVec 16 W8) = 788-primOpTag (VecSubOp WordVec 8 W16) = 789-primOpTag (VecSubOp WordVec 4 W32) = 790-primOpTag (VecSubOp WordVec 2 W64) = 791-primOpTag (VecSubOp WordVec 32 W8) = 792-primOpTag (VecSubOp WordVec 16 W16) = 793-primOpTag (VecSubOp WordVec 8 W32) = 794-primOpTag (VecSubOp WordVec 4 W64) = 795-primOpTag (VecSubOp WordVec 64 W8) = 796-primOpTag (VecSubOp WordVec 32 W16) = 797-primOpTag (VecSubOp WordVec 16 W32) = 798-primOpTag (VecSubOp WordVec 8 W64) = 799-primOpTag (VecSubOp FloatVec 4 W32) = 800-primOpTag (VecSubOp FloatVec 2 W64) = 801-primOpTag (VecSubOp FloatVec 8 W32) = 802-primOpTag (VecSubOp FloatVec 4 W64) = 803-primOpTag (VecSubOp FloatVec 16 W32) = 804-primOpTag (VecSubOp FloatVec 8 W64) = 805-primOpTag (VecMulOp IntVec 16 W8) = 806-primOpTag (VecMulOp IntVec 8 W16) = 807-primOpTag (VecMulOp IntVec 4 W32) = 808-primOpTag (VecMulOp IntVec 2 W64) = 809-primOpTag (VecMulOp IntVec 32 W8) = 810-primOpTag (VecMulOp IntVec 16 W16) = 811-primOpTag (VecMulOp IntVec 8 W32) = 812-primOpTag (VecMulOp IntVec 4 W64) = 813-primOpTag (VecMulOp IntVec 64 W8) = 814-primOpTag (VecMulOp IntVec 32 W16) = 815-primOpTag (VecMulOp IntVec 16 W32) = 816-primOpTag (VecMulOp IntVec 8 W64) = 817-primOpTag (VecMulOp WordVec 16 W8) = 818-primOpTag (VecMulOp WordVec 8 W16) = 819-primOpTag (VecMulOp WordVec 4 W32) = 820-primOpTag (VecMulOp WordVec 2 W64) = 821-primOpTag (VecMulOp WordVec 32 W8) = 822-primOpTag (VecMulOp WordVec 16 W16) = 823-primOpTag (VecMulOp WordVec 8 W32) = 824-primOpTag (VecMulOp WordVec 4 W64) = 825-primOpTag (VecMulOp WordVec 64 W8) = 826-primOpTag (VecMulOp WordVec 32 W16) = 827-primOpTag (VecMulOp WordVec 16 W32) = 828-primOpTag (VecMulOp WordVec 8 W64) = 829-primOpTag (VecMulOp FloatVec 4 W32) = 830-primOpTag (VecMulOp FloatVec 2 W64) = 831-primOpTag (VecMulOp FloatVec 8 W32) = 832-primOpTag (VecMulOp FloatVec 4 W64) = 833-primOpTag (VecMulOp FloatVec 16 W32) = 834-primOpTag (VecMulOp FloatVec 8 W64) = 835-primOpTag (VecDivOp FloatVec 4 W32) = 836-primOpTag (VecDivOp FloatVec 2 W64) = 837-primOpTag (VecDivOp FloatVec 8 W32) = 838-primOpTag (VecDivOp FloatVec 4 W64) = 839-primOpTag (VecDivOp FloatVec 16 W32) = 840-primOpTag (VecDivOp FloatVec 8 W64) = 841-primOpTag (VecQuotOp IntVec 16 W8) = 842-primOpTag (VecQuotOp IntVec 8 W16) = 843-primOpTag (VecQuotOp IntVec 4 W32) = 844-primOpTag (VecQuotOp IntVec 2 W64) = 845-primOpTag (VecQuotOp IntVec 32 W8) = 846-primOpTag (VecQuotOp IntVec 16 W16) = 847-primOpTag (VecQuotOp IntVec 8 W32) = 848-primOpTag (VecQuotOp IntVec 4 W64) = 849-primOpTag (VecQuotOp IntVec 64 W8) = 850-primOpTag (VecQuotOp IntVec 32 W16) = 851-primOpTag (VecQuotOp IntVec 16 W32) = 852-primOpTag (VecQuotOp IntVec 8 W64) = 853-primOpTag (VecQuotOp WordVec 16 W8) = 854-primOpTag (VecQuotOp WordVec 8 W16) = 855-primOpTag (VecQuotOp WordVec 4 W32) = 856-primOpTag (VecQuotOp WordVec 2 W64) = 857-primOpTag (VecQuotOp WordVec 32 W8) = 858-primOpTag (VecQuotOp WordVec 16 W16) = 859-primOpTag (VecQuotOp WordVec 8 W32) = 860-primOpTag (VecQuotOp WordVec 4 W64) = 861-primOpTag (VecQuotOp WordVec 64 W8) = 862-primOpTag (VecQuotOp WordVec 32 W16) = 863-primOpTag (VecQuotOp WordVec 16 W32) = 864-primOpTag (VecQuotOp WordVec 8 W64) = 865-primOpTag (VecRemOp IntVec 16 W8) = 866-primOpTag (VecRemOp IntVec 8 W16) = 867-primOpTag (VecRemOp IntVec 4 W32) = 868-primOpTag (VecRemOp IntVec 2 W64) = 869-primOpTag (VecRemOp IntVec 32 W8) = 870-primOpTag (VecRemOp IntVec 16 W16) = 871-primOpTag (VecRemOp IntVec 8 W32) = 872-primOpTag (VecRemOp IntVec 4 W64) = 873-primOpTag (VecRemOp IntVec 64 W8) = 874-primOpTag (VecRemOp IntVec 32 W16) = 875-primOpTag (VecRemOp IntVec 16 W32) = 876-primOpTag (VecRemOp IntVec 8 W64) = 877-primOpTag (VecRemOp WordVec 16 W8) = 878-primOpTag (VecRemOp WordVec 8 W16) = 879-primOpTag (VecRemOp WordVec 4 W32) = 880-primOpTag (VecRemOp WordVec 2 W64) = 881-primOpTag (VecRemOp WordVec 32 W8) = 882-primOpTag (VecRemOp WordVec 16 W16) = 883-primOpTag (VecRemOp WordVec 8 W32) = 884-primOpTag (VecRemOp WordVec 4 W64) = 885-primOpTag (VecRemOp WordVec 64 W8) = 886-primOpTag (VecRemOp WordVec 32 W16) = 887-primOpTag (VecRemOp WordVec 16 W32) = 888-primOpTag (VecRemOp WordVec 8 W64) = 889-primOpTag (VecNegOp IntVec 16 W8) = 890-primOpTag (VecNegOp IntVec 8 W16) = 891-primOpTag (VecNegOp IntVec 4 W32) = 892-primOpTag (VecNegOp IntVec 2 W64) = 893-primOpTag (VecNegOp IntVec 32 W8) = 894-primOpTag (VecNegOp IntVec 16 W16) = 895-primOpTag (VecNegOp IntVec 8 W32) = 896-primOpTag (VecNegOp IntVec 4 W64) = 897-primOpTag (VecNegOp IntVec 64 W8) = 898-primOpTag (VecNegOp IntVec 32 W16) = 899-primOpTag (VecNegOp IntVec 16 W32) = 900-primOpTag (VecNegOp IntVec 8 W64) = 901-primOpTag (VecNegOp FloatVec 4 W32) = 902-primOpTag (VecNegOp FloatVec 2 W64) = 903-primOpTag (VecNegOp FloatVec 8 W32) = 904-primOpTag (VecNegOp FloatVec 4 W64) = 905-primOpTag (VecNegOp FloatVec 16 W32) = 906-primOpTag (VecNegOp FloatVec 8 W64) = 907-primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 908-primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 909-primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 910-primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 911-primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 912-primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 913-primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 914-primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 915-primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 916-primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 917-primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 918-primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 919-primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 920-primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 921-primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 922-primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 923-primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 924-primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 925-primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 926-primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 927-primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 928-primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 929-primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 930-primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 931-primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 932-primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 933-primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 934-primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 935-primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 936-primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 937-primOpTag (VecReadByteArrayOp IntVec 16 W8) = 938-primOpTag (VecReadByteArrayOp IntVec 8 W16) = 939-primOpTag (VecReadByteArrayOp IntVec 4 W32) = 940-primOpTag (VecReadByteArrayOp IntVec 2 W64) = 941-primOpTag (VecReadByteArrayOp IntVec 32 W8) = 942-primOpTag (VecReadByteArrayOp IntVec 16 W16) = 943-primOpTag (VecReadByteArrayOp IntVec 8 W32) = 944-primOpTag (VecReadByteArrayOp IntVec 4 W64) = 945-primOpTag (VecReadByteArrayOp IntVec 64 W8) = 946-primOpTag (VecReadByteArrayOp IntVec 32 W16) = 947-primOpTag (VecReadByteArrayOp IntVec 16 W32) = 948-primOpTag (VecReadByteArrayOp IntVec 8 W64) = 949-primOpTag (VecReadByteArrayOp WordVec 16 W8) = 950-primOpTag (VecReadByteArrayOp WordVec 8 W16) = 951-primOpTag (VecReadByteArrayOp WordVec 4 W32) = 952-primOpTag (VecReadByteArrayOp WordVec 2 W64) = 953-primOpTag (VecReadByteArrayOp WordVec 32 W8) = 954-primOpTag (VecReadByteArrayOp WordVec 16 W16) = 955-primOpTag (VecReadByteArrayOp WordVec 8 W32) = 956-primOpTag (VecReadByteArrayOp WordVec 4 W64) = 957-primOpTag (VecReadByteArrayOp WordVec 64 W8) = 958-primOpTag (VecReadByteArrayOp WordVec 32 W16) = 959-primOpTag (VecReadByteArrayOp WordVec 16 W32) = 960-primOpTag (VecReadByteArrayOp WordVec 8 W64) = 961-primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 962-primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 963-primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 964-primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 965-primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 966-primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 967-primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 968-primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 969-primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 970-primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 971-primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 972-primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 973-primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 974-primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 975-primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 976-primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 977-primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 978-primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 979-primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 980-primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 981-primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 982-primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 983-primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 984-primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 985-primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 986-primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 987-primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 988-primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 989-primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 990-primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 991-primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 992-primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 993-primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 994-primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 995-primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 996-primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 997-primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 998-primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 999-primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1000-primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1001-primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1002-primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1003-primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1004-primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1005-primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1006-primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1007-primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1008-primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1009-primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1010-primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1011-primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1012-primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1013-primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1014-primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1015-primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1016-primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1017-primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1018-primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1019-primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1020-primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1021-primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1022-primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1023-primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1024-primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1025-primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1026-primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1027-primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1028-primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1029-primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1030-primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1031-primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1032-primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1033-primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1034-primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1035-primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1036-primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1037-primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1038-primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1039-primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1040-primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1041-primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1042-primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1043-primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1044-primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1045-primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1046-primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1047-primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1048-primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1049-primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1050-primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1051-primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1052-primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1053-primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1054-primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1055-primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1056-primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1057-primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1058-primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1059-primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1060-primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1061-primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1062-primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1063-primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1064-primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1065-primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1066-primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1067-primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1068-primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1069-primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1070-primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1071-primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1072-primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1073-primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1074-primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1075-primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1076-primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1077-primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1078-primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1079-primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1080-primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1081-primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1082-primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1083-primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1084-primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1085-primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1086-primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1087-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1088-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1089-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1090-primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1091-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1092-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1093-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1094-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1095-primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1096-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1097-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1098-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1099-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1100-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1101-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1102-primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1103-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1104-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1105-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1106-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1107-primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1108-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1109-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1110-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1111-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1112-primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1113-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1114-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1115-primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1116-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1117-primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1118-primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1119-primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1120-primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1121-primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1122-primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1123-primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1124-primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1125-primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1126-primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1127-primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1128-primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1129-primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1130-primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1131-primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1132-primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1133-primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1134-primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1135-primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1136-primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1137-primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1138-primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1139-primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1140-primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1141-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1142-primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1143-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1144-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1145-primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1146-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1147-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1148-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1149-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1150-primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1151-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1152-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1153-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1154-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1155-primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1156-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1157-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1158-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1159-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1160-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1161-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1162-primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1163-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1164-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1165-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1166-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1167-primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1168-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1169-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1170-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1171-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1172-primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1173-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1174-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1175-primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1176-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1177-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1178-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1179-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1180-primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1181-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1182-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1183-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1184-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1185-primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1186-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1187-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1188-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1189-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1190-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1191-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1192-primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1193-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1194-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1195-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1196-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1197-primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1198-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1199-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1200-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1201-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1202-primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1203-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1204-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1205-primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1206-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1207-primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1208-primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1209-primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1210-primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1211-primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1212-primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1213-primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1214-primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1215-primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1216-primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1217-primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1218-primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1219-primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1220-primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1221-primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1222-primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1223-primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1224-primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1225-primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1226-primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1227-primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1228-primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1229-primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1230-primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1231-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1232-primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1233-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1234-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1235-primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1236-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1237-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1238-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1239-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1240-primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1241-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1242-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1243-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1244-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1245-primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1246-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1247-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1248-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1249-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1250-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1251-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1252-primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1253-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1254-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1255-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1256-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1257-primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1258-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1259-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1260-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1261-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1262-primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1263-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1264-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1265-primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1266-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1267-primOpTag PrefetchByteArrayOp3 = 1268-primOpTag PrefetchMutableByteArrayOp3 = 1269-primOpTag PrefetchAddrOp3 = 1270-primOpTag PrefetchValueOp3 = 1271-primOpTag PrefetchByteArrayOp2 = 1272-primOpTag PrefetchMutableByteArrayOp2 = 1273-primOpTag PrefetchAddrOp2 = 1274-primOpTag PrefetchValueOp2 = 1275-primOpTag PrefetchByteArrayOp1 = 1276-primOpTag PrefetchMutableByteArrayOp1 = 1277-primOpTag PrefetchAddrOp1 = 1278-primOpTag PrefetchValueOp1 = 1279-primOpTag PrefetchByteArrayOp0 = 1280-primOpTag PrefetchMutableByteArrayOp0 = 1281-primOpTag PrefetchAddrOp0 = 1282-primOpTag PrefetchValueOp0 = 1283+maxPrimOpTag = 1274+primOpTag :: PrimOp -> Int+primOpTag CharGtOp = 1+primOpTag CharGeOp = 2+primOpTag CharEqOp = 3+primOpTag CharNeOp = 4+primOpTag CharLtOp = 5+primOpTag CharLeOp = 6+primOpTag OrdOp = 7+primOpTag Int8ToIntOp = 8+primOpTag IntToInt8Op = 9+primOpTag Int8NegOp = 10+primOpTag Int8AddOp = 11+primOpTag Int8SubOp = 12+primOpTag Int8MulOp = 13+primOpTag Int8QuotOp = 14+primOpTag Int8RemOp = 15+primOpTag Int8QuotRemOp = 16+primOpTag Int8SllOp = 17+primOpTag Int8SraOp = 18+primOpTag Int8SrlOp = 19+primOpTag Int8ToWord8Op = 20+primOpTag Int8EqOp = 21+primOpTag Int8GeOp = 22+primOpTag Int8GtOp = 23+primOpTag Int8LeOp = 24+primOpTag Int8LtOp = 25+primOpTag Int8NeOp = 26+primOpTag Word8ToWordOp = 27+primOpTag WordToWord8Op = 28+primOpTag Word8AddOp = 29+primOpTag Word8SubOp = 30+primOpTag Word8MulOp = 31+primOpTag Word8QuotOp = 32+primOpTag Word8RemOp = 33+primOpTag Word8QuotRemOp = 34+primOpTag Word8AndOp = 35+primOpTag Word8OrOp = 36+primOpTag Word8XorOp = 37+primOpTag Word8NotOp = 38+primOpTag Word8SllOp = 39+primOpTag Word8SrlOp = 40+primOpTag Word8ToInt8Op = 41+primOpTag Word8EqOp = 42+primOpTag Word8GeOp = 43+primOpTag Word8GtOp = 44+primOpTag Word8LeOp = 45+primOpTag Word8LtOp = 46+primOpTag Word8NeOp = 47+primOpTag Int16ToIntOp = 48+primOpTag IntToInt16Op = 49+primOpTag Int16NegOp = 50+primOpTag Int16AddOp = 51+primOpTag Int16SubOp = 52+primOpTag Int16MulOp = 53+primOpTag Int16QuotOp = 54+primOpTag Int16RemOp = 55+primOpTag Int16QuotRemOp = 56+primOpTag Int16SllOp = 57+primOpTag Int16SraOp = 58+primOpTag Int16SrlOp = 59+primOpTag Int16ToWord16Op = 60+primOpTag Int16EqOp = 61+primOpTag Int16GeOp = 62+primOpTag Int16GtOp = 63+primOpTag Int16LeOp = 64+primOpTag Int16LtOp = 65+primOpTag Int16NeOp = 66+primOpTag Word16ToWordOp = 67+primOpTag WordToWord16Op = 68+primOpTag Word16AddOp = 69+primOpTag Word16SubOp = 70+primOpTag Word16MulOp = 71+primOpTag Word16QuotOp = 72+primOpTag Word16RemOp = 73+primOpTag Word16QuotRemOp = 74+primOpTag Word16AndOp = 75+primOpTag Word16OrOp = 76+primOpTag Word16XorOp = 77+primOpTag Word16NotOp = 78+primOpTag Word16SllOp = 79+primOpTag Word16SrlOp = 80+primOpTag Word16ToInt16Op = 81+primOpTag Word16EqOp = 82+primOpTag Word16GeOp = 83+primOpTag Word16GtOp = 84+primOpTag Word16LeOp = 85+primOpTag Word16LtOp = 86+primOpTag Word16NeOp = 87+primOpTag Int32ToIntOp = 88+primOpTag IntToInt32Op = 89+primOpTag Int32NegOp = 90+primOpTag Int32AddOp = 91+primOpTag Int32SubOp = 92+primOpTag Int32MulOp = 93+primOpTag Int32QuotOp = 94+primOpTag Int32RemOp = 95+primOpTag Int32QuotRemOp = 96+primOpTag Int32SllOp = 97+primOpTag Int32SraOp = 98+primOpTag Int32SrlOp = 99+primOpTag Int32ToWord32Op = 100+primOpTag Int32EqOp = 101+primOpTag Int32GeOp = 102+primOpTag Int32GtOp = 103+primOpTag Int32LeOp = 104+primOpTag Int32LtOp = 105+primOpTag Int32NeOp = 106+primOpTag Word32ToWordOp = 107+primOpTag WordToWord32Op = 108+primOpTag Word32AddOp = 109+primOpTag Word32SubOp = 110+primOpTag Word32MulOp = 111+primOpTag Word32QuotOp = 112+primOpTag Word32RemOp = 113+primOpTag Word32QuotRemOp = 114+primOpTag Word32AndOp = 115+primOpTag Word32OrOp = 116+primOpTag Word32XorOp = 117+primOpTag Word32NotOp = 118+primOpTag Word32SllOp = 119+primOpTag Word32SrlOp = 120+primOpTag Word32ToInt32Op = 121+primOpTag Word32EqOp = 122+primOpTag Word32GeOp = 123+primOpTag Word32GtOp = 124+primOpTag Word32LeOp = 125+primOpTag Word32LtOp = 126+primOpTag Word32NeOp = 127+primOpTag IntAddOp = 128+primOpTag IntSubOp = 129+primOpTag IntMulOp = 130+primOpTag IntMul2Op = 131+primOpTag IntMulMayOfloOp = 132+primOpTag IntQuotOp = 133+primOpTag IntRemOp = 134+primOpTag IntQuotRemOp = 135+primOpTag IntAndOp = 136+primOpTag IntOrOp = 137+primOpTag IntXorOp = 138+primOpTag IntNotOp = 139+primOpTag IntNegOp = 140+primOpTag IntAddCOp = 141+primOpTag IntSubCOp = 142+primOpTag IntGtOp = 143+primOpTag IntGeOp = 144+primOpTag IntEqOp = 145+primOpTag IntNeOp = 146+primOpTag IntLtOp = 147+primOpTag IntLeOp = 148+primOpTag ChrOp = 149+primOpTag IntToWordOp = 150+primOpTag IntToFloatOp = 151+primOpTag IntToDoubleOp = 152+primOpTag WordToFloatOp = 153+primOpTag WordToDoubleOp = 154+primOpTag IntSllOp = 155+primOpTag IntSraOp = 156+primOpTag IntSrlOp = 157+primOpTag WordAddOp = 158+primOpTag WordAddCOp = 159+primOpTag WordSubCOp = 160+primOpTag WordAdd2Op = 161+primOpTag WordSubOp = 162+primOpTag WordMulOp = 163+primOpTag WordMul2Op = 164+primOpTag WordQuotOp = 165+primOpTag WordRemOp = 166+primOpTag WordQuotRemOp = 167+primOpTag WordQuotRem2Op = 168+primOpTag WordAndOp = 169+primOpTag WordOrOp = 170+primOpTag WordXorOp = 171+primOpTag WordNotOp = 172+primOpTag WordSllOp = 173+primOpTag WordSrlOp = 174+primOpTag WordToIntOp = 175+primOpTag WordGtOp = 176+primOpTag WordGeOp = 177+primOpTag WordEqOp = 178+primOpTag WordNeOp = 179+primOpTag WordLtOp = 180+primOpTag WordLeOp = 181+primOpTag PopCnt8Op = 182+primOpTag PopCnt16Op = 183+primOpTag PopCnt32Op = 184+primOpTag PopCnt64Op = 185+primOpTag PopCntOp = 186+primOpTag Pdep8Op = 187+primOpTag Pdep16Op = 188+primOpTag Pdep32Op = 189+primOpTag Pdep64Op = 190+primOpTag PdepOp = 191+primOpTag Pext8Op = 192+primOpTag Pext16Op = 193+primOpTag Pext32Op = 194+primOpTag Pext64Op = 195+primOpTag PextOp = 196+primOpTag Clz8Op = 197+primOpTag Clz16Op = 198+primOpTag Clz32Op = 199+primOpTag Clz64Op = 200+primOpTag ClzOp = 201+primOpTag Ctz8Op = 202+primOpTag Ctz16Op = 203+primOpTag Ctz32Op = 204+primOpTag Ctz64Op = 205+primOpTag CtzOp = 206+primOpTag BSwap16Op = 207+primOpTag BSwap32Op = 208+primOpTag BSwap64Op = 209+primOpTag BSwapOp = 210+primOpTag BRev8Op = 211+primOpTag BRev16Op = 212+primOpTag BRev32Op = 213+primOpTag BRev64Op = 214+primOpTag BRevOp = 215+primOpTag Narrow8IntOp = 216+primOpTag Narrow16IntOp = 217+primOpTag Narrow32IntOp = 218+primOpTag Narrow8WordOp = 219+primOpTag Narrow16WordOp = 220+primOpTag Narrow32WordOp = 221+primOpTag DoubleGtOp = 222+primOpTag DoubleGeOp = 223+primOpTag DoubleEqOp = 224+primOpTag DoubleNeOp = 225+primOpTag DoubleLtOp = 226+primOpTag DoubleLeOp = 227+primOpTag DoubleAddOp = 228+primOpTag DoubleSubOp = 229+primOpTag DoubleMulOp = 230+primOpTag DoubleDivOp = 231+primOpTag DoubleNegOp = 232+primOpTag DoubleFabsOp = 233+primOpTag DoubleToIntOp = 234+primOpTag DoubleToFloatOp = 235+primOpTag DoubleExpOp = 236+primOpTag DoubleExpM1Op = 237+primOpTag DoubleLogOp = 238+primOpTag DoubleLog1POp = 239+primOpTag DoubleSqrtOp = 240+primOpTag DoubleSinOp = 241+primOpTag DoubleCosOp = 242+primOpTag DoubleTanOp = 243+primOpTag DoubleAsinOp = 244+primOpTag DoubleAcosOp = 245+primOpTag DoubleAtanOp = 246+primOpTag DoubleSinhOp = 247+primOpTag DoubleCoshOp = 248+primOpTag DoubleTanhOp = 249+primOpTag DoubleAsinhOp = 250+primOpTag DoubleAcoshOp = 251+primOpTag DoubleAtanhOp = 252+primOpTag DoublePowerOp = 253+primOpTag DoubleDecode_2IntOp = 254+primOpTag DoubleDecode_Int64Op = 255+primOpTag FloatGtOp = 256+primOpTag FloatGeOp = 257+primOpTag FloatEqOp = 258+primOpTag FloatNeOp = 259+primOpTag FloatLtOp = 260+primOpTag FloatLeOp = 261+primOpTag FloatAddOp = 262+primOpTag FloatSubOp = 263+primOpTag FloatMulOp = 264+primOpTag FloatDivOp = 265+primOpTag FloatNegOp = 266+primOpTag FloatFabsOp = 267+primOpTag FloatToIntOp = 268+primOpTag FloatExpOp = 269+primOpTag FloatExpM1Op = 270+primOpTag FloatLogOp = 271+primOpTag FloatLog1POp = 272+primOpTag FloatSqrtOp = 273+primOpTag FloatSinOp = 274+primOpTag FloatCosOp = 275+primOpTag FloatTanOp = 276+primOpTag FloatAsinOp = 277+primOpTag FloatAcosOp = 278+primOpTag FloatAtanOp = 279+primOpTag FloatSinhOp = 280+primOpTag FloatCoshOp = 281+primOpTag FloatTanhOp = 282+primOpTag FloatAsinhOp = 283+primOpTag FloatAcoshOp = 284+primOpTag FloatAtanhOp = 285+primOpTag FloatPowerOp = 286+primOpTag FloatToDoubleOp = 287+primOpTag FloatDecode_IntOp = 288+primOpTag NewArrayOp = 289+primOpTag ReadArrayOp = 290+primOpTag WriteArrayOp = 291+primOpTag SizeofArrayOp = 292+primOpTag SizeofMutableArrayOp = 293+primOpTag IndexArrayOp = 294+primOpTag UnsafeFreezeArrayOp = 295+primOpTag UnsafeThawArrayOp = 296+primOpTag CopyArrayOp = 297+primOpTag CopyMutableArrayOp = 298+primOpTag CloneArrayOp = 299+primOpTag CloneMutableArrayOp = 300+primOpTag FreezeArrayOp = 301+primOpTag ThawArrayOp = 302+primOpTag CasArrayOp = 303+primOpTag NewSmallArrayOp = 304+primOpTag ShrinkSmallMutableArrayOp_Char = 305+primOpTag ReadSmallArrayOp = 306+primOpTag WriteSmallArrayOp = 307+primOpTag SizeofSmallArrayOp = 308+primOpTag SizeofSmallMutableArrayOp = 309+primOpTag GetSizeofSmallMutableArrayOp = 310+primOpTag IndexSmallArrayOp = 311+primOpTag UnsafeFreezeSmallArrayOp = 312+primOpTag UnsafeThawSmallArrayOp = 313+primOpTag CopySmallArrayOp = 314+primOpTag CopySmallMutableArrayOp = 315+primOpTag CloneSmallArrayOp = 316+primOpTag CloneSmallMutableArrayOp = 317+primOpTag FreezeSmallArrayOp = 318+primOpTag ThawSmallArrayOp = 319+primOpTag CasSmallArrayOp = 320+primOpTag NewByteArrayOp_Char = 321+primOpTag NewPinnedByteArrayOp_Char = 322+primOpTag NewAlignedPinnedByteArrayOp_Char = 323+primOpTag MutableByteArrayIsPinnedOp = 324+primOpTag ByteArrayIsPinnedOp = 325+primOpTag ByteArrayContents_Char = 326+primOpTag MutableByteArrayContents_Char = 327+primOpTag ShrinkMutableByteArrayOp_Char = 328+primOpTag ResizeMutableByteArrayOp_Char = 329+primOpTag UnsafeFreezeByteArrayOp = 330+primOpTag SizeofByteArrayOp = 331+primOpTag SizeofMutableByteArrayOp = 332+primOpTag GetSizeofMutableByteArrayOp = 333+primOpTag IndexByteArrayOp_Char = 334+primOpTag IndexByteArrayOp_WideChar = 335+primOpTag IndexByteArrayOp_Int = 336+primOpTag IndexByteArrayOp_Word = 337+primOpTag IndexByteArrayOp_Addr = 338+primOpTag IndexByteArrayOp_Float = 339+primOpTag IndexByteArrayOp_Double = 340+primOpTag IndexByteArrayOp_StablePtr = 341+primOpTag IndexByteArrayOp_Int8 = 342+primOpTag IndexByteArrayOp_Int16 = 343+primOpTag IndexByteArrayOp_Int32 = 344+primOpTag IndexByteArrayOp_Int64 = 345+primOpTag IndexByteArrayOp_Word8 = 346+primOpTag IndexByteArrayOp_Word16 = 347+primOpTag IndexByteArrayOp_Word32 = 348+primOpTag IndexByteArrayOp_Word64 = 349+primOpTag IndexByteArrayOp_Word8AsChar = 350+primOpTag IndexByteArrayOp_Word8AsWideChar = 351+primOpTag IndexByteArrayOp_Word8AsInt = 352+primOpTag IndexByteArrayOp_Word8AsWord = 353+primOpTag IndexByteArrayOp_Word8AsAddr = 354+primOpTag IndexByteArrayOp_Word8AsFloat = 355+primOpTag IndexByteArrayOp_Word8AsDouble = 356+primOpTag IndexByteArrayOp_Word8AsStablePtr = 357+primOpTag IndexByteArrayOp_Word8AsInt16 = 358+primOpTag IndexByteArrayOp_Word8AsInt32 = 359+primOpTag IndexByteArrayOp_Word8AsInt64 = 360+primOpTag IndexByteArrayOp_Word8AsWord16 = 361+primOpTag IndexByteArrayOp_Word8AsWord32 = 362+primOpTag IndexByteArrayOp_Word8AsWord64 = 363+primOpTag ReadByteArrayOp_Char = 364+primOpTag ReadByteArrayOp_WideChar = 365+primOpTag ReadByteArrayOp_Int = 366+primOpTag ReadByteArrayOp_Word = 367+primOpTag ReadByteArrayOp_Addr = 368+primOpTag ReadByteArrayOp_Float = 369+primOpTag ReadByteArrayOp_Double = 370+primOpTag ReadByteArrayOp_StablePtr = 371+primOpTag ReadByteArrayOp_Int8 = 372+primOpTag ReadByteArrayOp_Int16 = 373+primOpTag ReadByteArrayOp_Int32 = 374+primOpTag ReadByteArrayOp_Int64 = 375+primOpTag ReadByteArrayOp_Word8 = 376+primOpTag ReadByteArrayOp_Word16 = 377+primOpTag ReadByteArrayOp_Word32 = 378+primOpTag ReadByteArrayOp_Word64 = 379+primOpTag ReadByteArrayOp_Word8AsChar = 380+primOpTag ReadByteArrayOp_Word8AsWideChar = 381+primOpTag ReadByteArrayOp_Word8AsInt = 382+primOpTag ReadByteArrayOp_Word8AsWord = 383+primOpTag ReadByteArrayOp_Word8AsAddr = 384+primOpTag ReadByteArrayOp_Word8AsFloat = 385+primOpTag ReadByteArrayOp_Word8AsDouble = 386+primOpTag ReadByteArrayOp_Word8AsStablePtr = 387+primOpTag ReadByteArrayOp_Word8AsInt16 = 388+primOpTag ReadByteArrayOp_Word8AsInt32 = 389+primOpTag ReadByteArrayOp_Word8AsInt64 = 390+primOpTag ReadByteArrayOp_Word8AsWord16 = 391+primOpTag ReadByteArrayOp_Word8AsWord32 = 392+primOpTag ReadByteArrayOp_Word8AsWord64 = 393+primOpTag WriteByteArrayOp_Char = 394+primOpTag WriteByteArrayOp_WideChar = 395+primOpTag WriteByteArrayOp_Int = 396+primOpTag WriteByteArrayOp_Word = 397+primOpTag WriteByteArrayOp_Addr = 398+primOpTag WriteByteArrayOp_Float = 399+primOpTag WriteByteArrayOp_Double = 400+primOpTag WriteByteArrayOp_StablePtr = 401+primOpTag WriteByteArrayOp_Int8 = 402+primOpTag WriteByteArrayOp_Int16 = 403+primOpTag WriteByteArrayOp_Int32 = 404+primOpTag WriteByteArrayOp_Int64 = 405+primOpTag WriteByteArrayOp_Word8 = 406+primOpTag WriteByteArrayOp_Word16 = 407+primOpTag WriteByteArrayOp_Word32 = 408+primOpTag WriteByteArrayOp_Word64 = 409+primOpTag WriteByteArrayOp_Word8AsChar = 410+primOpTag WriteByteArrayOp_Word8AsWideChar = 411+primOpTag WriteByteArrayOp_Word8AsInt = 412+primOpTag WriteByteArrayOp_Word8AsWord = 413+primOpTag WriteByteArrayOp_Word8AsAddr = 414+primOpTag WriteByteArrayOp_Word8AsFloat = 415+primOpTag WriteByteArrayOp_Word8AsDouble = 416+primOpTag WriteByteArrayOp_Word8AsStablePtr = 417+primOpTag WriteByteArrayOp_Word8AsInt16 = 418+primOpTag WriteByteArrayOp_Word8AsInt32 = 419+primOpTag WriteByteArrayOp_Word8AsInt64 = 420+primOpTag WriteByteArrayOp_Word8AsWord16 = 421+primOpTag WriteByteArrayOp_Word8AsWord32 = 422+primOpTag WriteByteArrayOp_Word8AsWord64 = 423+primOpTag CompareByteArraysOp = 424+primOpTag CopyByteArrayOp = 425+primOpTag CopyMutableByteArrayOp = 426+primOpTag CopyByteArrayToAddrOp = 427+primOpTag CopyMutableByteArrayToAddrOp = 428+primOpTag CopyAddrToByteArrayOp = 429+primOpTag SetByteArrayOp = 430+primOpTag AtomicReadByteArrayOp_Int = 431+primOpTag AtomicWriteByteArrayOp_Int = 432+primOpTag CasByteArrayOp_Int = 433+primOpTag FetchAddByteArrayOp_Int = 434+primOpTag FetchSubByteArrayOp_Int = 435+primOpTag FetchAndByteArrayOp_Int = 436+primOpTag FetchNandByteArrayOp_Int = 437+primOpTag FetchOrByteArrayOp_Int = 438+primOpTag FetchXorByteArrayOp_Int = 439+primOpTag NewArrayArrayOp = 440+primOpTag UnsafeFreezeArrayArrayOp = 441+primOpTag SizeofArrayArrayOp = 442+primOpTag SizeofMutableArrayArrayOp = 443+primOpTag IndexArrayArrayOp_ByteArray = 444+primOpTag IndexArrayArrayOp_ArrayArray = 445+primOpTag ReadArrayArrayOp_ByteArray = 446+primOpTag ReadArrayArrayOp_MutableByteArray = 447+primOpTag ReadArrayArrayOp_ArrayArray = 448+primOpTag ReadArrayArrayOp_MutableArrayArray = 449+primOpTag WriteArrayArrayOp_ByteArray = 450+primOpTag WriteArrayArrayOp_MutableByteArray = 451+primOpTag WriteArrayArrayOp_ArrayArray = 452+primOpTag WriteArrayArrayOp_MutableArrayArray = 453+primOpTag CopyArrayArrayOp = 454+primOpTag CopyMutableArrayArrayOp = 455+primOpTag AddrAddOp = 456+primOpTag AddrSubOp = 457+primOpTag AddrRemOp = 458+primOpTag AddrToIntOp = 459+primOpTag IntToAddrOp = 460+primOpTag AddrGtOp = 461+primOpTag AddrGeOp = 462+primOpTag AddrEqOp = 463+primOpTag AddrNeOp = 464+primOpTag AddrLtOp = 465+primOpTag AddrLeOp = 466+primOpTag IndexOffAddrOp_Char = 467+primOpTag IndexOffAddrOp_WideChar = 468+primOpTag IndexOffAddrOp_Int = 469+primOpTag IndexOffAddrOp_Word = 470+primOpTag IndexOffAddrOp_Addr = 471+primOpTag IndexOffAddrOp_Float = 472+primOpTag IndexOffAddrOp_Double = 473+primOpTag IndexOffAddrOp_StablePtr = 474+primOpTag IndexOffAddrOp_Int8 = 475+primOpTag IndexOffAddrOp_Int16 = 476+primOpTag IndexOffAddrOp_Int32 = 477+primOpTag IndexOffAddrOp_Int64 = 478+primOpTag IndexOffAddrOp_Word8 = 479+primOpTag IndexOffAddrOp_Word16 = 480+primOpTag IndexOffAddrOp_Word32 = 481+primOpTag IndexOffAddrOp_Word64 = 482+primOpTag ReadOffAddrOp_Char = 483+primOpTag ReadOffAddrOp_WideChar = 484+primOpTag ReadOffAddrOp_Int = 485+primOpTag ReadOffAddrOp_Word = 486+primOpTag ReadOffAddrOp_Addr = 487+primOpTag ReadOffAddrOp_Float = 488+primOpTag ReadOffAddrOp_Double = 489+primOpTag ReadOffAddrOp_StablePtr = 490+primOpTag ReadOffAddrOp_Int8 = 491+primOpTag ReadOffAddrOp_Int16 = 492+primOpTag ReadOffAddrOp_Int32 = 493+primOpTag ReadOffAddrOp_Int64 = 494+primOpTag ReadOffAddrOp_Word8 = 495+primOpTag ReadOffAddrOp_Word16 = 496+primOpTag ReadOffAddrOp_Word32 = 497+primOpTag ReadOffAddrOp_Word64 = 498+primOpTag WriteOffAddrOp_Char = 499+primOpTag WriteOffAddrOp_WideChar = 500+primOpTag WriteOffAddrOp_Int = 501+primOpTag WriteOffAddrOp_Word = 502+primOpTag WriteOffAddrOp_Addr = 503+primOpTag WriteOffAddrOp_Float = 504+primOpTag WriteOffAddrOp_Double = 505+primOpTag WriteOffAddrOp_StablePtr = 506+primOpTag WriteOffAddrOp_Int8 = 507+primOpTag WriteOffAddrOp_Int16 = 508+primOpTag WriteOffAddrOp_Int32 = 509+primOpTag WriteOffAddrOp_Int64 = 510+primOpTag WriteOffAddrOp_Word8 = 511+primOpTag WriteOffAddrOp_Word16 = 512+primOpTag WriteOffAddrOp_Word32 = 513+primOpTag WriteOffAddrOp_Word64 = 514+primOpTag InterlockedExchange_Addr = 515+primOpTag InterlockedExchange_Word = 516+primOpTag CasAddrOp_Addr = 517+primOpTag CasAddrOp_Word = 518+primOpTag FetchAddAddrOp_Word = 519+primOpTag FetchSubAddrOp_Word = 520+primOpTag FetchAndAddrOp_Word = 521+primOpTag FetchNandAddrOp_Word = 522+primOpTag FetchOrAddrOp_Word = 523+primOpTag FetchXorAddrOp_Word = 524+primOpTag AtomicReadAddrOp_Word = 525+primOpTag AtomicWriteAddrOp_Word = 526+primOpTag NewMutVarOp = 527+primOpTag ReadMutVarOp = 528+primOpTag WriteMutVarOp = 529+primOpTag AtomicModifyMutVar2Op = 530+primOpTag AtomicModifyMutVar_Op = 531+primOpTag CasMutVarOp = 532+primOpTag CatchOp = 533+primOpTag RaiseOp = 534+primOpTag RaiseIOOp = 535+primOpTag MaskAsyncExceptionsOp = 536+primOpTag MaskUninterruptibleOp = 537+primOpTag UnmaskAsyncExceptionsOp = 538+primOpTag MaskStatus = 539+primOpTag AtomicallyOp = 540+primOpTag RetryOp = 541+primOpTag CatchRetryOp = 542+primOpTag CatchSTMOp = 543+primOpTag NewTVarOp = 544+primOpTag ReadTVarOp = 545+primOpTag ReadTVarIOOp = 546+primOpTag WriteTVarOp = 547+primOpTag NewMVarOp = 548+primOpTag TakeMVarOp = 549+primOpTag TryTakeMVarOp = 550+primOpTag PutMVarOp = 551+primOpTag TryPutMVarOp = 552+primOpTag ReadMVarOp = 553+primOpTag TryReadMVarOp = 554+primOpTag IsEmptyMVarOp = 555+primOpTag NewIOPortrOp = 556+primOpTag ReadIOPortOp = 557+primOpTag WriteIOPortOp = 558+primOpTag DelayOp = 559+primOpTag WaitReadOp = 560+primOpTag WaitWriteOp = 561+primOpTag ForkOp = 562+primOpTag ForkOnOp = 563+primOpTag KillThreadOp = 564+primOpTag YieldOp = 565+primOpTag MyThreadIdOp = 566+primOpTag LabelThreadOp = 567+primOpTag IsCurrentThreadBoundOp = 568+primOpTag NoDuplicateOp = 569+primOpTag ThreadStatusOp = 570+primOpTag MkWeakOp = 571+primOpTag MkWeakNoFinalizerOp = 572+primOpTag AddCFinalizerToWeakOp = 573+primOpTag DeRefWeakOp = 574+primOpTag FinalizeWeakOp = 575+primOpTag TouchOp = 576+primOpTag MakeStablePtrOp = 577+primOpTag DeRefStablePtrOp = 578+primOpTag EqStablePtrOp = 579+primOpTag MakeStableNameOp = 580+primOpTag StableNameToIntOp = 581+primOpTag CompactNewOp = 582+primOpTag CompactResizeOp = 583+primOpTag CompactContainsOp = 584+primOpTag CompactContainsAnyOp = 585+primOpTag CompactGetFirstBlockOp = 586+primOpTag CompactGetNextBlockOp = 587+primOpTag CompactAllocateBlockOp = 588+primOpTag CompactFixupPointersOp = 589+primOpTag CompactAdd = 590+primOpTag CompactAddWithSharing = 591+primOpTag CompactSize = 592+primOpTag ReallyUnsafePtrEqualityOp = 593+primOpTag ParOp = 594+primOpTag SparkOp = 595+primOpTag SeqOp = 596+primOpTag GetSparkOp = 597+primOpTag NumSparks = 598+primOpTag KeepAliveOp = 599+primOpTag DataToTagOp = 600+primOpTag TagToEnumOp = 601+primOpTag AddrToAnyOp = 602+primOpTag AnyToAddrOp = 603+primOpTag MkApUpd0_Op = 604+primOpTag NewBCOOp = 605+primOpTag UnpackClosureOp = 606+primOpTag ClosureSizeOp = 607+primOpTag GetApStackValOp = 608+primOpTag GetCCSOfOp = 609+primOpTag GetCurrentCCSOp = 610+primOpTag ClearCCSOp = 611+primOpTag WhereFromOp = 612+primOpTag TraceEventOp = 613+primOpTag TraceEventBinaryOp = 614+primOpTag TraceMarkerOp = 615+primOpTag SetThreadAllocationCounter = 616+primOpTag (VecBroadcastOp IntVec 16 W8) = 617+primOpTag (VecBroadcastOp IntVec 8 W16) = 618+primOpTag (VecBroadcastOp IntVec 4 W32) = 619+primOpTag (VecBroadcastOp IntVec 2 W64) = 620+primOpTag (VecBroadcastOp IntVec 32 W8) = 621+primOpTag (VecBroadcastOp IntVec 16 W16) = 622+primOpTag (VecBroadcastOp IntVec 8 W32) = 623+primOpTag (VecBroadcastOp IntVec 4 W64) = 624+primOpTag (VecBroadcastOp IntVec 64 W8) = 625+primOpTag (VecBroadcastOp IntVec 32 W16) = 626+primOpTag (VecBroadcastOp IntVec 16 W32) = 627+primOpTag (VecBroadcastOp IntVec 8 W64) = 628+primOpTag (VecBroadcastOp WordVec 16 W8) = 629+primOpTag (VecBroadcastOp WordVec 8 W16) = 630+primOpTag (VecBroadcastOp WordVec 4 W32) = 631+primOpTag (VecBroadcastOp WordVec 2 W64) = 632+primOpTag (VecBroadcastOp WordVec 32 W8) = 633+primOpTag (VecBroadcastOp WordVec 16 W16) = 634+primOpTag (VecBroadcastOp WordVec 8 W32) = 635+primOpTag (VecBroadcastOp WordVec 4 W64) = 636+primOpTag (VecBroadcastOp WordVec 64 W8) = 637+primOpTag (VecBroadcastOp WordVec 32 W16) = 638+primOpTag (VecBroadcastOp WordVec 16 W32) = 639+primOpTag (VecBroadcastOp WordVec 8 W64) = 640+primOpTag (VecBroadcastOp FloatVec 4 W32) = 641+primOpTag (VecBroadcastOp FloatVec 2 W64) = 642+primOpTag (VecBroadcastOp FloatVec 8 W32) = 643+primOpTag (VecBroadcastOp FloatVec 4 W64) = 644+primOpTag (VecBroadcastOp FloatVec 16 W32) = 645+primOpTag (VecBroadcastOp FloatVec 8 W64) = 646+primOpTag (VecPackOp IntVec 16 W8) = 647+primOpTag (VecPackOp IntVec 8 W16) = 648+primOpTag (VecPackOp IntVec 4 W32) = 649+primOpTag (VecPackOp IntVec 2 W64) = 650+primOpTag (VecPackOp IntVec 32 W8) = 651+primOpTag (VecPackOp IntVec 16 W16) = 652+primOpTag (VecPackOp IntVec 8 W32) = 653+primOpTag (VecPackOp IntVec 4 W64) = 654+primOpTag (VecPackOp IntVec 64 W8) = 655+primOpTag (VecPackOp IntVec 32 W16) = 656+primOpTag (VecPackOp IntVec 16 W32) = 657+primOpTag (VecPackOp IntVec 8 W64) = 658+primOpTag (VecPackOp WordVec 16 W8) = 659+primOpTag (VecPackOp WordVec 8 W16) = 660+primOpTag (VecPackOp WordVec 4 W32) = 661+primOpTag (VecPackOp WordVec 2 W64) = 662+primOpTag (VecPackOp WordVec 32 W8) = 663+primOpTag (VecPackOp WordVec 16 W16) = 664+primOpTag (VecPackOp WordVec 8 W32) = 665+primOpTag (VecPackOp WordVec 4 W64) = 666+primOpTag (VecPackOp WordVec 64 W8) = 667+primOpTag (VecPackOp WordVec 32 W16) = 668+primOpTag (VecPackOp WordVec 16 W32) = 669+primOpTag (VecPackOp WordVec 8 W64) = 670+primOpTag (VecPackOp FloatVec 4 W32) = 671+primOpTag (VecPackOp FloatVec 2 W64) = 672+primOpTag (VecPackOp FloatVec 8 W32) = 673+primOpTag (VecPackOp FloatVec 4 W64) = 674+primOpTag (VecPackOp FloatVec 16 W32) = 675+primOpTag (VecPackOp FloatVec 8 W64) = 676+primOpTag (VecUnpackOp IntVec 16 W8) = 677+primOpTag (VecUnpackOp IntVec 8 W16) = 678+primOpTag (VecUnpackOp IntVec 4 W32) = 679+primOpTag (VecUnpackOp IntVec 2 W64) = 680+primOpTag (VecUnpackOp IntVec 32 W8) = 681+primOpTag (VecUnpackOp IntVec 16 W16) = 682+primOpTag (VecUnpackOp IntVec 8 W32) = 683+primOpTag (VecUnpackOp IntVec 4 W64) = 684+primOpTag (VecUnpackOp IntVec 64 W8) = 685+primOpTag (VecUnpackOp IntVec 32 W16) = 686+primOpTag (VecUnpackOp IntVec 16 W32) = 687+primOpTag (VecUnpackOp IntVec 8 W64) = 688+primOpTag (VecUnpackOp WordVec 16 W8) = 689+primOpTag (VecUnpackOp WordVec 8 W16) = 690+primOpTag (VecUnpackOp WordVec 4 W32) = 691+primOpTag (VecUnpackOp WordVec 2 W64) = 692+primOpTag (VecUnpackOp WordVec 32 W8) = 693+primOpTag (VecUnpackOp WordVec 16 W16) = 694+primOpTag (VecUnpackOp WordVec 8 W32) = 695+primOpTag (VecUnpackOp WordVec 4 W64) = 696+primOpTag (VecUnpackOp WordVec 64 W8) = 697+primOpTag (VecUnpackOp WordVec 32 W16) = 698+primOpTag (VecUnpackOp WordVec 16 W32) = 699+primOpTag (VecUnpackOp WordVec 8 W64) = 700+primOpTag (VecUnpackOp FloatVec 4 W32) = 701+primOpTag (VecUnpackOp FloatVec 2 W64) = 702+primOpTag (VecUnpackOp FloatVec 8 W32) = 703+primOpTag (VecUnpackOp FloatVec 4 W64) = 704+primOpTag (VecUnpackOp FloatVec 16 W32) = 705+primOpTag (VecUnpackOp FloatVec 8 W64) = 706+primOpTag (VecInsertOp IntVec 16 W8) = 707+primOpTag (VecInsertOp IntVec 8 W16) = 708+primOpTag (VecInsertOp IntVec 4 W32) = 709+primOpTag (VecInsertOp IntVec 2 W64) = 710+primOpTag (VecInsertOp IntVec 32 W8) = 711+primOpTag (VecInsertOp IntVec 16 W16) = 712+primOpTag (VecInsertOp IntVec 8 W32) = 713+primOpTag (VecInsertOp IntVec 4 W64) = 714+primOpTag (VecInsertOp IntVec 64 W8) = 715+primOpTag (VecInsertOp IntVec 32 W16) = 716+primOpTag (VecInsertOp IntVec 16 W32) = 717+primOpTag (VecInsertOp IntVec 8 W64) = 718+primOpTag (VecInsertOp WordVec 16 W8) = 719+primOpTag (VecInsertOp WordVec 8 W16) = 720+primOpTag (VecInsertOp WordVec 4 W32) = 721+primOpTag (VecInsertOp WordVec 2 W64) = 722+primOpTag (VecInsertOp WordVec 32 W8) = 723+primOpTag (VecInsertOp WordVec 16 W16) = 724+primOpTag (VecInsertOp WordVec 8 W32) = 725+primOpTag (VecInsertOp WordVec 4 W64) = 726+primOpTag (VecInsertOp WordVec 64 W8) = 727+primOpTag (VecInsertOp WordVec 32 W16) = 728+primOpTag (VecInsertOp WordVec 16 W32) = 729+primOpTag (VecInsertOp WordVec 8 W64) = 730+primOpTag (VecInsertOp FloatVec 4 W32) = 731+primOpTag (VecInsertOp FloatVec 2 W64) = 732+primOpTag (VecInsertOp FloatVec 8 W32) = 733+primOpTag (VecInsertOp FloatVec 4 W64) = 734+primOpTag (VecInsertOp FloatVec 16 W32) = 735+primOpTag (VecInsertOp FloatVec 8 W64) = 736+primOpTag (VecAddOp IntVec 16 W8) = 737+primOpTag (VecAddOp IntVec 8 W16) = 738+primOpTag (VecAddOp IntVec 4 W32) = 739+primOpTag (VecAddOp IntVec 2 W64) = 740+primOpTag (VecAddOp IntVec 32 W8) = 741+primOpTag (VecAddOp IntVec 16 W16) = 742+primOpTag (VecAddOp IntVec 8 W32) = 743+primOpTag (VecAddOp IntVec 4 W64) = 744+primOpTag (VecAddOp IntVec 64 W8) = 745+primOpTag (VecAddOp IntVec 32 W16) = 746+primOpTag (VecAddOp IntVec 16 W32) = 747+primOpTag (VecAddOp IntVec 8 W64) = 748+primOpTag (VecAddOp WordVec 16 W8) = 749+primOpTag (VecAddOp WordVec 8 W16) = 750+primOpTag (VecAddOp WordVec 4 W32) = 751+primOpTag (VecAddOp WordVec 2 W64) = 752+primOpTag (VecAddOp WordVec 32 W8) = 753+primOpTag (VecAddOp WordVec 16 W16) = 754+primOpTag (VecAddOp WordVec 8 W32) = 755+primOpTag (VecAddOp WordVec 4 W64) = 756+primOpTag (VecAddOp WordVec 64 W8) = 757+primOpTag (VecAddOp WordVec 32 W16) = 758+primOpTag (VecAddOp WordVec 16 W32) = 759+primOpTag (VecAddOp WordVec 8 W64) = 760+primOpTag (VecAddOp FloatVec 4 W32) = 761+primOpTag (VecAddOp FloatVec 2 W64) = 762+primOpTag (VecAddOp FloatVec 8 W32) = 763+primOpTag (VecAddOp FloatVec 4 W64) = 764+primOpTag (VecAddOp FloatVec 16 W32) = 765+primOpTag (VecAddOp FloatVec 8 W64) = 766+primOpTag (VecSubOp IntVec 16 W8) = 767+primOpTag (VecSubOp IntVec 8 W16) = 768+primOpTag (VecSubOp IntVec 4 W32) = 769+primOpTag (VecSubOp IntVec 2 W64) = 770+primOpTag (VecSubOp IntVec 32 W8) = 771+primOpTag (VecSubOp IntVec 16 W16) = 772+primOpTag (VecSubOp IntVec 8 W32) = 773+primOpTag (VecSubOp IntVec 4 W64) = 774+primOpTag (VecSubOp IntVec 64 W8) = 775+primOpTag (VecSubOp IntVec 32 W16) = 776+primOpTag (VecSubOp IntVec 16 W32) = 777+primOpTag (VecSubOp IntVec 8 W64) = 778+primOpTag (VecSubOp WordVec 16 W8) = 779+primOpTag (VecSubOp WordVec 8 W16) = 780+primOpTag (VecSubOp WordVec 4 W32) = 781+primOpTag (VecSubOp WordVec 2 W64) = 782+primOpTag (VecSubOp WordVec 32 W8) = 783+primOpTag (VecSubOp WordVec 16 W16) = 784+primOpTag (VecSubOp WordVec 8 W32) = 785+primOpTag (VecSubOp WordVec 4 W64) = 786+primOpTag (VecSubOp WordVec 64 W8) = 787+primOpTag (VecSubOp WordVec 32 W16) = 788+primOpTag (VecSubOp WordVec 16 W32) = 789+primOpTag (VecSubOp WordVec 8 W64) = 790+primOpTag (VecSubOp FloatVec 4 W32) = 791+primOpTag (VecSubOp FloatVec 2 W64) = 792+primOpTag (VecSubOp FloatVec 8 W32) = 793+primOpTag (VecSubOp FloatVec 4 W64) = 794+primOpTag (VecSubOp FloatVec 16 W32) = 795+primOpTag (VecSubOp FloatVec 8 W64) = 796+primOpTag (VecMulOp IntVec 16 W8) = 797+primOpTag (VecMulOp IntVec 8 W16) = 798+primOpTag (VecMulOp IntVec 4 W32) = 799+primOpTag (VecMulOp IntVec 2 W64) = 800+primOpTag (VecMulOp IntVec 32 W8) = 801+primOpTag (VecMulOp IntVec 16 W16) = 802+primOpTag (VecMulOp IntVec 8 W32) = 803+primOpTag (VecMulOp IntVec 4 W64) = 804+primOpTag (VecMulOp IntVec 64 W8) = 805+primOpTag (VecMulOp IntVec 32 W16) = 806+primOpTag (VecMulOp IntVec 16 W32) = 807+primOpTag (VecMulOp IntVec 8 W64) = 808+primOpTag (VecMulOp WordVec 16 W8) = 809+primOpTag (VecMulOp WordVec 8 W16) = 810+primOpTag (VecMulOp WordVec 4 W32) = 811+primOpTag (VecMulOp WordVec 2 W64) = 812+primOpTag (VecMulOp WordVec 32 W8) = 813+primOpTag (VecMulOp WordVec 16 W16) = 814+primOpTag (VecMulOp WordVec 8 W32) = 815+primOpTag (VecMulOp WordVec 4 W64) = 816+primOpTag (VecMulOp WordVec 64 W8) = 817+primOpTag (VecMulOp WordVec 32 W16) = 818+primOpTag (VecMulOp WordVec 16 W32) = 819+primOpTag (VecMulOp WordVec 8 W64) = 820+primOpTag (VecMulOp FloatVec 4 W32) = 821+primOpTag (VecMulOp FloatVec 2 W64) = 822+primOpTag (VecMulOp FloatVec 8 W32) = 823+primOpTag (VecMulOp FloatVec 4 W64) = 824+primOpTag (VecMulOp FloatVec 16 W32) = 825+primOpTag (VecMulOp FloatVec 8 W64) = 826+primOpTag (VecDivOp FloatVec 4 W32) = 827+primOpTag (VecDivOp FloatVec 2 W64) = 828+primOpTag (VecDivOp FloatVec 8 W32) = 829+primOpTag (VecDivOp FloatVec 4 W64) = 830+primOpTag (VecDivOp FloatVec 16 W32) = 831+primOpTag (VecDivOp FloatVec 8 W64) = 832+primOpTag (VecQuotOp IntVec 16 W8) = 833+primOpTag (VecQuotOp IntVec 8 W16) = 834+primOpTag (VecQuotOp IntVec 4 W32) = 835+primOpTag (VecQuotOp IntVec 2 W64) = 836+primOpTag (VecQuotOp IntVec 32 W8) = 837+primOpTag (VecQuotOp IntVec 16 W16) = 838+primOpTag (VecQuotOp IntVec 8 W32) = 839+primOpTag (VecQuotOp IntVec 4 W64) = 840+primOpTag (VecQuotOp IntVec 64 W8) = 841+primOpTag (VecQuotOp IntVec 32 W16) = 842+primOpTag (VecQuotOp IntVec 16 W32) = 843+primOpTag (VecQuotOp IntVec 8 W64) = 844+primOpTag (VecQuotOp WordVec 16 W8) = 845+primOpTag (VecQuotOp WordVec 8 W16) = 846+primOpTag (VecQuotOp WordVec 4 W32) = 847+primOpTag (VecQuotOp WordVec 2 W64) = 848+primOpTag (VecQuotOp WordVec 32 W8) = 849+primOpTag (VecQuotOp WordVec 16 W16) = 850+primOpTag (VecQuotOp WordVec 8 W32) = 851+primOpTag (VecQuotOp WordVec 4 W64) = 852+primOpTag (VecQuotOp WordVec 64 W8) = 853+primOpTag (VecQuotOp WordVec 32 W16) = 854+primOpTag (VecQuotOp WordVec 16 W32) = 855+primOpTag (VecQuotOp WordVec 8 W64) = 856+primOpTag (VecRemOp IntVec 16 W8) = 857+primOpTag (VecRemOp IntVec 8 W16) = 858+primOpTag (VecRemOp IntVec 4 W32) = 859+primOpTag (VecRemOp IntVec 2 W64) = 860+primOpTag (VecRemOp IntVec 32 W8) = 861+primOpTag (VecRemOp IntVec 16 W16) = 862+primOpTag (VecRemOp IntVec 8 W32) = 863+primOpTag (VecRemOp IntVec 4 W64) = 864+primOpTag (VecRemOp IntVec 64 W8) = 865+primOpTag (VecRemOp IntVec 32 W16) = 866+primOpTag (VecRemOp IntVec 16 W32) = 867+primOpTag (VecRemOp IntVec 8 W64) = 868+primOpTag (VecRemOp WordVec 16 W8) = 869+primOpTag (VecRemOp WordVec 8 W16) = 870+primOpTag (VecRemOp WordVec 4 W32) = 871+primOpTag (VecRemOp WordVec 2 W64) = 872+primOpTag (VecRemOp WordVec 32 W8) = 873+primOpTag (VecRemOp WordVec 16 W16) = 874+primOpTag (VecRemOp WordVec 8 W32) = 875+primOpTag (VecRemOp WordVec 4 W64) = 876+primOpTag (VecRemOp WordVec 64 W8) = 877+primOpTag (VecRemOp WordVec 32 W16) = 878+primOpTag (VecRemOp WordVec 16 W32) = 879+primOpTag (VecRemOp WordVec 8 W64) = 880+primOpTag (VecNegOp IntVec 16 W8) = 881+primOpTag (VecNegOp IntVec 8 W16) = 882+primOpTag (VecNegOp IntVec 4 W32) = 883+primOpTag (VecNegOp IntVec 2 W64) = 884+primOpTag (VecNegOp IntVec 32 W8) = 885+primOpTag (VecNegOp IntVec 16 W16) = 886+primOpTag (VecNegOp IntVec 8 W32) = 887+primOpTag (VecNegOp IntVec 4 W64) = 888+primOpTag (VecNegOp IntVec 64 W8) = 889+primOpTag (VecNegOp IntVec 32 W16) = 890+primOpTag (VecNegOp IntVec 16 W32) = 891+primOpTag (VecNegOp IntVec 8 W64) = 892+primOpTag (VecNegOp FloatVec 4 W32) = 893+primOpTag (VecNegOp FloatVec 2 W64) = 894+primOpTag (VecNegOp FloatVec 8 W32) = 895+primOpTag (VecNegOp FloatVec 4 W64) = 896+primOpTag (VecNegOp FloatVec 16 W32) = 897+primOpTag (VecNegOp FloatVec 8 W64) = 898+primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 899+primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 900+primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 901+primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 902+primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 903+primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 904+primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 905+primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 906+primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 907+primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 908+primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 909+primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 910+primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 911+primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 912+primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 913+primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 914+primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 915+primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 916+primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 917+primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 918+primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 919+primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 920+primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 921+primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 922+primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 923+primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 924+primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 925+primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 926+primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 927+primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 928+primOpTag (VecReadByteArrayOp IntVec 16 W8) = 929+primOpTag (VecReadByteArrayOp IntVec 8 W16) = 930+primOpTag (VecReadByteArrayOp IntVec 4 W32) = 931+primOpTag (VecReadByteArrayOp IntVec 2 W64) = 932+primOpTag (VecReadByteArrayOp IntVec 32 W8) = 933+primOpTag (VecReadByteArrayOp IntVec 16 W16) = 934+primOpTag (VecReadByteArrayOp IntVec 8 W32) = 935+primOpTag (VecReadByteArrayOp IntVec 4 W64) = 936+primOpTag (VecReadByteArrayOp IntVec 64 W8) = 937+primOpTag (VecReadByteArrayOp IntVec 32 W16) = 938+primOpTag (VecReadByteArrayOp IntVec 16 W32) = 939+primOpTag (VecReadByteArrayOp IntVec 8 W64) = 940+primOpTag (VecReadByteArrayOp WordVec 16 W8) = 941+primOpTag (VecReadByteArrayOp WordVec 8 W16) = 942+primOpTag (VecReadByteArrayOp WordVec 4 W32) = 943+primOpTag (VecReadByteArrayOp WordVec 2 W64) = 944+primOpTag (VecReadByteArrayOp WordVec 32 W8) = 945+primOpTag (VecReadByteArrayOp WordVec 16 W16) = 946+primOpTag (VecReadByteArrayOp WordVec 8 W32) = 947+primOpTag (VecReadByteArrayOp WordVec 4 W64) = 948+primOpTag (VecReadByteArrayOp WordVec 64 W8) = 949+primOpTag (VecReadByteArrayOp WordVec 32 W16) = 950+primOpTag (VecReadByteArrayOp WordVec 16 W32) = 951+primOpTag (VecReadByteArrayOp WordVec 8 W64) = 952+primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 953+primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 954+primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 955+primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 956+primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 957+primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 958+primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 959+primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 960+primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 961+primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 962+primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 963+primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 964+primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 965+primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 966+primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 967+primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 968+primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 969+primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 970+primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 971+primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 972+primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 973+primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 974+primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 975+primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 976+primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 977+primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 978+primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 979+primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 980+primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 981+primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 982+primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 983+primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 984+primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 985+primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 986+primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 987+primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 988+primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 989+primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 990+primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 991+primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 992+primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 993+primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 994+primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 995+primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 996+primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 997+primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 998+primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 999+primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1000+primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1001+primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1002+primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1003+primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1004+primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1005+primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1006+primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1007+primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1008+primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1009+primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1010+primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1011+primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1012+primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1013+primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1014+primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1015+primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1016+primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1017+primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1018+primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1019+primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1020+primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1021+primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1022+primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1023+primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1024+primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1025+primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1026+primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1027+primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1028+primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1029+primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1030+primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1031+primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1032+primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1033+primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1034+primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1035+primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1036+primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1037+primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1038+primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1039+primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1040+primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1041+primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1042+primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1043+primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1044+primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1045+primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1046+primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1047+primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1048+primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1049+primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1050+primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1051+primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1052+primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1053+primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1054+primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1055+primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1056+primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1057+primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1058+primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1059+primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1060+primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1061+primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1062+primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1063+primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1064+primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1065+primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1066+primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1067+primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1068+primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1069+primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1070+primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1071+primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1072+primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1073+primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1074+primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1075+primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1076+primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1077+primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1078+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1079+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1080+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1081+primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1082+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1083+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1084+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1085+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1086+primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1087+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1088+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1089+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1090+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1091+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1092+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1093+primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1094+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1095+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1096+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1097+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1098+primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1099+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1100+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1101+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1102+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1103+primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1104+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1105+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1106+primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1107+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1108+primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1109+primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1110+primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1111+primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1112+primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1113+primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1114+primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1115+primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1116+primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1117+primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1118+primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1119+primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1120+primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1121+primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1122+primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1123+primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1124+primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1125+primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1126+primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1127+primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1128+primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1129+primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1130+primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1131+primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1132+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1133+primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1134+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1135+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1136+primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1137+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1138+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1139+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1140+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1141+primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1142+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1143+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1144+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1145+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1146+primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1147+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1148+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1149+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1150+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1151+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1152+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1153+primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1154+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1155+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1156+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1157+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1158+primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1159+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1160+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1161+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1162+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1163+primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1164+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1165+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1166+primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1167+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1168+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1169+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1170+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1171+primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1172+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1173+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1174+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1175+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1176+primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1177+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1178+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1179+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1180+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1181+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1182+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1183+primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1184+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1185+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1186+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1187+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1188+primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1189+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1190+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1191+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1192+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1193+primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1194+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1195+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1196+primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1197+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1198+primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1199+primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1200+primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1201+primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1202+primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1203+primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1204+primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1205+primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1206+primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1207+primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1208+primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1209+primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1210+primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1211+primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1212+primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1213+primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1214+primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1215+primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1216+primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1217+primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1218+primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1219+primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1220+primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1221+primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1222+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1223+primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1224+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1225+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1226+primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1227+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1228+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1229+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1230+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1231+primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1232+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1233+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1234+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1235+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1236+primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1237+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1238+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1239+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1240+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1241+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1242+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1243+primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1244+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1245+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1246+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1247+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1248+primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1249+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1250+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1251+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1252+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1253+primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1254+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1255+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1256+primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1257+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1258+primOpTag PrefetchByteArrayOp3 = 1259+primOpTag PrefetchMutableByteArrayOp3 = 1260+primOpTag PrefetchAddrOp3 = 1261+primOpTag PrefetchValueOp3 = 1262+primOpTag PrefetchByteArrayOp2 = 1263+primOpTag PrefetchMutableByteArrayOp2 = 1264+primOpTag PrefetchAddrOp2 = 1265+primOpTag PrefetchValueOp2 = 1266+primOpTag PrefetchByteArrayOp1 = 1267+primOpTag PrefetchMutableByteArrayOp1 = 1268+primOpTag PrefetchAddrOp1 = 1269+primOpTag PrefetchValueOp1 = 1270+primOpTag PrefetchByteArrayOp0 = 1271+primOpTag PrefetchMutableByteArrayOp0 = 1272+primOpTag PrefetchAddrOp0 = 1273+primOpTag PrefetchValueOp0 = 1274
ghc-lib/stage0/lib/ghcautoconf.h view
@@ -482,6 +482,9 @@ macro is obsolete. */ #define TIME_WITH_SYS_TIME 1 +/* Compile-in ASSERTs in all ways. */+/* #undef USE_ASSERTS_ALL_WAYS */+ /* Enable single heap address space support */ #define USE_LARGE_ADDRESS_SPACE 1
libraries/ghci/GHCi/InfoTable.hsc view
@@ -37,8 +37,8 @@ -> Int -- pointer tag -> ByteString -- con desc -> IO (Ptr StgInfoTable)- -- resulting info table is allocated with allocateExec(), and- -- should be freed with freeExec().+ -- resulting info table is allocated with allocateExecPage(), and+ -- should be freed with freeExecPage(). mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do let entry_addr = interpConstrEntry !! ptrtag@@ -325,13 +325,35 @@ Right xs -> sizeOf (head xs) * length xs -- Note: Must return proper pointer for use in a closure+#if MIN_VERSION_rts(1,0,1) newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())-newExecConItbl tables_next_to_code obj con_desc-#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)- = do+newExecConItbl tables_next_to_code obj con_desc = do+ sz0 <- sizeOfEntryCode tables_next_to_code+ let lcon_desc = BS.length con_desc + 1{- null terminator -}+ -- SCARY+ -- This size represents the number of bytes in an StgConInfoTable.+ sz = fromIntegral $ conInfoTableSizeB + sz0+ -- Note: we need to allocate the conDesc string next to the info+ -- table, because on a 64-bit platform we reference this string+ -- with a 32-bit offset relative to the info table, so if we+ -- allocated the string separately it might be out of range.++ ex_ptr <- fillExecBuffer (sz + fromIntegral lcon_desc) $ \wr_ptr ex_ptr -> do+ let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz+ , infoTable = obj }+ pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo+ BS.useAsCStringLen con_desc $ \(src, len) ->+ copyBytes (castPtr wr_ptr `plusPtr` fromIntegral sz) src len+ let null_off = fromIntegral sz + fromIntegral (BS.length con_desc)+ poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8)++ pure $ if tables_next_to_code+ then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB+ else castPtrToFunPtr ex_ptr #else+newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())+newExecConItbl tables_next_to_code obj con_desc = alloca $ \pcode -> do-#endif sz0 <- sizeOfEntryCode tables_next_to_code let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY@@ -341,13 +363,8 @@ -- table, because on a 64-bit platform we reference this string -- with a 32-bit offset relative to the info table, so if we -- allocated the string separately it might be out of range.-#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)- wr_ptr <- _allocateWrite (sz + fromIntegral lcon_desc)- let ex_ptr = wr_ptr-#else wr_ptr <- _allocateExec (sz + fromIntegral lcon_desc) pcode ex_ptr <- peek pcode-#endif let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo@@ -356,25 +373,64 @@ let null_off = fromIntegral sz + fromIntegral (BS.length con_desc) poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8) _flushExec sz ex_ptr -- Cache flush (if needed)-#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)- _markExec (sz + fromIntegral lcon_desc) ex_ptr-#endif pure $ if tables_next_to_code then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB else castPtrToFunPtr ex_ptr+#endif +-- | Allocate a buffer of a given size, use the given action to fill it with+-- data, and mark it as executable. The action is given a writable pointer and+-- the executable pointer. Returns a pointer to the executable code.+#if MIN_VERSION_rts(1,0,1)+fillExecBuffer :: CSize -> (Ptr a -> Ptr a -> IO ()) -> IO (Ptr a)+#endif++#if MIN_VERSION_rts(1,0,2)++data ExecPage++foreign import ccall unsafe "allocateExecPage"+ _allocateExecPage :: IO (Ptr ExecPage)++foreign import ccall unsafe "freezeExecPage"+ _freezeExecPage :: Ptr ExecPage -> IO ()++fillExecBuffer sz cont+ -- we can only allocate single pages. This assumes a 4k page size which+ -- isn't strictly correct but is a reasonable conservative lower bound.+ | sz > 4096 = fail "withExecBuffer: Too large"+ | otherwise = do+ pg <- _allocateExecPage+ cont (castPtr pg) (castPtr pg)+ _freezeExecPage pg+ return (castPtr pg)++#elif MIN_VERSION_rts(1,0,1)+ foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a) foreign import ccall unsafe "flushExec" _flushExec :: CUInt -> Ptr a -> IO () -#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)-foreign import ccall unsafe "allocateWrite"- _allocateWrite :: CUInt -> IO (Ptr a)-foreign import ccall unsafe "markExec"- _markExec :: CUInt -> Ptr a -> IO ()+fillExecBuffer sz cont = alloca $ \pcode -> do+ wr_ptr <- _allocateExec (fromIntegral sz) pcode+ ex_ptr <- peek pcode+ cont wr_ptr ex_ptr+ _flushExec (fromIntegral sz) ex_ptr -- Cache flush (if needed)+ return (ex_ptr)++#else++foreign import ccall unsafe "allocateExec"+ _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)++foreign import ccall unsafe "flushExec"+ _flushExec :: CUInt -> Ptr a -> IO ()++ #endif+ -- ----------------------------------------------------------------------------- -- Constants and config