ghc-lib 0.20190523.1 → 0.20190603
raw patch · 35 files changed
+1115/−977 lines, 35 filesdep ~ghc-lib-parserPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghc-lib-parser
API changes (from Hackage documentation)
- GHC: [settings] :: DynFlags -> Settings
- HeaderInfo: checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
- HeaderInfo: getImports :: DynFlags -> StringBuffer -> FilePath -> FilePath -> IO ([(Maybe FastString, Located ModuleName)], [(Maybe FastString, Located ModuleName)], Located ModuleName)
- HeaderInfo: getOptions :: DynFlags -> StringBuffer -> FilePath -> [Located String]
- HeaderInfo: getOptionsFromFile :: DynFlags -> FilePath -> IO [Located String]
- HeaderInfo: mkPrelImports :: ModuleName -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
- HeaderInfo: optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages
- HieTypes: [hie_ghc_version] :: HieFile -> ByteString
- HieTypes: [hie_version] :: HieFile -> Word8
- HieTypes: curHieVersion :: Word8
- Specialise: instance Outputable.Outputable Specialise.CallKey
+ DriverPipeline: doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
+ GHC: [fileSettings] :: DynFlags -> {-# UNPACK #-} !FileSettings
+ GHC: [ghcNameVersion] :: DynFlags -> {-# UNPACK #-} !GhcNameVersion
+ GHC: [platformConstants] :: DynFlags -> PlatformConstants
+ GHC: [platformMisc] :: DynFlags -> {-# UNPACK #-} !PlatformMisc
+ GHC: [rawSettings] :: DynFlags -> [(String, String)]
+ GHC: [targetPlatform] :: DynFlags -> Platform
+ GHC: [toolSettings] :: DynFlags -> {-# UNPACK #-} !ToolSettings
+ GhcMake: depanalPartial :: GhcMonad m => [ModuleName] -> Bool -> m (ErrorMessages, ModuleGraph)
+ GhcMake: downsweep :: HscEnv -> [ModSummary] -> [ModuleName] -> Bool -> IO [Either ErrorMessages ModSummary]
+ HieBin: HieFileResult :: Integer -> ByteString -> HieFile -> HieFileResult
+ HieBin: [hie_file_result] :: HieFileResult -> HieFile
+ HieBin: [hie_file_result_ghc_version] :: HieFileResult -> ByteString
+ HieBin: [hie_file_result_version] :: HieFileResult -> Integer
+ HieBin: data HieFileResult
+ HieBin: hieMagic :: [Word8]
+ HieBin: readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader (HieFileResult, NameCache))
+ HieBin: type HieHeader = (Integer, ByteString)
+ HieTypes: hieVersion :: Integer
+ Specialise: instance Outputable.Outputable Specialise.SpecArg
- DriverPipeline: preprocess :: HscEnv -> (FilePath, Maybe Phase) -> IO (DynFlags, FilePath)
+ DriverPipeline: preprocess :: HscEnv -> FilePath -> Maybe InputFileBuffer -> Maybe Phase -> IO (Either ErrorMessages (DynFlags, FilePath))
- GHC: DynFlags :: GhcMode -> GhcLink -> HscTarget -> Settings -> IntegerLibrary -> LlvmTargets -> LlvmPasses -> Int -> Int -> Int -> Int -> Int -> Int -> Maybe String -> Maybe String -> [Int] -> Maybe Int -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Maybe Int -> Maybe Int -> Int -> Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> Module -> Maybe String -> IntWithInf -> IntWithInf -> InstalledUnitId -> Maybe ComponentId -> Maybe [(ModuleName, Module)] -> [Way] -> String -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> IORef Bool -> String -> String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> Maybe FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [LoadedPlugin] -> [StaticPlugin] -> Hooks -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> Maybe [(FilePath, [PackageConfig])] -> PackageState -> IORef FilesToClean -> IORef (Map FilePath FilePath) -> IORef Int -> IORef (Set FilePath) -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> Int -> Int -> Int -> Int -> Float -> Int -> Bool -> Int -> Int -> LogAction -> FlushOut -> FlushErr -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> Maybe String -> IORef (ModuleEnv Int) -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> IORef (Maybe LinkerInfo) -> IORef (Maybe CompilerInfo) -> Int -> Int -> Int -> Bool -> Maybe Int -> Int -> Int -> CfgWeights -> DynFlags
+ GHC: DynFlags :: GhcMode -> GhcLink -> HscTarget -> {-# UNPACK #-} !GhcNameVersion -> {-# UNPACK #-} !FileSettings -> Platform -> {-# UNPACK #-} !ToolSettings -> {-# UNPACK #-} !PlatformMisc -> PlatformConstants -> [(String, String)] -> IntegerLibrary -> LlvmTargets -> LlvmPasses -> Int -> Int -> Int -> Int -> Int -> Int -> Maybe String -> Maybe String -> [Int] -> Maybe Int -> Bool -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Int -> Int -> Maybe Int -> Maybe Int -> Int -> Word -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Bool -> Maybe Int -> Int -> [FilePath] -> Module -> Maybe String -> IntWithInf -> IntWithInf -> InstalledUnitId -> Maybe ComponentId -> Maybe [(ModuleName, Module)] -> [Way] -> String -> Maybe (String, Int) -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> String -> String -> String -> String -> IORef Bool -> String -> String -> Maybe String -> Maybe String -> Maybe String -> DynLibLoader -> Maybe FilePath -> Maybe FilePath -> [Option] -> IncludeSpecs -> [String] -> [String] -> [String] -> Maybe String -> RtsOptsEnabled -> Bool -> String -> [ModuleName] -> [(ModuleName, String)] -> [String] -> [LoadedPlugin] -> [StaticPlugin] -> Hooks -> FilePath -> Bool -> Bool -> [ModuleName] -> [String] -> [PackageDBFlag] -> [IgnorePackageFlag] -> [PackageFlag] -> [PackageFlag] -> [TrustFlag] -> Maybe FilePath -> Maybe [(FilePath, [PackageConfig])] -> PackageState -> IORef FilesToClean -> IORef (Map FilePath FilePath) -> IORef Int -> IORef (Set FilePath) -> EnumSet DumpFlag -> EnumSet GeneralFlag -> EnumSet WarningFlag -> EnumSet WarningFlag -> Maybe Language -> SafeHaskellMode -> Bool -> Bool -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> SrcSpan -> [OnOff Extension] -> EnumSet Extension -> Int -> Int -> Int -> Int -> Float -> Int -> Bool -> Int -> Int -> LogAction -> FlushOut -> FlushErr -> Maybe FilePath -> Maybe String -> [String] -> Int -> Int -> Bool -> OverridingBool -> Bool -> Scheme -> ProfAuto -> Maybe String -> IORef (ModuleEnv Int) -> Maybe SseVersion -> Maybe BmiVersion -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> IORef (Maybe LinkerInfo) -> IORef (Maybe CompilerInfo) -> Int -> Int -> Int -> Bool -> Maybe Int -> Int -> Int -> CfgWeights -> DynFlags
- GHC: Target :: TargetId -> Bool -> Maybe (StringBuffer, UTCTime) -> Target
+ GHC: Target :: TargetId -> Bool -> Maybe (InputFileBuffer, UTCTime) -> Target
- GHC: [targetContents] :: Target -> Maybe (StringBuffer, UTCTime)
+ GHC: [targetContents] :: Target -> Maybe (InputFileBuffer, UTCTime)
- GHC: defaultObjectTarget :: Settings -> HscTarget
+ GHC: defaultObjectTarget :: DynFlags -> HscTarget
- GhcMake: summariseModule :: HscEnv -> NodeMap ModSummary -> IsBoot -> Located ModuleName -> Bool -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -> IO (Maybe (Either ErrMsg ModSummary))
+ GhcMake: summariseModule :: HscEnv -> NodeMap ModSummary -> IsBoot -> Located ModuleName -> Bool -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -> IO (Maybe (Either ErrorMessages ModSummary))
- GhcPlugins: zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv
+ GhcPlugins: zipCoEnv :: HasDebugCallStack -> [CoVar] -> [Coercion] -> CvSubstEnv
- GhcPlugins: zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst
+ GhcPlugins: zipTCvSubst :: HasDebugCallStack -> [TyCoVar] -> [Type] -> TCvSubst
- GhcPlugins: zipTvSubst :: [TyVar] -> [Type] -> TCvSubst
+ GhcPlugins: zipTvSubst :: HasDebugCallStack -> [TyVar] -> [Type] -> TCvSubst
- GhcPlugins: zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
+ GhcPlugins: zipTyEnv :: HasDebugCallStack -> [TyVar] -> [Type] -> TvSubstEnv
- HieBin: readHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache)
+ HieBin: readHieFile :: NameCache -> FilePath -> IO (HieFileResult, NameCache)
- HieBin: writeHieFile :: Binary a => FilePath -> a -> IO ()
+ HieBin: writeHieFile :: FilePath -> HieFile -> IO ()
- HieTypes: HieFile :: Word8 -> ByteString -> FilePath -> Module -> Array TypeIndex HieTypeFlat -> HieASTs TypeIndex -> [AvailInfo] -> ByteString -> HieFile
+ HieTypes: HieFile :: FilePath -> Module -> Array TypeIndex HieTypeFlat -> HieASTs TypeIndex -> [AvailInfo] -> ByteString -> HieFile
- TcMatches: tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpRhoType -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
+ TcMatches: tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpSigmaType -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
Files
- compiler/backpack/DriverBkp.hs +1/−1
- compiler/cmm/CLabel.hs +7/−7
- compiler/cmm/CmmInfo.hs +1/−1
- compiler/cmm/PprCmmDecl.hs +1/−1
- compiler/deSugar/Check.hs +8/−2
- compiler/deSugar/DsForeign.hs +1/−1
- compiler/deSugar/ExtractDocs.hs +14/−3
- compiler/ghci/Linker.hs +8/−8
- compiler/hieFile/HieAst.hs +7/−6
- compiler/hieFile/HieBin.hs +116/−7
- compiler/hieFile/HieDebug.hs +3/−0
- compiler/hieFile/HieTypes.hs +9/−14
- compiler/main/CodeOutput.hs +2/−2
- compiler/main/DriverPipeline.hs +63/−25
- compiler/main/GhcMake.hs +233/−194
- compiler/main/HeaderInfo.hs +0/−352
- compiler/main/HscMain.hs +2/−2
- compiler/main/SysTools.hs +78/−63
- compiler/main/TidyPgm.hs +15/−14
- compiler/nativeGen/PPC/CodeGen.hs +1/−0
- compiler/nativeGen/PPC/Instr.hs +1/−1
- compiler/specialise/Specialise.hs +368/−112
- compiler/typecheck/FamInst.hs +7/−9
- compiler/typecheck/TcForeign.hs +8/−6
- compiler/typecheck/TcHoleErrors.hs +16/−7
- compiler/typecheck/TcMatches.hs +1/−1
- compiler/typecheck/TcMatches.hs-boot +2/−2
- compiler/typecheck/TcValidity.hs +1/−0
- ghc-lib.cabal +9/−3
- ghc-lib/generated/GHCConstantsHaskellWrappers.hs +125/−125
- ghc-lib/generated/ghcversion.h +1/−1
- ghc-lib/stage1/lib/settings +3/−3
- ghc/GHCi/Leak.hs +1/−2
- includes/CodeGen.Platform.hs +1/−1
- includes/MachDeps.h +1/−1
compiler/backpack/DriverBkp.hs view
@@ -729,7 +729,7 @@ [] -- No exclusions case r of Nothing -> throwOneError (mkPlainErrMsg dflags loc (text "module" <+> ppr modname <+> text "was not found"))- Just (Left err) -> throwOneError err+ Just (Left err) -> throwErrors err Just (Right summary) -> return summary -- | Up until now, GHC has assumed a single compilation target per source file.
compiler/cmm/CLabel.hs view
@@ -1162,7 +1162,7 @@ = tempLabelPrefixOrUnderscore <> pprUniqueAlways u pprCLabel dynFlags (AsmTempDerivedLabel l suf)- | sGhcWithNativeCodeGen $ settings dynFlags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = ptext (asmTempLabelPrefix $ targetPlatform dynFlags) <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u@@ -1170,15 +1170,15 @@ <> ftext suf pprCLabel dynFlags (DynamicLinkerLabel info lbl)- | sGhcWithNativeCodeGen $ settings dynFlags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl pprCLabel dynFlags PicBaseLabel- | sGhcWithNativeCodeGen $ settings dynFlags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = text "1b" pprCLabel dynFlags (DeadStripPreventer lbl)- | sGhcWithNativeCodeGen $ settings dynFlags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = {- `lbl` can be temp one but we need to ensure that dsp label will stay@@ -1190,18 +1190,18 @@ <> pprCLabel dynFlags lbl <> text "_dsp" pprCLabel dynFlags (StringLitLabel u)- | sGhcWithNativeCodeGen $ settings dynFlags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags = pprUniqueAlways u <> ptext (sLit "_str") pprCLabel dynFlags lbl = getPprStyle $ \ sty ->- if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty+ if platformMisc_ghcWithNativeCodeGen (platformMisc dynFlags) && asmStyle sty then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl else pprCLbl lbl maybe_underscore :: DynFlags -> SDoc -> SDoc maybe_underscore dynFlags doc =- if sLeadingUnderscore $ settings dynFlags+ if platformMisc_leadingUnderscore $ platformMisc dynFlags then pp_cSEP <> doc else doc
compiler/cmm/CmmInfo.hs view
@@ -531,7 +531,7 @@ | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc , oFFSET_StgFunInfoExtraFwd_arity dflags ) - pc = sPlatformConstants (settings dflags)+ pc = platformConstants dflags ----------------------------------------------------------------------------- --
compiler/cmm/PprCmmDecl.hs view
@@ -94,7 +94,7 @@ pprTop (CmmProc info lbl live graph) - = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live+ = vcat [ ppr lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live , nest 8 $ lbrace <+> ppr info $$ rbrace , nest 4 $ ppr graph , rbrace ]
compiler/deSugar/Check.hs view
@@ -43,6 +43,7 @@ import DataCon import PatSyn import HscTypes (CompleteMatch(..))+import BasicTypes (Boxity(..)) import DsMonad import TcSimplify (tcCheckSatisfiability)@@ -1078,12 +1079,17 @@ TuplePat tys ps boxity -> do tidy_ps <- translatePatVec fam_insts (map unLoc ps) let tuple_con = RealDataCon (tupleDataCon boxity (length ps))- return [vanillaConPattern tuple_con tys (concat tidy_ps)]+ tys' = case boxity of+ Boxed -> tys+ -- See Note [Unboxed tuple RuntimeRep vars] in TyCon+ Unboxed -> map getRuntimeRep tys ++ tys+ return [vanillaConPattern tuple_con tys' (concat tidy_ps)] SumPat ty p alt arity -> do tidy_p <- translatePat fam_insts (unLoc p) let sum_con = RealDataCon (sumDataCon alt arity)- return [vanillaConPattern sum_con ty tidy_p]+ -- See Note [Unboxed tuple RuntimeRep vars] in TyCon+ return [vanillaConPattern sum_con (map getRuntimeRep ty ++ ty) tidy_p] -- -------------------------------------------------------------------------- -- Not supposed to happen
compiler/deSugar/DsForeign.hs view
@@ -541,7 +541,7 @@ | otherwise = text ('a':show n) -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled- libffi = sLibFFI (settings dflags) && isNothing maybe_target+ libffi = platformMisc_libFFI (platformMisc dflags) && isNothing maybe_target type_string -- libffi needs to know the result type too:
compiler/deSugar/ExtractDocs.hs view
@@ -191,10 +191,21 @@ , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (dL->L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty)- | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) }- <- concatMap (unLoc . deriv_clause_tys . unLoc) $- unLoc $ dd_derivs dd+ | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $+ concatMap (unLoc . deriv_clause_tys . unLoc) $+ unLoc $ dd_derivs dd , Just instName <- [M.lookup l instMap] ]++ extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)+ extract_deriv_ty ty =+ case dL ty of+ -- deriving (forall a. C a {- ^ Doc comment -})+ L l (HsForAllTy{ hst_fvf = ForallInvis+ , hst_body = dL->L _ (HsDocTy _ _ doc) })+ -> Just (l, doc)+ -- deriving (C a {- ^ Doc comment -})+ L l (HsDocTy _ _ doc) -> Just (l, doc)+ _ -> Nothing -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
compiler/ghci/Linker.hs view
@@ -115,7 +115,7 @@ modifyMbPLS_ :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO ()-modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState {@@ -343,7 +343,7 @@ -- Add directories to library search paths, this only has an effect -- on Windows. On Unix OSes this function is a NOP.- let all_paths = let paths = takeDirectory (fst $ sPgm_c $ settings dflags)+ let all_paths = let paths = takeDirectory (fst $ pgm_c dflags) : framework_paths ++ lib_paths_base ++ [ takeDirectory dll | DLLPath dll <- libspecs ]@@ -881,8 +881,8 @@ dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] -> IO PersistentLinkerState-dynLoadObjs _ pls [] = return pls-dynLoadObjs hsc_env pls objs = do+dynLoadObjs _ pls [] = return pls+dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do let dflags = hsc_dflags hsc_env let platform = targetPlatform dflags let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]@@ -899,13 +899,13 @@ -- library. ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ])- (nub $ snd <$> temp_sos pls)+ (nub $ snd <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) , Option "-Xlinker" , Option "-rpath" , Option "-Xlinker" , Option lp ])- (nub $ fst <$> temp_sos pls)+ (nub $ fst <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp)@@ -933,13 +933,13 @@ -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again.- linkDynLib dflags2 objs (pkgs_loaded pls)+ linkDynLib dflags2 objs pkgs_loaded -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime dflags TFL_GhcSession [soFile] m <- loadDLL hsc_env soFile case m of- Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls }+ Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded
compiler/hieFile/HieAst.hs view
@@ -1,3 +1,6 @@+{-+Main functions for .hie file generation+-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}@@ -20,7 +23,6 @@ import Class ( FunDep ) import CoreUtils ( exprType ) import ConLike ( conLikeName )-import Config ( cProjectVersion ) import Desugar ( deSugarExpr ) import FieldLabel import HsSyn@@ -42,7 +44,6 @@ import qualified Data.Array as A import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC import qualified Data.Map as M import qualified Data.Set as S import Data.Data ( Data, Typeable )@@ -98,9 +99,7 @@ let Just src_file = ml_hs_file $ ms_location ms src <- liftIO $ BS.readFile src_file return $ HieFile- { hie_version = curHieVersion- , hie_ghc_version = BSC.pack cProjectVersion- , hie_hs_file = src_file+ { hie_hs_file = src_file , hie_module = ms_mod ms , hie_types = arr , hie_asts = asts'@@ -479,7 +478,9 @@ in case tyOpt of- _ | skipDesugaring e' -> fallback+ Just t -> makeTypeNode e' spn t+ Nothing+ | skipDesugaring e' -> fallback | otherwise -> do hs_env <- Hsc $ \e w -> return (e,w) (_,mbe) <- liftIO $ deSugarExpr hs_env e
compiler/hieFile/HieBin.hs view
@@ -1,8 +1,11 @@+{-+Binary serialization for .hie files.+-} {-# LANGUAGE ScopedTypeVariables #-}-module HieBin ( readHieFile, writeHieFile, HieName(..), toHieName ) where+module HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic) where +import Config ( cProjectVersion ) import GhcPrelude- import Binary import BinIface ( getDictFastString ) import FastMutInt@@ -14,17 +17,23 @@ import PrelInfo import SrcLoc import UniqSupply ( takeUniqFromSupply )+import Util ( maybeRead ) import Unique import UniqFM import qualified Data.Array as A import Data.IORef+import Data.ByteString ( ByteString )+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC import Data.List ( mapAccumR )-import Data.Word ( Word32 )-import Control.Monad ( replicateM )+import Data.Word ( Word8, Word32 )+import Control.Monad ( replicateM, when ) import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) +import HieTypes+ -- | `Name`'s get converted into `HieName`'s before being written into @.hie@ -- files. See 'toHieName' and 'fromHieName' for logic on how to convert between -- these two types.@@ -63,10 +72,33 @@ initBinMemSize :: Int initBinMemSize = 1024*1024 -writeHieFile :: Binary a => FilePath -> a -> IO ()+-- | The header for HIE files - Capital ASCII letters "HIE".+hieMagic :: [Word8]+hieMagic = [72,73,69]++hieMagicLen :: Int+hieMagicLen = length hieMagic++ghcVersion :: ByteString+ghcVersion = BSC.pack cProjectVersion++putBinLine :: BinHandle -> ByteString -> IO ()+putBinLine bh xs = do+ mapM_ (putByte bh) $ BS.unpack xs+ putByte bh 10 -- newline char++-- | Write a `HieFile` to the given `FilePath`, with a proper header and+-- symbol tables for `Name`s and `FastString`s+writeHieFile :: FilePath -> HieFile -> IO () writeHieFile hie_file_path hiefile = do bh0 <- openBinMem initBinMemSize + -- Write the header: hieHeader followed by the+ -- hieVersion and the GHC version used to generate this file+ mapM_ (putByte bh0) hieMagic+ putBinLine bh0 $ BSC.pack $ show hieVersion+ putBinLine bh0 $ ghcVersion+ -- remember where the dictionary pointer will go dict_p_p <- tellBin bh0 put_ bh0 dict_p_p@@ -105,7 +137,7 @@ symtab_map' <- readIORef symtab_map putSymbolTable bh symtab_next' symtab_map' - -- write the dictionary pointer at the fornt of the file+ -- write the dictionary pointer at the front of the file dict_p <- tellBin bh putAt bh dict_p_p dict_p seekBin bh dict_p@@ -120,9 +152,86 @@ writeBinMem bh hie_file_path return () -readHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache)+data HieFileResult+ = HieFileResult+ { hie_file_result_version :: Integer+ , hie_file_result_ghc_version :: ByteString+ , hie_file_result :: HieFile+ }++type HieHeader = (Integer, ByteString)++-- | Read a `HieFile` from a `FilePath`. Can use+-- an existing `NameCache`. Allows you to specify+-- which versions of hieFile to attempt to read.+-- `Left` case returns the failing header versions.+readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader (HieFileResult, NameCache))+readHieFileWithVersion readVersion nc file = do+ bh0 <- readBinMem file++ (hieVersion, ghcVersion) <- readHieFileHeader file bh0++ if readVersion (hieVersion, ghcVersion)+ then do+ (hieFile, nc') <- readHieFileContents bh0 nc+ return $ Right (HieFileResult hieVersion ghcVersion hieFile, nc')+ else return $ Left (hieVersion, ghcVersion)+++-- | Read a `HieFile` from a `FilePath`. Can use+-- an existing `NameCache`.+readHieFile :: NameCache -> FilePath -> IO (HieFileResult, NameCache) readHieFile nc file = do+ bh0 <- readBinMem file++ (readHieVersion, ghcVersion) <- readHieFileHeader file bh0++ -- Check if the versions match+ when (readHieVersion /= hieVersion) $+ panic $ unwords ["readHieFile: hie file versions don't match for file:"+ , file+ , "Expected"+ , show hieVersion+ , "but got", show readHieVersion+ ]+ (hieFile, nc') <- readHieFileContents bh0 nc+ return $ (HieFileResult hieVersion ghcVersion hieFile, nc')++readBinLine :: BinHandle -> IO ByteString+readBinLine bh = BS.pack . reverse <$> loop []+ where+ loop acc = do+ char <- get bh :: IO Word8+ if char == 10 -- ASCII newline '\n'+ then return acc+ else loop (char : acc)++readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader+readHieFileHeader file bh0 = do+ -- Read the header+ magic <- replicateM hieMagicLen (get bh0)+ version <- BSC.unpack <$> readBinLine bh0+ case maybeRead version of+ Nothing ->+ panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:"+ , show version+ ]+ Just readHieVersion -> do+ ghcVersion <- readBinLine bh0++ -- Check if the header is valid+ when (magic /= hieMagic) $+ panic $ unwords ["readHieFileHeader: headers don't match for file:"+ , file+ , "Expected"+ , show hieMagic+ , "but got", show magic+ ]+ return (readHieVersion, ghcVersion)++readHieFileContents :: BinHandle -> NameCache -> IO (HieFile, NameCache)+readHieFileContents bh0 nc = do dict <- get_dictionary bh0
compiler/hieFile/HieDebug.hs view
@@ -1,3 +1,6 @@+{-+Functions to validate and check .hie file ASTs generated by GHC.+-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}
compiler/hieFile/HieTypes.hs view
@@ -1,3 +1,8 @@+{-+Types for the .hie file format are defined here.++For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files+-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -7,6 +12,7 @@ import GhcPrelude +import Config import Binary import FastString ( FastString ) import IfaceType@@ -28,8 +34,8 @@ type Span = RealSrcSpan -- | Current version of @.hie@ files-curHieVersion :: Word8-curHieVersion = 0+hieVersion :: Integer+hieVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer {- | GHC builds up a wealth of information about Haskell source as it compiles it.@@ -48,13 +54,7 @@ interface than the GHC API. -} data HieFile = HieFile- { hie_version :: Word8- -- ^ version of the HIE format-- , hie_ghc_version :: ByteString- -- ^ Version of GHC that produced this file-- , hie_hs_file :: FilePath+ { hie_hs_file :: FilePath -- ^ Initial Haskell source file path , hie_module :: Module@@ -74,11 +74,8 @@ , hie_hs_src :: ByteString -- ^ Raw bytes of the initial Haskell source }- instance Binary HieFile where put_ bh hf = do- put_ bh $ hie_version hf- put_ bh $ hie_ghc_version hf put_ bh $ hie_hs_file hf put_ bh $ hie_module hf put_ bh $ hie_types hf@@ -88,8 +85,6 @@ get bh = HieFile <$> get bh- <*> get bh- <*> get bh <*> get bh <*> get bh <*> get bh
compiler/main/CodeOutput.hs view
@@ -155,7 +155,7 @@ -> Stream IO RawCmmGroup () -> IO () outputAsm dflags this_mod location filenm cmm_stream- | sGhcWithNativeCodeGen $ settings dflags+ | platformMisc_ghcWithNativeCodeGen $ platformMisc dflags = do ncg_uniqs <- mkSplitUniqSupply 'n' debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)@@ -226,7 +226,7 @@ -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes- | sLibFFI $ settings dflags = "#include \"ffi.h\"\n"+ | platformMisc_libFFI $ platformMisc dflags = "#include \"ffi.h\"\n" | otherwise = "" stub_h_file_exists
compiler/main/DriverPipeline.hs view
@@ -29,6 +29,7 @@ hscPostBackendPhase, getLocation, setModLocation, setDynFlags, runPhase, exeFileName, maybeCreateManifest,+ doCpp, linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode ) where @@ -51,7 +52,7 @@ import DynFlags import Panic import Util-import StringBuffer ( hGetStringBuffer )+import StringBuffer ( hGetStringBuffer, hPutStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) import SrcLoc@@ -59,10 +60,13 @@ import MonadUtils import Platform import TcRnTypes+import ToolSettings import Hooks import qualified GHC.LanguageExtensions as LangExt import FileCleanup import Ar+import Bag ( unitBag )+import FastString ( mkFastString ) import Exception import System.Directory@@ -86,17 +90,28 @@ -- of slurping in the OPTIONS pragmas preprocess :: HscEnv- -> (FilePath, Maybe Phase) -- ^ filename and starting phase- -> IO (DynFlags, FilePath)-preprocess hsc_env (filename, mb_phase) =- ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)- runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase)+ -> FilePath -- ^ input filename+ -> Maybe InputFileBuffer+ -- ^ optional buffer to use instead of reading the input file+ -> Maybe Phase -- ^ starting phase+ -> IO (Either ErrorMessages (DynFlags, FilePath))+preprocess hsc_env input_fn mb_input_buf mb_phase =+ handleSourceError (\err -> return (Left (srcErrorMessages err))) $+ ghandle handler $+ fmap Right $+ ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)+ 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-}+ where+ srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1+ handler (ProgramError msg) = return $ Left $ unitBag $+ mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg+ handler ex = throwGhcExceptionIO ex -- --------------------------------------------------------------------------- @@ -185,6 +200,7 @@ -- handled properly _ <- runPipeline StopLn hsc_env (output_fn,+ Nothing, Just (HscOut src_flavour mod_name HscUpdateSig)) (Just basename)@@ -222,6 +238,7 @@ -- We're in --make mode: finish the compilation pipeline. _ <- runPipeline StopLn hsc_env (output_fn,+ Nothing, Just (HscOut src_flavour mod_name (HscRecomp cgguts summary))) (Just basename) Persistent@@ -319,7 +336,7 @@ LangAsm -> As True -- allow CPP RawObject -> panic "compileForeign: should be unreachable" (_, stub_o) <- runPipeline StopLn hsc_env- (stub_c, Just (RealPhase phase))+ (stub_c, Nothing, Just (RealPhase phase)) Nothing (Temporary TFL_GhcSession) Nothing{-no ModLocation-} []@@ -341,7 +358,7 @@ let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) _ <- runPipeline StopLn hsc_env- (empty_stub, Nothing)+ (empty_stub, Nothing, Nothing) (Just basename) Persistent (Just location)@@ -368,7 +385,7 @@ = lookupHook linkHook l dflags ghcLink dflags where l LinkInMemory _ _ _- = if sGhcWithInterpreter $ settings dflags+ = if platformMisc_ghcWithInterpreter $ platformMisc dflags then -- Not Linking...(demand linker will do the job) return Succeeded else panicBadLink LinkInMemory@@ -528,7 +545,9 @@ | otherwise = Persistent ( _, out_file) <- runPipeline stop_phase hsc_env- (src, fmap RealPhase mb_phase) Nothing output+ (src, Nothing, fmap RealPhase mb_phase)+ Nothing+ output Nothing{-no ModLocation-} [] return out_file @@ -561,13 +580,15 @@ runPipeline :: Phase -- ^ When to stop -> HscEnv -- ^ Compilation environment- -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix)+ -> (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) -- ^ (final flags, output filename)-runPipeline stop_phase hsc_env0 (input_fn, mb_phase)+runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) mb_basename output maybe_loc foreign_os = do let@@ -619,8 +640,22 @@ ++ input_fn)) HscOut {} -> 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 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 dflags 4 (text "Running the pipeline")- r <- runPipeline' start_phase hsc_env env input_fn+ r <- runPipeline' start_phase hsc_env env input_fn' maybe_loc foreign_os -- If we are compiling a Haskell module, and doing@@ -634,7 +669,7 @@ (text "Running the pipeline again for -dynamic-too") let dflags' = dynamicTooMkDynamicDynFlags dflags hsc_env' <- newHscEnv dflags'- _ <- runPipeline' start_phase hsc_env' env input_fn+ _ <- runPipeline' start_phase hsc_env' env input_fn' maybe_loc foreign_os return () return r@@ -1008,8 +1043,11 @@ (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do do buf <- hGetStringBuffer input_fn- (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)- return (Just buf, mod_name, imps, src_imps)+ eimps <- getImports dflags buf input_fn (basename <.> suff)+ case eimps of+ Left errs -> throwErrors 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@@ -1582,7 +1620,7 @@ linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags- mySettings = settings dflags+ toolSettings' = toolSettings dflags verbFlags = getVerbFlags dflags output_fn = exeFileName staticLink dflags @@ -1738,7 +1776,7 @@ -- like -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog -- on x86.- ++ (if sLdSupportsCompactUnwind mySettings &&+ ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' && not staticLink && (platformOS platform == OSDarwin) && case platformArch platform of@@ -1762,7 +1800,7 @@ then ["-Wl,-read_only_relocs,suppress"] else []) - ++ (if sLdIsGnuLd mySettings &&+ ++ (if toolSettings_ldIsGnuLd toolSettings' && not (gopt Opt_WholeArchiveHsLibs dflags) then ["-Wl,--gc-sections"] else [])@@ -1889,7 +1927,7 @@ <$> (Archive <$> mapM loadObj modules) <*> mapM loadAr archives - if sLdIsGnuLd (settings dflags)+ if toolSettings_ldIsGnuLd (toolSettings dflags) then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar @@ -2062,15 +2100,15 @@ joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO () joinObjectFiles dflags o_files output_fn = do- let mySettings = settings dflags- ldIsGnuLd = sLdIsGnuLd mySettings+ let toolSettings' = toolSettings dflags+ ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' osInfo = platformOS (targetPlatform dflags) ld_r args cc = SysTools.runLink dflags ([ SysTools.Option "-nostdlib", SysTools.Option "-Wl,-r" ] -- See Note [No PIE while linking] in DynFlags- ++ (if sGccSupportsNoPie mySettings+ ++ (if toolSettings_ccSupportsNoPie toolSettings' then [SysTools.Option "-no-pie"] else []) @@ -2101,7 +2139,7 @@ -- 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 | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"]+ ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"] | otherwise = [] ccInfo <- getCompilerInfo dflags@@ -2112,7 +2150,7 @@ let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" ld_r [SysTools.FileOption "" script] ccInfo- else if sLdSupportsFilelist mySettings+ else if toolSettings_ldSupportsFilelist toolSettings' then do filelist <- newTempName dflags TFL_CurrentModule "filelist" writeFile filelist $ unlines o_files
compiler/main/GhcMake.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-}-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} -- ----------------------------------------------------------------------------- --@@ -10,9 +10,11 @@ -- -- ----------------------------------------------------------------------------- module GhcMake(- depanal,+ depanal, depanalPartial, load, load', LoadHowMuch(..), + downsweep,+ topSortModuleGraph, ms_home_srcimps, ms_home_imps,@@ -46,7 +48,7 @@ import TcRnMonad ( initIfaceCheck ) import HscMain -import Bag ( listToBag )+import Bag ( unitBag, listToBag, unionManyBags, isEmptyBag ) import BasicTypes import Digraph import Exception ( tryIO, gbracket, gfinally )@@ -80,6 +82,7 @@ import Control.Concurrent.QSem import Control.Exception import Control.Monad+import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) import Data.IORef import Data.List import qualified Data.List as List@@ -119,6 +122,32 @@ -> Bool -- ^ allow duplicate roots -> m ModuleGraph depanal excluded_mods allow_dup_roots = do+ hsc_env <- getSession+ (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots+ if isEmptyBag errs+ then do+ warnMissingHomeModules hsc_env mod_graph+ setSession hsc_env { hsc_mod_graph = mod_graph }+ return mod_graph+ else throwErrors errs+++-- | Perform dependency analysis like 'depanal' but return a partial module+-- graph even in the face of problems with some modules.+--+-- Modules which have parse errors in the module header, failing+-- preprocessors or other issues preventing them from being summarised will+-- simply be absent from the returned module graph.+--+-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the+-- new module graph.+depanalPartial+ :: GhcMonad m+ => [ModuleName] -- ^ excluded modules+ -> Bool -- ^ allow duplicate roots+ -> m (ErrorMessages, ModuleGraph)+ -- ^ possibly empty 'Bag' of errors and a module graph.+depanalPartial excluded_mods allow_dup_roots = do hsc_env <- getSession let dflags = hsc_dflags hsc_env@@ -138,14 +167,10 @@ mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph) excluded_mods allow_dup_roots- mod_summaries <- reportImportErrors mod_summariesE-- let mod_graph = mkModuleGraph mod_summaries-- warnMissingHomeModules hsc_env mod_graph-- setSession hsc_env { hsc_mod_graph = mod_graph }- return mod_graph+ let+ (errs, mod_summaries) = partitionEithers mod_summariesE+ mod_graph = mkModuleGraph mod_summaries+ return (unionManyBags errs, mod_graph) -- Note [Missing home modules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -184,6 +209,10 @@ is_my_target mod (TargetFile target_file _) | Just mod_file <- ml_hs_file (ms_location mod) = target_file == mod_file ||++ -- Don't warn on B.hs-boot if B.hs is specified (#16551)+ addBootSuffix target_file == mod_file ||+ -- We can get a file target even if a module name was -- originally specified in a command line because it can -- be converted in guessTarget (by appending .hs/.lhs).@@ -1906,15 +1935,12 @@ <+> quotes (ppr mod)) -reportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b]+reportImportErrors :: MonadIO m => [Either ErrorMessages b] -> m [b] reportImportErrors xs | null errs = return oks- | otherwise = throwManyErrors errs+ | otherwise = throwErrors $ unionManyBags errs where (errs, oks) = partitionEithers xs -throwManyErrors :: MonadIO m => [ErrMsg] -> m ab-throwManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs - ----------------------------------------------------------------------------- -- -- | Downsweep (dependency analysis)@@ -1937,7 +1963,7 @@ -> Bool -- True <=> allow multiple targets to have -- the same module name; this is -- very useful for ghc -M- -> IO [Either ErrMsg ModSummary]+ -> IO [Either ErrorMessages ModSummary] -- The elts of [ModSummary] all have distinct -- (Modules, IsBoot) identifiers, unless the Bool is true -- in which case there can be repeats@@ -1954,11 +1980,11 @@ -- See Note [-fno-code mode] #8025 map1 <- if hscTarget dflags == HscNothing then enableCodeGenForTH- (defaultObjectTarget (settings dflags))+ (defaultObjectTarget dflags) map0 else if hscTarget dflags == HscInterpreted then enableCodeGenForUnboxedTuples- (defaultObjectTarget (settings dflags))+ (defaultObjectTarget dflags) map0 else return map0 return $ concat $ nodeMapElts map1@@ -1971,13 +1997,13 @@ old_summary_map :: NodeMap ModSummary old_summary_map = mkNodeMap old_summaries - getRootSummary :: Target -> IO (Either ErrMsg ModSummary)+ getRootSummary :: Target -> IO (Either ErrorMessages ModSummary) getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) = do exists <- liftIO $ doesFileExist file- if exists- then Right `fmap` summariseFile hsc_env old_summaries file mb_phase+ if exists || isJust maybe_buf+ then summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf- else return $ Left $ mkPlainErrMsg dflags noSrcSpan $+ else return $ Left $ unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "can't find file:" <+> text file getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf) = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot@@ -1993,7 +2019,7 @@ -- name, so we have to check that there aren't multiple root files -- defining the same module (otherwise the duplicates will be silently -- ignored, leading to confusing behaviour).- checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO ()+ checkDuplicates :: NodeMap [Either ErrorMessages ModSummary] -> IO () checkDuplicates root_map | allow_dup_roots = return () | null dup_roots = return ()@@ -2004,11 +2030,11 @@ loop :: [(Located ModuleName,IsBoot)] -- Work list: process these modules- -> NodeMap [Either ErrMsg ModSummary]+ -> NodeMap [Either ErrorMessages ModSummary] -- Visited set; the range is a list because -- the roots can have the same module names -- if allow_dup_roots is True- -> IO (NodeMap [Either ErrMsg ModSummary])+ -> IO (NodeMap [Either ErrorMessages ModSummary]) -- The result is the completed NodeMap loop [] done = return done loop ((wanted_mod, is_boot) : ss) done@@ -2037,8 +2063,8 @@ -- and .o file locations to be temporary files. -- See Note [-fno-code mode] enableCodeGenForTH :: HscTarget- -> NodeMap [Either ErrMsg ModSummary]- -> IO (NodeMap [Either ErrMsg ModSummary])+ -> NodeMap [Either ErrorMessages ModSummary]+ -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForTH = enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession where@@ -2057,8 +2083,8 @@ -- This is used used in order to load code that uses unboxed tuples -- into GHCi while still allowing some code to be interpreted. enableCodeGenForUnboxedTuples :: HscTarget- -> NodeMap [Either ErrMsg ModSummary]- -> IO (NodeMap [Either ErrMsg ModSummary])+ -> NodeMap [Either ErrorMessages ModSummary]+ -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenForUnboxedTuples = enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule where@@ -2080,8 +2106,8 @@ -> TempFileLifetime -> TempFileLifetime -> HscTarget- -> NodeMap [Either ErrMsg ModSummary]- -> IO (NodeMap [Either ErrMsg ModSummary])+ -> NodeMap [Either ErrorMessages ModSummary]+ -> IO (NodeMap [Either ErrorMessages ModSummary]) enableCodeGenWhen condition should_modify staticLife dynLife target nodemap = traverse (traverse (traverse enable_code_gen)) nodemap where@@ -2143,7 +2169,7 @@ new_marked_mods = Set.insert ms_mod marked_mods in foldl' go new_marked_mods deps -mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary]+mkRootMap :: [ModSummary] -> NodeMap [Either ErrorMessages ModSummary] mkRootMap summaries = Map.insertListWith (flip (++)) [ (msKey s, [Right s]) | s <- summaries ] Map.empty@@ -2203,13 +2229,13 @@ -> Maybe Phase -- start phase -> Bool -- object code allowed? -> Maybe (StringBuffer,UTCTime)- -> IO ModSummary+ -> IO (Either ErrorMessages ModSummary) -summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf+summariseFile hsc_env old_summaries src_fn mb_phase obj_allowed maybe_buf -- we can use a cached summary if one is available and the -- source file hasn't changed, But we have to look up the summary -- by source file, rather than module name as we do in summarise.- | Just old_summary <- findSummaryBySourceFile old_summaries file+ | Just old_summary <- findSummaryBySourceFile old_summaries src_fn = do let location = ms_location old_summary dflags = hsc_dflags hsc_env@@ -2221,82 +2247,44 @@ -- behaviour. -- return the cached summary if the source didn't change- if ms_hs_date old_summary == src_timestamp &&- not (gopt Opt_ForceRecomp (hsc_dflags hsc_env))- then do -- update the object-file timestamp- obj_timestamp <-- if isObjectTarget (hscTarget (hsc_dflags hsc_env))- || obj_allowed -- bug #1205- then liftIO $ getObjTimestamp location NotBoot- else return Nothing- hi_timestamp <- maybeGetIfaceDate dflags location- let hie_location = ml_hie_file location- hie_timestamp <- modificationTimeIfExists hie_location-- -- We have to repopulate the Finder's cache because it- -- was flushed before the downsweep.- _ <- liftIO $ addHomeModuleToFinder hsc_env- (moduleName (ms_mod old_summary)) (ms_location old_summary)-- return old_summary{ ms_obj_date = obj_timestamp- , ms_iface_date = hi_timestamp- , ms_hie_date = hie_timestamp }- else- new_summary src_timestamp+ checkSummaryTimestamp+ hsc_env dflags obj_allowed NotBoot (new_summary src_fn)+ old_summary location src_timestamp | otherwise = do src_timestamp <- get_src_timestamp- new_summary src_timestamp+ new_summary src_fn src_timestamp where get_src_timestamp = case maybe_buf of Just (_,t) -> return t- Nothing -> liftIO $ getModificationUTCTime file+ Nothing -> liftIO $ getModificationUTCTime src_fn -- getModificationUTCTime may fail - new_summary src_timestamp = do- let dflags = hsc_dflags hsc_env+ new_summary src_fn src_timestamp = runExceptT $ do+ preimps@PreprocessedImports {..}+ <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf - let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile - (dflags', hspp_fn, buf)- <- preprocessFile hsc_env file mb_phase maybe_buf-- (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file- -- Make a ModLocation for this file- location <- liftIO $ mkHomeModLocation dflags mod_name file+ location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) 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- mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location-- -- when the user asks to load a source file by name, we only- -- use an object file if -fobject-code is on. See #1205.- obj_timestamp <-- if isObjectTarget (hscTarget (hsc_dflags hsc_env))- || obj_allowed -- bug #1205- then liftIO $ modificationTimeIfExists (ml_obj_file location)- else return Nothing-- hi_timestamp <- maybeGetIfaceDate dflags location- hie_timestamp <- modificationTimeIfExists (ml_hie_file location)-- extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name- required_by_imports <- implicitRequirements hsc_env the_imps+ mod <- liftIO $ addHomeModuleToFinder hsc_env pi_mod_name location - return (ModSummary { ms_mod = mod,- ms_hsc_src = hsc_src,- ms_location = location,- ms_hspp_file = hspp_fn,- ms_hspp_opts = dflags',- ms_hspp_buf = Just buf,- ms_parsed_mod = Nothing,- ms_srcimps = srcimps,- ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,- ms_hs_date = src_timestamp,- ms_iface_date = hi_timestamp,- ms_hie_date = hie_timestamp,- ms_obj_date = obj_timestamp })+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary+ { nms_src_fn = src_fn+ , nms_src_timestamp = src_timestamp+ , nms_is_boot = NotBoot+ , nms_hsc_src =+ if isHaskellSigFilename src_fn+ then HsigFile+ else HsSrcFile+ , nms_location = location+ , nms_mod = mod+ , nms_obj_allowed = obj_allowed+ , nms_preimps = preimps+ } findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary findSummaryBySourceFile summaries file@@ -2305,6 +2293,44 @@ [] -> Nothing (x:_) -> Just x +checkSummaryTimestamp+ :: HscEnv -> DynFlags -> Bool -> IsBoot+ -> (UTCTime -> IO (Either e ModSummary))+ -> ModSummary -> ModLocation -> UTCTime+ -> IO (Either e ModSummary)+checkSummaryTimestamp+ hsc_env dflags obj_allowed is_boot new_summary+ old_summary location src_timestamp+ | ms_hs_date old_summary == src_timestamp &&+ not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do+ -- update the object-file timestamp+ obj_timestamp <-+ if isObjectTarget (hscTarget (hsc_dflags hsc_env))+ || obj_allowed -- bug #1205+ then liftIO $ getObjTimestamp location is_boot+ else return Nothing++ -- We have to repopulate the Finder's cache for file targets+ -- because the file might not even be on the regular serach path+ -- and it was likely flushed in depanal. This is not technically+ -- needed when we're called from sumariseModule but it shouldn't+ -- hurt.+ _ <- addHomeModuleToFinder hsc_env+ (moduleName (ms_mod old_summary)) location++ hi_timestamp <- maybeGetIfaceDate dflags location+ hie_timestamp <- modificationTimeIfExists (ml_hie_file location)++ return $ Right old_summary+ { ms_obj_date = obj_timestamp+ , ms_iface_date = hi_timestamp+ , ms_hie_date = hie_timestamp+ }++ | otherwise =+ -- source changed: re-summarise.+ new_summary src_timestamp+ -- Summarise a module, and pick up source and timestamp. summariseModule :: HscEnv@@ -2314,7 +2340,7 @@ -> Bool -- object code allowed? -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -- Modules to exclude- -> IO (Maybe (Either ErrMsg ModSummary)) -- Its new summary+ -> IO (Maybe (Either ErrorMessages ModSummary)) -- Its new summary summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) obj_allowed maybe_buf excl_mods@@ -2331,11 +2357,13 @@ -- return the cached summary if it hasn't changed. If the -- file has disappeared, we need to call the Finder again. case maybe_buf of- Just (_,t) -> check_timestamp old_summary location src_fn t+ Just (_,t) ->+ Just <$> check_timestamp old_summary location src_fn t Nothing -> do m <- tryIO (getModificationUTCTime src_fn) case m of- Right t -> check_timestamp old_summary location src_fn t+ Right t ->+ Just <$> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it | otherwise -> ioError e @@ -2343,23 +2371,11 @@ where dflags = hsc_dflags hsc_env - check_timestamp old_summary location src_fn src_timestamp- | ms_hs_date old_summary == src_timestamp &&- not (gopt Opt_ForceRecomp dflags) = do- -- update the object-file timestamp- obj_timestamp <-- if isObjectTarget (hscTarget (hsc_dflags hsc_env))- || obj_allowed -- bug #1205- then getObjTimestamp location is_boot- else return Nothing- hi_timestamp <- maybeGetIfaceDate dflags location- hie_timestamp <- modificationTimeIfExists (ml_hie_file location)- return (Just (Right old_summary{ ms_obj_date = obj_timestamp- , ms_iface_date = hi_timestamp- , ms_hie_date = hie_timestamp }))- | otherwise =- -- source changed: re-summarise.- new_summary location (ms_mod old_summary) src_fn src_timestamp+ check_timestamp old_summary location src_fn =+ checkSummaryTimestamp+ hsc_env dflags obj_allowed is_boot+ (new_summary location (ms_mod old_summary) src_fn)+ old_summary location find_it = do found <- findImportedModule hsc_env wanted_mod Nothing@@ -2367,7 +2383,7 @@ Found location mod | isJust (ml_hs_file location) -> -- Home package- just_found location mod+ Just <$> just_found location mod _ -> return Nothing -- Not found@@ -2385,16 +2401,13 @@ -- It might have been deleted since the Finder last found it maybe_t <- modificationTimeIfExists src_fn case maybe_t of- Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn+ Nothing -> return $ Left $ noHsFileErr dflags loc src_fn Just t -> new_summary location' mod src_fn t - new_summary location mod src_fn src_timestamp- = do- -- Preprocess the source file and get its imports- -- The dflags' contains the OPTIONS pragmas- (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf- (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn+ = runExceptT $ do+ preimps@PreprocessedImports {..}+ <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf -- NB: Despite the fact that is_boot is a top-level parameter, we -- don't actually know coming into this function what the HscSource@@ -2408,97 +2421,123 @@ _ | isHaskellSigFilename src_fn -> HsigFile | otherwise -> HsSrcFile - when (mod_name /= wanted_mod) $- throwOneError $ mkPlainErrMsg dflags' mod_loc $+ when (pi_mod_name /= wanted_mod) $+ throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $ text "File name does not match module name:"- $$ text "Saw:" <+> quotes (ppr mod_name)+ $$ text "Saw:" <+> quotes (ppr pi_mod_name) $$ text "Expected:" <+> quotes (ppr wanted_mod) - when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $+ when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $ let suggested_instantiated_with = hcat (punctuate comma $ [ ppr k <> text "=" <> ppr v- | (k,v) <- ((mod_name, mkHoleModule mod_name)+ | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : thisUnitIdInsts dflags) ])- in throwOneError $ mkPlainErrMsg dflags' mod_loc $- text "Unexpected signature:" <+> quotes (ppr mod_name)+ in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $+ text "Unexpected signature:" <+> quotes (ppr pi_mod_name) $$ if gopt Opt_BuildingCabalPackage dflags- then parens (text "Try adding" <+> quotes (ppr mod_name)+ then parens (text "Try adding" <+> quotes (ppr pi_mod_name) <+> text "to the" <+> quotes (text "signatures") <+> text "field in your Cabal file.") else parens (text "Try passing -instantiated-with=\"" <> suggested_instantiated_with <> text "\"" $$- text "replacing <" <> ppr mod_name <> text "> as necessary.")+ text "replacing <" <> ppr pi_mod_name <> text "> as necessary.") - -- Find the object timestamp, and return the summary- obj_timestamp <-- if isObjectTarget (hscTarget (hsc_dflags hsc_env))- || obj_allowed -- bug #1205- then getObjTimestamp location is_boot- else return Nothing+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary+ { nms_src_fn = src_fn+ , nms_src_timestamp = src_timestamp+ , nms_is_boot = is_boot+ , nms_hsc_src = hsc_src+ , nms_location = location+ , nms_mod = mod+ , nms_obj_allowed = obj_allowed+ , nms_preimps = preimps+ } - hi_timestamp <- maybeGetIfaceDate dflags location- hie_timestamp <- modificationTimeIfExists (ml_hie_file location)+-- | Convenience named arguments for 'makeNewModSummary' only used to make+-- code more readable, not exported.+data MakeNewModSummary+ = MakeNewModSummary+ { nms_src_fn :: FilePath+ , nms_src_timestamp :: UTCTime+ , nms_is_boot :: IsBoot+ , nms_hsc_src :: HscSource+ , nms_location :: ModLocation+ , nms_mod :: Module+ , nms_obj_allowed :: Bool+ , nms_preimps :: PreprocessedImports+ } - extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name- required_by_imports <- implicitRequirements hsc_env the_imps+makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary+makeNewModSummary hsc_env MakeNewModSummary{..} = do+ let PreprocessedImports{..} = nms_preimps+ let dflags = hsc_dflags hsc_env - return (Just (Right (ModSummary { ms_mod = mod,- ms_hsc_src = hsc_src,- ms_location = location,- ms_hspp_file = hspp_fn,- ms_hspp_opts = dflags',- ms_hspp_buf = Just buf,- ms_parsed_mod = Nothing,- ms_srcimps = srcimps,- ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,- ms_hs_date = src_timestamp,- ms_iface_date = hi_timestamp,- ms_hie_date = hie_timestamp,- ms_obj_date = obj_timestamp })))+ -- when the user asks to load a source file by name, we only+ -- use an object file if -fobject-code is on. See #1205.+ obj_timestamp <- liftIO $+ if isObjectTarget (hscTarget dflags)+ || nms_obj_allowed -- bug #1205+ then getObjTimestamp nms_location nms_is_boot+ else return Nothing + hi_timestamp <- maybeGetIfaceDate dflags nms_location+ hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) + extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name+ required_by_imports <- implicitRequirements hsc_env pi_theimps++ return $ ModSummary+ { ms_mod = nms_mod+ , ms_hsc_src = nms_hsc_src+ , ms_location = nms_location+ , ms_hspp_file = pi_hspp_fn+ , ms_hspp_opts = pi_local_dflags+ , ms_hspp_buf = Just pi_hspp_buf+ , ms_parsed_mod = Nothing+ , ms_srcimps = pi_srcimps+ , ms_textual_imps =+ pi_theimps ++ extra_sig_imports ++ required_by_imports+ , ms_hs_date = nms_src_timestamp+ , ms_iface_date = hi_timestamp+ , ms_hie_date = hie_timestamp+ , ms_obj_date = obj_timestamp+ }+ getObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime) getObjTimestamp location is_boot = if is_boot == IsBoot then return Nothing else modificationTimeIfExists (ml_obj_file location) --preprocessFile :: HscEnv- -> FilePath- -> Maybe Phase -- ^ Starting phase- -> Maybe (StringBuffer,UTCTime)- -> IO (DynFlags, FilePath, StringBuffer)-preprocessFile hsc_env src_fn mb_phase Nothing- = do- (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)- buf <- hGetStringBuffer hspp_fn- return (dflags', hspp_fn, buf)--preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))- = do- let dflags = hsc_dflags hsc_env- let local_opts = getOptions dflags buf src_fn-- (dflags', leftovers, warns)- <- parseDynamicFilePragma dflags local_opts- checkProcessArgsResult dflags leftovers- handleFlagWarnings dflags' warns-- let needs_preprocessing- | Just (Unlit _) <- mb_phase = True- | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True- -- note: local_opts is only required if there's no Unlit phase- | xopt LangExt.Cpp dflags' = True- | gopt Opt_Pp dflags' = True- | otherwise = False-- when needs_preprocessing $- throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled")+data PreprocessedImports+ = PreprocessedImports+ { pi_local_dflags :: DynFlags+ , pi_srcimps :: [(Maybe FastString, Located ModuleName)]+ , pi_theimps :: [(Maybe FastString, Located ModuleName)]+ , pi_hspp_fn :: FilePath+ , pi_hspp_buf :: StringBuffer+ , pi_mod_name_loc :: SrcSpan+ , pi_mod_name :: ModuleName+ } - return (dflags', src_fn, buf)+-- Preprocess the source file and get its imports+-- The pi_local_dflags contains the OPTIONS pragmas+getPreprocessedImports+ :: HscEnv+ -> FilePath+ -> Maybe Phase+ -> Maybe (StringBuffer, UTCTime)+ -- ^ optional source code buffer and modification time+ -> ExceptT ErrorMessages IO PreprocessedImports+getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do+ (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)+ <- ExceptT $ getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn+ return PreprocessedImports {..} -----------------------------------------------------------------------------@@ -2545,13 +2584,13 @@ noModError dflags loc wanted_mod err = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err -noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg+noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrorMessages noHsFileErr dflags loc path- = mkPlainErrMsg dflags loc $ text "Can't find" <+> text path+ = unitBag $ mkPlainErrMsg dflags loc $ text "Can't find" <+> text path -moduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg+moduleNotFoundErr :: DynFlags -> ModuleName -> ErrorMessages moduleNotFoundErr dflags mod- = mkPlainErrMsg dflags noSrcSpan $+ = unitBag $ mkPlainErrMsg dflags noSrcSpan $ text "module" <+> quotes (ppr mod) <+> text "cannot be found locally" multiRootsErr :: DynFlags -> [ModSummary] -> IO ()
− compiler/main/HeaderInfo.hs
@@ -1,352 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeFamilies #-}------------------------------------------------------------------------------------- | Parsing the top of a Haskell source file to get its module name,--- imports and options.------ (c) Simon Marlow 2005--- (c) Lemmih 2006-----------------------------------------------------------------------------------module HeaderInfo ( getImports- , mkPrelImports -- used by the renamer too- , getOptionsFromFile, getOptions- , optionsErrorMsgs,- checkProcessArgsResult ) where--#include "HsVersions.h"--import GhcPrelude--import HscTypes-import Parser ( parseHeader )-import Lexer-import FastString-import HsSyn-import Module-import PrelNames-import StringBuffer-import SrcLoc-import DynFlags-import ErrUtils-import Util-import Outputable-import Pretty ()-import Maybes-import Bag ( emptyBag, listToBag, unitBag )-import MonadUtils-import Exception-import BasicTypes-import qualified GHC.LanguageExtensions as LangExt--import Control.Monad-import System.IO-import System.IO.Unsafe-import Data.List------------------------------------------------------------------------------------ | Parse the imports of a source file.------ Throws a 'SourceError' if parsing fails.-getImports :: DynFlags- -> StringBuffer -- ^ Parse this.- -> FilePath -- ^ Filename the buffer came from. Used for- -- reporting parse error locations.- -> FilePath -- ^ The original source filename (used for locations- -- in the function result)- -> IO ([(Maybe FastString, Located ModuleName)],- [(Maybe FastString, Located ModuleName)],- Located ModuleName)- -- ^ The source imports, normal imports, and the module name.-getImports dflags buf filename source_filename = do- let loc = mkRealSrcLoc (mkFastString filename) 1 1- case unP parseHeader (mkPState dflags buf loc) of- PFailed pst -> do- -- assuming we're not logging warnings here as per below- throwErrors (getErrorMessages pst dflags)- POk pst rdr_module -> do- let _ms@(_warns, errs) = getMessages pst dflags- -- don't log warnings: they'll be reported when we parse the file- -- for real. See #2500.- ms = (emptyBag, errs)- -- logWarnings warns- if errorsFound dflags ms- then throwIO $ mkSrcErr errs- else- let hsmod = unLoc rdr_module- mb_mod = hsmodName hsmod- imps = hsmodImports hsmod- main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)- 1 1)- mod = mb_mod `orElse` cL main_loc mAIN_NAME- (src_idecls, ord_idecls) = partition (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-- implicit_prelude = xopt LangExt.ImplicitPrelude dflags- implicit_imports = mkPrelImports (unLoc mod) main_loc- implicit_prelude imps- convImport (dL->L _ i) = (fmap sl_fs (ideclPkgQual i)- , ideclName i)- in- return (map convImport src_idecls,- map convImport (implicit_imports ++ ordinary_imps),- mod)--mkPrelImports :: ModuleName- -> SrcSpan -- Attribute the "import Prelude" to this location- -> Bool -> [LImportDecl GhcPs]- -> [LImportDecl GhcPs]--- Construct the implicit declaration "import Prelude" (or not)------ NB: opt_NoImplicitPrelude is slightly different to import Prelude ();--- because the former doesn't even look at Prelude.hi for instance--- declarations, whereas the latter does.-mkPrelImports this_mod loc implicit_prelude import_decls- | this_mod == pRELUDE_NAME- || explicit_prelude_import- || not implicit_prelude- = []- | otherwise = [preludeImportDecl]- where- explicit_prelude_import- = notNull [ () | (dL->L _ (ImportDecl { ideclName = mod- , ideclPkgQual = Nothing }))- <- import_decls- , unLoc mod == pRELUDE_NAME ]-- preludeImportDecl :: LImportDecl GhcPs- preludeImportDecl- = cL loc $ ImportDecl { ideclExt = noExt,- ideclSourceSrc = NoSourceText,- ideclName = cL loc pRELUDE_NAME,- ideclPkgQual = Nothing,- ideclSource = False,- ideclSafe = False, -- Not a safe import- ideclQualified = NotQualified,- ideclImplicit = True, -- Implicit!- ideclAs = Nothing,- ideclHiding = Nothing }------------------------------------------------------------------- Get options------------------------------------------------------------------- | Parse OPTIONS and LANGUAGE pragmas of the source file.------ Throws a 'SourceError' if flag parsing fails (including unsupported flags.)-getOptionsFromFile :: DynFlags- -> FilePath -- ^ Input file- -> IO [Located String] -- ^ Parsed options, if any.-getOptionsFromFile dflags filename- = Exception.bracket- (openBinaryFile filename ReadMode)- (hClose)- (\handle -> do- opts <- fmap (getOptions' dflags)- (lazyGetToks dflags' filename handle)- seqList opts $ return opts)- where -- We don't need to get haddock doc tokens when we're just- -- getting the options from pragmas, and lazily lexing them- -- correctly is a little tricky: If there is "\n" or "\n-"- -- left at the end of a buffer then the haddock doc may- -- continue past the end of the buffer, despite the fact that- -- we already have an apparently-complete token.- -- We therefore just turn Opt_Haddock off when doing the lazy- -- lex.- dflags' = gopt_unset dflags Opt_Haddock--blockSize :: Int--- blockSize = 17 -- for testing :-)-blockSize = 1024--lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]-lazyGetToks dflags filename handle = do- buf <- hGetStringBufferBlock handle blockSize- unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize- where- loc = mkRealSrcLoc (mkFastString filename) 1 1-- lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]- lazyLexBuf handle state eof size = do- case unP (lexer False return) state of- POk state' t -> do- -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())- if atEnd (buffer state') && not eof- -- if this token reached the end of the buffer, and we haven't- -- necessarily read up to the end of the file, then the token might- -- be truncated, so read some more of the file and lex it again.- then getMore handle state size- else case unLoc t of- ITeof -> return [t]- _other -> do rest <- lazyLexBuf handle state' eof size- return (t : rest)- _ | not eof -> getMore handle state size- | otherwise -> return [cL (RealSrcSpan (last_loc state)) ITeof]- -- parser assumes an ITeof sentinel at the end-- getMore :: Handle -> PState -> Int -> IO [Located Token]- getMore handle state size = do- -- pprTrace "getMore" (text (show (buffer state))) (return ())- let new_size = size * 2- -- double the buffer size each time we read a new block. This- -- counteracts the quadratic slowdown we otherwise get for very- -- large module names (#5981)- nextbuf <- hGetStringBufferBlock handle new_size- if (len nextbuf == 0) then lazyLexBuf handle state True new_size else do- newbuf <- appendStringBuffers (buffer state) nextbuf- unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size---getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]-getToks dflags filename buf = lexAll (pragState dflags buf loc)- where- loc = mkRealSrcLoc (mkFastString filename) 1 1-- lexAll state = case unP (lexer False return) state of- POk _ t@(dL->L _ ITeof) -> [t]- POk state' t -> t : lexAll state'- _ -> [cL (RealSrcSpan (last_loc state)) ITeof]----- | Parse OPTIONS and LANGUAGE pragmas of the source file.------ Throws a 'SourceError' if flag parsing fails (including unsupported flags.)-getOptions :: DynFlags- -> StringBuffer -- ^ Input Buffer- -> FilePath -- ^ Source filename. Used for location info.- -> [Located String] -- ^ Parsed options.-getOptions dflags buf filename- = getOptions' dflags (getToks dflags filename buf)---- The token parser is written manually because Happy can't--- return a partial result when it encounters a lexer error.--- We want to extract options before the buffer is passed through--- CPP, so we can't use the same trick as 'getImports'.-getOptions' :: DynFlags- -> [Located Token] -- Input buffer- -> [Located String] -- Options.-getOptions' dflags toks- = parseToks toks- where- parseToks (open:close:xs)- | IToptions_prag str <- unLoc open- , ITclose_prag <- unLoc close- = case toArgs str of- Left _err -> optionsParseError str dflags $ -- #15053- combineSrcSpans (getLoc open) (getLoc close)- Right args -> map (cL (getLoc open)) args ++ parseToks xs- parseToks (open:close:xs)- | ITinclude_prag str <- unLoc open- , ITclose_prag <- unLoc close- = map (cL (getLoc open)) ["-#include",removeSpaces str] ++- parseToks xs- parseToks (open:close:xs)- | ITdocOptions str <- unLoc open- , ITclose_prag <- unLoc close- = map (cL (getLoc open)) ["-haddock-opts", removeSpaces str]- ++ parseToks xs- parseToks (open:xs)- | ITlanguage_prag <- unLoc open- = parseLanguage xs- parseToks (comment:xs) -- Skip over comments- | isComment (unLoc comment)- = parseToks xs- parseToks _ = []- parseLanguage ((dL->L loc (ITconid fs)):rest)- = checkExtension dflags (cL loc fs) :- case rest of- (dL->L _loc ITcomma):more -> parseLanguage more- (dL->L _loc ITclose_prag):more -> parseToks more- (dL->L loc _):_ -> languagePragParseError dflags loc- [] -> panic "getOptions'.parseLanguage(1) went past eof token"- parseLanguage (tok:_)- = languagePragParseError dflags (getLoc tok)- parseLanguage []- = panic "getOptions'.parseLanguage(2) went past eof token"-- isComment :: Token -> Bool- isComment c =- case c of- (ITlineComment {}) -> True- (ITblockComment {}) -> True- (ITdocCommentNext {}) -> True- (ITdocCommentPrev {}) -> True- (ITdocCommentNamed {}) -> True- (ITdocSection {}) -> True- _ -> False----------------------------------------------------------------------------------- | Complain about non-dynamic flags in OPTIONS pragmas.------ Throws a 'SourceError' if the input list is non-empty claiming that the--- input flags are unknown.-checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()-checkProcessArgsResult dflags flags- = when (notNull flags) $- liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags- where mkMsg (dL->L loc flag)- = mkPlainErrMsg dflags loc $- (text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+>- text flag)---------------------------------------------------------------------------------checkExtension :: DynFlags -> Located FastString -> Located String-checkExtension dflags (dL->L l ext)--- Checks if a given extension is valid, and if so returns--- its corresponding flag. Otherwise it throws an exception.- = let ext' = unpackFS ext in- if ext' `elem` supportedLanguagesAndExtensions- then cL l ("-X"++ext')- else unsupportedExtnError dflags l ext'--languagePragParseError :: DynFlags -> SrcSpan -> a-languagePragParseError dflags loc =- throwErr dflags loc $- vcat [ text "Cannot parse LANGUAGE pragma"- , text "Expecting comma-separated list of language options,"- , text "each starting with a capital letter"- , nest 2 (text "E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]--unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a-unsupportedExtnError dflags loc unsup =- throwErr dflags loc $- text "Unsupported extension: " <> text unsup $$- if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)- where- suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions---optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages-optionsErrorMsgs dflags unhandled_flags flags_lines _filename- = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))- where unhandled_flags_lines :: [Located String]- unhandled_flags_lines = [ cL l f- | f <- unhandled_flags- , (dL->L l f') <- flags_lines- , f == f' ]- mkMsg (dL->L flagSpan flag) =- ErrUtils.mkPlainErrMsg dflags flagSpan $- text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag--optionsParseError :: String -> DynFlags -> SrcSpan -> a -- #15053-optionsParseError str dflags loc =- throwErr dflags loc $- vcat [ text "Error while parsing OPTIONS_GHC pragma."- , text "Expecting whitespace-separated list of GHC options."- , text " E.g. {-# OPTIONS_GHC -Wall -O2 #-}"- , text ("Input was: " ++ show str) ]--throwErr :: DynFlags -> SrcSpan -> SDoc -> a -- #15053-throwErr dflags loc doc =- throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc
compiler/main/HscMain.hs view
@@ -174,7 +174,7 @@ import HieAst ( mkHieFile ) import HieTypes ( getAsts, hie_asts )-import HieBin ( readHieFile, writeHieFile )+import HieBin ( readHieFile, writeHieFile , hie_file_result) import HieDebug ( diffFile, validateScopes ) #include "HsVersions.h"@@ -434,7 +434,7 @@ -- Roundtrip testing nc <- readIORef $ hsc_NC hs_env (file', _) <- readHieFile nc out_file- case diffFile hieFile file' of+ case diffFile hieFile (hie_file_result file') of [] -> putMsg dflags $ text "Got no roundtrip errors" xs -> do
compiler/main/SysTools.hs view
@@ -49,6 +49,7 @@ import Util import DynFlags import Fingerprint+import ToolSettings import System.FilePath import System.IO@@ -282,70 +283,84 @@ ghcDebugged <- getBooleanSetting "Use Debugging" ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw" - return $ Settings {- sTargetPlatform = platform,- sTmpDir = normalise tmpdir,- sGhcUsagePath = ghc_usage_msg_path,- sGhciUsagePath = ghci_usage_msg_path,- sToolDir = mtool_dir,- sTopDir = top_dir,- sRawSettings = mySettings,- sExtraGccViaCFlags = words myExtraGccViaCFlags,- sSystemPackageConfig = pkgconfig_path,- sLdSupportsCompactUnwind = ldSupportsCompactUnwind,- sLdSupportsBuildId = ldSupportsBuildId,- sLdSupportsFilelist = ldSupportsFilelist,- sLdIsGnuLd = ldIsGnuLd,- sGccSupportsNoPie = gccSupportsNoPie,- sProgramName = "ghc",- sProjectVersion = cProjectVersion,- sPgm_L = unlit_path,- sPgm_P = (cpp_prog, cpp_args),- sPgm_F = "",- sPgm_c = (gcc_prog, gcc_args),- sPgm_a = (as_prog, as_args),- sPgm_l = (ld_prog, ld_args),- sPgm_dll = (mkdll_prog,mkdll_args),- sPgm_T = touch_path,- sPgm_windres = windres_path,- sPgm_libtool = libtool_path,- sPgm_ar = ar_path,- sPgm_ranlib = ranlib_path,- sPgm_lo = (lo_prog,[]),- sPgm_lc = (lc_prog,[]),- sPgm_lcc = (lcc_prog,[]),- sPgm_i = iserv_prog,- sOpt_L = [],- sOpt_P = [],- sOpt_P_fingerprint = fingerprint0,- sOpt_F = [],- sOpt_c = [],- sOpt_cxx = [],- sOpt_a = [],- sOpt_l = [],- sOpt_windres = [],- sOpt_lcc = [],- sOpt_lo = [],- sOpt_lc = [],- sOpt_i = [],- sPlatformConstants = platformConstants,+ return $ Settings+ { sGhcNameVersion = GhcNameVersion+ { ghcNameVersion_programName = "ghc"+ , ghcNameVersion_projectVersion = cProjectVersion+ } - sTargetPlatformString = targetPlatformString,- sIntegerLibrary = integerLibrary,- sIntegerLibraryType = integerLibraryType,- sGhcWithInterpreter = ghcWithInterpreter,- sGhcWithNativeCodeGen = ghcWithNativeCodeGen,- sGhcWithSMP = ghcWithSMP,- sGhcRTSWays = ghcRTSWays,- sTablesNextToCode = tablesNextToCode,- sLeadingUnderscore = leadingUnderscore,- sLibFFI = useLibFFI,- sGhcThreaded = ghcThreaded,- sGhcDebugged = ghcDebugged,- sGhcRtsWithLibdw = ghcRtsWithLibdw- }+ , sFileSettings = FileSettings+ { fileSettings_tmpDir = normalise tmpdir+ , fileSettings_ghcUsagePath = ghc_usage_msg_path+ , fileSettings_ghciUsagePath = ghci_usage_msg_path+ , fileSettings_toolDir = mtool_dir+ , fileSettings_topDir = top_dir+ , fileSettings_systemPackageConfig = pkgconfig_path+ } + , sToolSettings = ToolSettings+ { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind+ , toolSettings_ldSupportsBuildId = ldSupportsBuildId+ , toolSettings_ldSupportsFilelist = ldSupportsFilelist+ , toolSettings_ldIsGnuLd = ldIsGnuLd+ , toolSettings_ccSupportsNoPie = gccSupportsNoPie + , toolSettings_pgm_L = unlit_path+ , toolSettings_pgm_P = (cpp_prog, cpp_args)+ , toolSettings_pgm_F = ""+ , toolSettings_pgm_c = (gcc_prog, gcc_args)+ , toolSettings_pgm_a = (as_prog, as_args)+ , toolSettings_pgm_l = (ld_prog, ld_args)+ , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)+ , toolSettings_pgm_T = touch_path+ , toolSettings_pgm_windres = windres_path+ , toolSettings_pgm_libtool = libtool_path+ , toolSettings_pgm_ar = ar_path+ , toolSettings_pgm_ranlib = ranlib_path+ , toolSettings_pgm_lo = (lo_prog,[])+ , toolSettings_pgm_lc = (lc_prog,[])+ , toolSettings_pgm_lcc = (lcc_prog,[])+ , toolSettings_pgm_i = iserv_prog+ , toolSettings_opt_L = []+ , toolSettings_opt_P = []+ , toolSettings_opt_P_fingerprint = fingerprint0+ , toolSettings_opt_F = []+ , toolSettings_opt_c = []+ , toolSettings_opt_cxx = []+ , toolSettings_opt_a = []+ , toolSettings_opt_l = []+ , toolSettings_opt_windres = []+ , toolSettings_opt_lcc = []+ , toolSettings_opt_lo = []+ , toolSettings_opt_lc = []+ , toolSettings_opt_i = []++ , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags+ }++ , sTargetPlatform = platform+ , sPlatformMisc = PlatformMisc+ { platformMisc_targetPlatformString = targetPlatformString+ , platformMisc_integerLibrary = integerLibrary+ , platformMisc_integerLibraryType = integerLibraryType+ , platformMisc_ghcWithInterpreter = ghcWithInterpreter+ , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen+ , platformMisc_ghcWithSMP = ghcWithSMP+ , platformMisc_ghcRTSWays = ghcRTSWays+ , platformMisc_tablesNextToCode = tablesNextToCode+ , platformMisc_leadingUnderscore = leadingUnderscore+ , platformMisc_libFFI = useLibFFI+ , platformMisc_ghcThreaded = ghcThreaded+ , platformMisc_ghcDebugged = ghcDebugged+ , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw+ }++ , sPlatformConstants = platformConstants++ , sRawSettings = mySettings+ }++ {- Note [Windows stack usage] See: #8870 (and #8834 for related info) and #12186@@ -418,10 +433,10 @@ -- against libHSrts, then both end up getting loaded, -- and things go wrong. We therefore link the libraries -- with the same RTS flags that we link GHC with.- dflags1 = if sGhcThreaded $ settings dflags0+ dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0 then addWay' WayThreaded dflags0 else dflags0- dflags2 = if sGhcDebugged $ settings dflags1+ dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1 then addWay' WayDebug dflags1 else dflags1 dflags = updateWays dflags2
compiler/main/TidyPgm.hs view
@@ -135,13 +135,14 @@ mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc hsc_env- TcGblEnv{ tcg_exports = exports,- tcg_type_env = type_env, -- just for the Ids- tcg_tcs = tcs,- tcg_patsyns = pat_syns,- tcg_insts = insts,- tcg_fam_insts = fam_insts,- tcg_mod = this_mod+ TcGblEnv{ tcg_exports = exports,+ tcg_type_env = type_env, -- just for the Ids+ tcg_tcs = tcs,+ tcg_patsyns = pat_syns,+ tcg_insts = insts,+ tcg_fam_insts = fam_insts,+ tcg_complete_matches = complete_sigs,+ tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but -- the message is useful to locating oneself in the compilation process.@@ -156,13 +157,13 @@ ; dfun_ids = map instanceDFunId insts' ; type_env' = extendTypeEnvWithIds type_env2 dfun_ids }- ; return (ModDetails { md_types = type_env'- , md_insts = insts'- , md_fam_insts = fam_insts- , md_rules = []- , md_anns = []- , md_exports = exports- , md_complete_sigs = []+ ; return (ModDetails { md_types = type_env'+ , md_insts = insts'+ , md_fam_insts = fam_insts+ , md_rules = []+ , md_anns = []+ , md_exports = exports+ , md_complete_sigs = complete_sigs }) } where
compiler/nativeGen/PPC/CodeGen.hs view
@@ -949,6 +949,7 @@ , BCC LE cmp_lo Nothing , CMPL II32 x_lo (RIReg y_lo) , BCC ALWAYS end_lbl Nothing+ , NEWBLOCK cmp_lo , CMPL II32 y_lo (RIReg x_lo) , BCC ALWAYS end_lbl Nothing
compiler/nativeGen/PPC/Instr.hs view
@@ -98,7 +98,7 @@ , STU fmt r0 (AddrRegReg sp tmp) ] where- fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8)+ fmt = intFormat $ widthFromBytes (platformWordSize platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount
compiler/specialise/Specialise.hs view
@@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-} module Specialise ( specProgram, specUnfolding ) where #include "HsVersions.h"@@ -25,13 +26,13 @@ import CoreSyn import Rules import CoreOpt ( collectBindersPushingCo )-import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast )+import CoreUtils ( exprIsTrivial, mkCast, exprType ) import CoreFVs import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name import MkId ( voidArgId, voidPrimId )-import Maybes ( catMaybes, isJust )+import Maybes ( mapMaybe, isJust ) import MonadUtils ( foldlM ) import BasicTypes import HscTypes@@ -42,6 +43,7 @@ import FastString import State import UniqDFM+import TyCoRep (TyCoBinder (..)) import Control.Monad import qualified Control.Monad.Fail as MonadFail@@ -631,6 +633,190 @@ See #10491 -} +-- | An argument that we might want to specialise.+-- See Note [Specialising Calls] for the nitty gritty details.+data SpecArg+ =+ -- | Type arguments that should be specialised, due to appearing+ -- free in the type of a 'SpecDict'.+ SpecType Type+ -- | Type arguments that should remain polymorphic.+ | UnspecType+ -- | Dictionaries that should be specialised.+ | SpecDict DictExpr+ -- | Value arguments that should not be specialised.+ | UnspecArg++instance Outputable SpecArg where+ ppr (SpecType t) = text "SpecType" <+> ppr t+ ppr UnspecType = text "UnspecType"+ ppr (SpecDict d) = text "SpecDict" <+> ppr d+ ppr UnspecArg = text "UnspecArg"++getSpecDicts :: [SpecArg] -> [DictExpr]+getSpecDicts = mapMaybe go+ where+ go (SpecDict d) = Just d+ go _ = Nothing++getSpecTypes :: [SpecArg] -> [Type]+getSpecTypes = mapMaybe go+ where+ go (SpecType t) = Just t+ go _ = Nothing++isUnspecArg :: SpecArg -> Bool+isUnspecArg UnspecArg = True+isUnspecArg UnspecType = True+isUnspecArg _ = False++isValueArg :: SpecArg -> Bool+isValueArg UnspecArg = True+isValueArg (SpecDict _) = True+isValueArg _ = False++-- | Given binders from an original function 'f', and the 'SpecArg's+-- corresponding to its usage, compute everything necessary to build+-- a specialisation.+--+-- We will use a running example. Consider the function+--+-- foo :: forall a b. Eq a => Int -> blah+-- foo @a @b dEqA i = blah+--+-- which is called with the 'CallInfo'+--+-- [SpecType T1, UnspecType, SpecDict dEqT1, UnspecArg]+--+-- We'd eventually like to build the RULE+--+-- RULE "SPEC foo @T1 _"+-- forall @a @b (dEqA' :: Eq a).+-- foo @T1 @b dEqA' = $sfoo @b+--+-- and the specialisation '$sfoo'+--+-- $sfoo :: forall b. Int -> blah+-- $sfoo @b = \i -> SUBST[a->T1, dEqA->dEqA'] blah+--+-- The cases for 'specHeader' below are presented in the same order as this+-- running example. The result of 'specHeader' for this example is as follows:+--+-- ( -- Returned arguments+-- env + [a -> T1, deqA -> dEqA']+-- , []+--+-- -- RULE helpers+-- , [b, dx', i]+-- , [T1, b, dx', i]+--+-- -- Specialised function helpers+-- , [b, i]+-- , [dx]+-- , [T1, b, dx_spec, i]+-- )+specHeader+ :: SpecEnv+ -> [CoreBndr] -- The binders from the original function 'f'+ -> [SpecArg] -- From the CallInfo+ -> SpecM ( -- Returned arguments+ SpecEnv -- Substitution to apply to the body of 'f'+ , [CoreBndr] -- All the remaining unspecialised args from the original function 'f'++ -- RULE helpers+ , [CoreBndr] -- Binders for the RULE+ , [CoreArg] -- Args for the LHS of the rule++ -- Specialised function helpers+ , [CoreBndr] -- Binders for $sf+ , [DictBind] -- Auxiliary dictionary bindings+ , [CoreExpr] -- Specialised arguments for unfolding+ )++-- We want to specialise on type 'T1', and so we must construct a substitution+-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding+-- details.+specHeader env (bndr : bndrs) (SpecType t : args)+ = do { let env' = extendTvSubstList env [(bndr, t)]+ ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args)+ <- specHeader env' bndrs args+ ; pure ( env''+ , unused_bndrs+ , rule_bs+ , Type t : rule_es+ , bs'+ , dx+ , Type t : spec_args+ )+ }++-- Next we have a type that we don't want to specialise. We need to perform+-- a substitution on it (in case the type refers to 'a'). Additionally, we need+-- to produce a binder, LHS argument and RHS argument for the resulting rule,+-- /and/ a binder for the specialised body.+specHeader env (bndr : bndrs) (UnspecType : args)+ = do { let (env', bndr') = substBndr env bndr+ ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args)+ <- specHeader env' bndrs args+ ; pure ( env''+ , unused_bndrs+ , bndr' : rule_bs+ , varToCoreExpr bndr' : rule_es+ , bndr' : bs'+ , dx+ , varToCoreExpr bndr' : spec_args+ )+ }++-- Next we want to specialise the 'Eq a' dict away. We need to construct+-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for+-- the nitty-gritty), as a LHS rule and unfolding details.+specHeader env (bndr : bndrs) (SpecDict d : args)+ = do { inst_dict_id <- newDictBndr env bndr+ ; let (rhs_env2, dx_binds, spec_dict_args')+ = bindAuxiliaryDicts env [bndr] [d] [inst_dict_id]+ ; (env', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args)+ <- specHeader rhs_env2 bndrs args+ ; pure ( env'+ , unused_bndrs+ -- See Note [Evidence foralls]+ , exprFreeIdsList (varToCoreExpr inst_dict_id) ++ rule_bs+ , varToCoreExpr inst_dict_id : rule_es+ , bs'+ , dx_binds ++ dx+ , spec_dict_args' ++ spec_args+ )+ }++-- Finally, we have the unspecialised argument 'i'. We need to produce+-- a binder, LHS and RHS argument for the RULE, and a binder for the+-- specialised body.+--+-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is+-- why 'i' doesn't appear in our RULE above. But we have no guarantee that+-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so+-- this case must be here.+specHeader env (bndr : bndrs) (UnspecArg : args)+ = do { let (env', bndr') = substBndr env bndr+ ; (env'', unused_bndrs, rule_bs, rule_es, bs', dx, spec_args)+ <- specHeader env' bndrs args+ ; pure ( env''+ , unused_bndrs+ , bndr' : rule_bs+ , varToCoreExpr bndr' : rule_es+ , bndr' : bs'+ , dx+ , varToCoreExpr bndr' : spec_args+ )+ }++-- Return all remaining binders from the original function. These have the+-- invariant that they should all correspond to unspecialised arguments, so+-- it's safe to stop processing at this point.+specHeader env bndrs [] = pure (env, bndrs, [], [], [], [], [])+specHeader env [] _ = pure (env, [], [], [], [], [], [])++ -- | Specialise a set of calls to imported bindings specImports :: DynFlags -> Module@@ -1171,8 +1357,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- The first case is the interesting one- | rhs_tyvars `lengthIs` n_tyvars -- Rhs of fn's defn has right number of big lambdas- && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args+ | callSpecArity pis <= fn_arity -- See Note [Specialisation Must Preserve Sharing] && notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) -- Don't specialise NOINLINE things@@ -1193,15 +1378,14 @@ -- pprTrace "specDefn: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where- _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars- , ppr rhs_bndrs, ppr n_dicts+ _trace_doc = sep [ ppr rhs_tyvars, ppr rhs_bndrs , ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here- (tyvars, theta, _) = tcSplitSigmaTy fn_type- n_tyvars = length tyvars+ pis = fst $ splitPiTys fn_type+ theta = getTheta pis n_dicts = length theta inl_prag = idInlinePragma fn inl_act = inlinePragmaActivation inl_prag@@ -1212,10 +1396,7 @@ (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs -- See Note [Account for casts in binding]- (rhs_tyvars, rhs_bndrs1) = span isTyVar rhs_bndrs- (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1- body = mkLams rhs_bndrs2 rhs_body- -- Glue back on the non-dict lambdas+ rhs_tyvars = filter isTyVar rhs_bndrs in_scope = CoreSubst.substInScope (se_subst env) @@ -1227,59 +1408,19 @@ -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) - mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr]- mk_ty_args [] poly_tvs- = ASSERT( null poly_tvs ) []- mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs)- = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs- mk_ty_args (Just ty : call_ts) poly_tvs- = Type ty : mk_ty_args call_ts poly_tvs- mk_ty_args (Nothing : _) [] = panic "mk_ty_args"- ---------------------------------------------------------- -- Specialise to one particular call pattern spec_call :: SpecInfo -- Accumulating parameter -> CallInfo -- Call instance -> SpecM SpecInfo spec_call spec_acc@(rules_acc, pairs_acc, uds_acc)- (CI { ci_key = CallKey call_ts, ci_args = call_ds })- = ASSERT( call_ts `lengthIs` n_tyvars && call_ds `lengthIs` n_dicts )-- -- Suppose f's defn is f = /\ a b c -> \ d1 d2 -> rhs- -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2]-- -- Construct the new binding- -- f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b -> rhs)- -- PLUS the rule- -- RULE "SPEC f" forall b d1' d2'. f b d1' d2' = f1 b- -- In the rule, d1' and d2' are just wildcards, not used in the RHS- -- PLUS the usage-details- -- { d1' = dx1; d2' = dx2 }- -- where d1', d2' are cloned versions of d1,d2, with the type substitution- -- applied. These auxiliary bindings just avoid duplication of dx1, dx2- --- -- Note that the substitution is applied to the whole thing.- -- This is convenient, but just slightly fragile. Notably:- -- * There had better be no name clashes in a/b/c- do { let- -- poly_tyvars = [b] in the example above- -- spec_tyvars = [a,c]- -- ty_args = [t1,b,t3]- spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts]- env1 = extendTvSubstList env spec_tv_binds- (rhs_env, poly_tyvars) = substBndrs env1- [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts]-- -- Clone rhs_dicts, including instantiating their types- ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids- ; let (rhs_env2, dx_binds, spec_dict_args)- = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids- ty_args = mk_ty_args call_ts poly_tyvars- ev_args = map varToCoreExpr inst_dict_ids -- ev_args, ev_bndrs:- ev_bndrs = exprsFreeIdsList ev_args -- See Note [Evidence foralls]- rule_args = ty_args ++ ev_args- rule_bndrs = poly_tyvars ++ ev_bndrs+ (CI { ci_key = call_args, ci_arity = call_arity })+ = ASSERT(call_arity <= fn_arity) + -- See Note [Specialising Calls]+ do { (rhs_env2, unused_bndrs, rule_bndrs, rule_args, unspec_bndrs, dx_binds, spec_args)+ <- specHeader env rhs_bndrs $ dropWhileEndLE isUnspecArg call_args+ ; let rhs_body' = mkLams unused_bndrs rhs_body ; dflags <- getDynFlags ; if already_covered dflags rules_acc rule_args then return spec_acc@@ -1288,25 +1429,28 @@ -- , ppr dx_binds ]) $ do { -- Figure out the type of the specialised function- let body_ty = applyTypeToArgs rhs fn_type rule_args- (lam_args, app_args) -- Add a dummy argument if body_ty is unlifted+ let body = mkLams unspec_bndrs rhs_body'+ body_ty = substTy rhs_env2 $ exprType body+ (lam_extra_args, app_args) -- See Note [Specialisations Must Be Lifted] | isUnliftedType body_ty -- C.f. WwLib.mkWorkerArgs , not (isJoinId fn)- = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId])- | otherwise = (poly_tyvars, poly_tyvars)- spec_id_ty = mkLamTypes lam_args body_ty+ = ([voidArgId], unspec_bndrs ++ [voidPrimId])+ | otherwise = ([], unspec_bndrs) join_arity_change = length app_args - length rule_args spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn = Just (orig_join_arity + join_arity_change) | otherwise = Nothing + ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_extra_args body)+ ; let spec_id_ty = exprType spec_rhs ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity- ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body) ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is:- -- forall b, d1',d2'. f t1 b t3 d1' d2' = f1 b+ -- forall x @b d1' d2'.+ -- f x @T1 @b @T2 d1' d2' = f1 x @b+ -- See Note [Specialising Calls] herald = case mb_mod of Nothing -- Specialising local fn -> text "SPEC"@@ -1315,7 +1459,7 @@ rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn))- <+> hsep (map ppr_call_key_ty call_ts)+ <+> hsep (mapMaybe ppr_call_key_ty call_args) -- This name ends up in interface files, so use occNameString. -- Otherwise uniques end up there, making builds -- less deterministic (See #4012 comment:61 ff)@@ -1338,6 +1482,7 @@ Nothing -> rule_wout_eta -- Add the { d1' = dx1; d2' = dx2 } usage stuff+ -- See Note [Specialising Calls] spec_uds = foldr consDictBind rhs_uds dx_binds --------------------------------------@@ -1352,11 +1497,9 @@ = (inl_prag { inl_inline = NoUserInline }, noUnfolding) | otherwise- = (inl_prag, specUnfolding dflags poly_tyvars spec_app- arity_decrease fn_unf)+ = (inl_prag, specUnfolding dflags unspec_bndrs spec_app n_dicts fn_unf) - arity_decrease = length spec_dict_args- spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args+ spec_app e = e `mkApps` spec_args -------------------------------------- -- Adding arity information just propagates it a bit faster@@ -1368,13 +1511,116 @@ `setIdUnfolding` spec_unf `asJoinId_maybe` spec_join_arity - ; return ( spec_rule : rules_acc+ _rule_trace_doc = vcat [ ppr spec_f, ppr fn_type, ppr spec_id_ty+ , ppr rhs_bndrs, ppr call_args+ , ppr spec_rule+ ]++ ; -- pprTrace "spec_call: rule" _rule_trace_doc+ return ( spec_rule : rules_acc , (spec_f_w_arity, spec_rhs) : pairs_acc , spec_uds `plusUDs` uds_acc ) } } -{- Note [Account for casts in binding]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{- Note [Specialisation Must Preserve Sharing]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider a function:++ f :: forall a. Eq a => a -> blah+ f =+ if expensive+ then f1+ else f2++As written, all calls to 'f' will share 'expensive'. But if we specialise 'f'+at 'Int', eg:++ $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2)++ RULE "SPEC f"+ forall (d :: Eq Int).+ f Int _ = $sfIntf++We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes!++To avoid this, we only generate specialisations for functions whose arity is+enough to bind all of the arguments we need to specialise. This ensures our+specialised functions don't do any work before receiving all of their dicts,+and thus avoids the 'f' case above.++Note [Specialisations Must Be Lifted]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider a function 'f':++ f = forall a. Eq a => Array# a++used like++ case x of+ True -> ...f @Int dEqInt...+ False -> 0++Naively, we might generate an (expensive) specialisation++ $sfInt :: Array# Int++even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to+the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to+preserve laziness.++Note [Specialising Calls]+~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have a function:++ f :: Int -> forall a b c. (Foo a, Foo c) => Bar -> Qux+ f = \x -> /\ a b c -> \d1 d2 bar -> rhs++and suppose it is called at:++ f 7 @T1 @T2 @T3 dFooT1 dFooT3 bar++This call is described as a 'CallInfo' whose 'ci_key' is++ [ UnspecArg, SpecType T1, UnspecType, SpecType T3, SpecDict dFooT1+ , SpecDict dFooT3, UnspecArg ]++Why are 'a' and 'c' identified as 'SpecType', while 'b' is 'UnspecType'?+Because we must specialise the function on type variables that appear+free in its *dictionary* arguments; but not on type variables that do not+appear in any dictionaries, i.e. are fully polymorphic.++Because this call has dictionaries applied, we'd like to specialise+the call on any type argument that appears free in those dictionaries.+In this case, those are (a ~ T1, c ~ T3).++As a result, we'd like to generate a function:++ $sf :: Int -> forall b. Bar -> Qux+ $sf = SUBST[a->T1, c->T3, d1->d1', d2->d2'] (\x -> /\ b -> \bar -> rhs)++Note that the substitution is applied to the whole thing. This is+convenient, but just slightly fragile. Notably:+ * There had better be no name clashes in a/b/c++We must construct a rewrite rule:++ RULE "SPEC f @T1 _ @T3"+ forall (x :: Int) (@b :: Type) (d1' :: Foo T1) (d2' :: Foo T3).+ f x @T1 @b @T3 d1' d2' = $sf x @b++In the rule, d1' and d2' are just wildcards, not used in the RHS. Note+additionally that 'bar' isn't captured by this rule --- we bind only+enough etas in order to capture all of the *specialised* arguments.++Finally, we must also construct the usage-details++ { d1' = dx1; d2' = dx2 }++where d1', d2' are cloned versions of d1,d2, with the type substitution+applied. These auxiliary bindings just avoid duplication of dx1, dx2.++Note [Account for casts in binding]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f :: Eq a => a -> IO () {-# INLINABLE f@@ -1888,16 +2134,14 @@ -- These dups are eliminated by already_covered in specCalls data CallInfo- = CI { ci_key :: CallKey -- Type arguments- , ci_args :: [DictExpr] -- Dictionary arguments- , ci_fvs :: VarSet -- Free vars of the ci_key and ci_args+ = CI { ci_key :: [SpecArg] -- All arguments+ , ci_arity :: Int -- The number of variables necessary to bind+ -- all of the specialised arguments+ , ci_fvs :: VarSet -- Free vars of the ci_key -- call (including tyvars) -- [*not* include the main id itself, of course] } -newtype CallKey = CallKey [Maybe Type]- -- Nothing => unconstrained type argument- type DictExpr = CoreExpr ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet@@ -1911,16 +2155,15 @@ pprCallInfo fn (CI { ci_key = key }) = ppr fn <+> ppr key -ppr_call_key_ty :: Maybe Type -> SDoc-ppr_call_key_ty Nothing = char '_'-ppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty--instance Outputable CallKey where- ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts))+ppr_call_key_ty :: SpecArg -> Maybe SDoc+ppr_call_key_ty (SpecType ty) = Just $ char '@' <+> pprParendType ty+ppr_call_key_ty UnspecType = Just $ char '_'+ppr_call_key_ty (SpecDict _) = Nothing+ppr_call_key_ty UnspecArg = Nothing instance Outputable CallInfo where- ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs })- = text "CI" <> braces (hsep [ ppr key, ppr args, ppr fvs ])+ ppr (CI { ci_key = key, ci_fvs = fvs })+ = text "CI" <> braces (hsep [ fsep (mapMaybe ppr_call_key_ty key), ppr fvs ]) unionCalls :: CallDetails -> CallDetails -> CallDetails unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2@@ -1939,17 +2182,29 @@ callInfoFVs (CIS _ call_info) = foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info +computeArity :: [SpecArg] -> Int+computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg++callSpecArity :: [TyCoBinder] -> Int+callSpecArity = length . filter (not . isNamedBinder) . dropWhileEndLE isVisibleBinder++getTheta :: [TyCoBinder] -> [PredType]+getTheta = fmap tyBinderType . filter isInvisibleBinder . filter (not . isNamedBinder)++ -------------------------------------------------------------singleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails-singleCall id tys dicts+singleCall :: Id -> [SpecArg] -> UsageDetails+singleCall id args = MkUD {ud_binds = emptyBag, ud_calls = unitDVarEnv id $ CIS id $- unitBag (CI { ci_key = CallKey tys- , ci_args = dicts+ unitBag (CI { ci_key = args -- used to be tys+ , ci_arity = computeArity args , ci_fvs = call_fvs }) } where+ tys = getSpecTypes args+ dicts = getSpecDicts args call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs- tys_fvs = tyCoVarsOfTypes (catMaybes tys)+ tys_fvs = tyCoVarsOfTypes tys -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound@@ -1973,8 +2228,8 @@ = emptyUDs | not (all type_determines_value theta)- || not (spec_tys `lengthIs` n_tyvars)- || not ( dicts `lengthIs` n_dicts)+ || not (computeArity ci_key <= idArity f)+ || not (length dicts == length theta) || not (any (interestingDict env) dicts) -- Note [Interesting dictionary arguments] -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc@@ -1982,27 +2237,28 @@ | otherwise = -- pprTrace "mkCallUDs: keeping" _trace_doc- singleCall f spec_tys dicts+ singleCall f ci_key where- _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts- , ppr (map (interestingDict env) dicts)]- (tyvars, theta, _) = tcSplitSigmaTy (idType f)- constrained_tyvars = tyCoVarsOfTypes theta- n_tyvars = length tyvars- n_dicts = length theta-- spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args]- dicts = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)]+ _trace_doc = vcat [ppr f, ppr args, ppr (map (interestingDict env) dicts)]+ pis = fst $ splitPiTys $ idType f+ theta = getTheta pis+ constrained_tyvars = tyCoVarsOfTypes theta - -- ignores Coercion arguments- type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)]- type_zip tvs (Coercion _ : args) = type_zip tvs args- type_zip (tv:tvs) (Type ty : args) = (tv, ty) : type_zip tvs args- type_zip _ _ = []+ ci_key :: [SpecArg]+ ci_key = fmap (\(t, a) ->+ case t of+ Named (binderVar -> tyVar)+ | tyVar `elemVarSet` constrained_tyvars+ -> case a of+ Type ty -> SpecType ty+ _ -> pprPanic "ci_key" $ ppr a+ | otherwise+ -> UnspecType+ Anon InvisArg _ -> SpecDict a+ Anon VisArg _ -> UnspecArg+ ) $ zip pis args - mk_spec_ty tyvar ty- | tyvar `elemVarSet` constrained_tyvars = Just ty- | otherwise = Nothing+ dicts = getSpecDicts ci_key want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) -- For imported things, we gather call instances if
compiler/typecheck/FamInst.hs view
@@ -768,14 +768,14 @@ -- declaration. The returned Pair includes invisible vars followed by visible ones unusedInjTvsInRHS :: TyCon -> [Bool] -> [Type] -> Type -> Pair TyVarSet -- INVARIANT: [Bool] list contains at least one True value--- See Note [Verifying injectivity annotation]. This function implements fourth--- check described there.+-- See Note [Verifying injectivity annotation] in FamInstEnv.+-- This function implements check (4) described there. -- In theory, instead of implementing this whole check in this way, we could -- attempt to unify equation with itself. We would reject exactly the same -- equations but this method gives us more precise error messages by returning -- precise names of variables that are not mentioned in the RHS. unusedInjTvsInRHS tycon injList lhs rhs =- (`minusVarSet` injRhsVars) <$> injLHSVars+ (`minusVarSet` injRhsVars) <$> injLhsVars where inj_pairs :: [(Type, ArgFlag)] -- All the injective arguments, paired with their visibility@@ -789,7 +789,7 @@ invis_vars = tyCoVarsOfTypes invis_lhs Pair invis_vars' vis_vars = splitVisVarsOfTypes vis_lhs- injLHSVars+ injLhsVars = Pair (invis_vars `minusVarSet` vis_vars `unionVarSet` invis_vars') vis_vars @@ -813,7 +813,7 @@ = unitVarSet v `unionVarSet` injTyVarsOfType (tyVarKind v) injTyVarsOfType (TyConApp tc tys) | isTypeFamilyTyCon tc- = case tyConInjectivityInfo tc of+ = case tyConInjectivityInfo tc of NotInjective -> emptyVarSet Injective inj -> injTyVarsOfTypes (filterByList inj tys) | otherwise@@ -835,8 +835,7 @@ -- | Is type headed by a type family application? isTFHeaded :: Type -> Bool--- See Note [Verifying injectivity annotation]. This function implements third--- check described there.+-- See Note [Verifying injectivity annotation], case 3. isTFHeaded ty | Just ty' <- coreView ty = isTFHeaded ty' isTFHeaded ty | (TyConApp tc args) <- ty@@ -848,8 +847,7 @@ -- | If a RHS is a bare type variable return a set of LHS patterns that are not -- bare type variables. bareTvInRHSViolated :: [Type] -> Type -> [Type]--- See Note [Verifying injectivity annotation]. This function implements second--- check described there.+-- See Note [Verifying injectivity annotation], case 2. bareTvInRHSViolated pats rhs | isTyVarTy rhs = filter (not . isTyVarTy) pats bareTvInRHSViolated _ _ = []
compiler/typecheck/TcForeign.hs view
@@ -64,7 +64,6 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad-import Data.Maybe -- Defines a binding isForeignImport :: LForeignDecl name -> Bool@@ -251,8 +250,7 @@ ; let -- Drop the foralls before inspecting the -- structure of the foreign type.- (bndrs, res_ty) = tcSplitPiTys norm_sig_ty- arg_tys = mapMaybe binderRelevantType_maybe bndrs+ (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty) id = mkLocalId nm sig_ty -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking,@@ -424,10 +422,9 @@ checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where- -- Drop the foralls before inspecting n+ -- Drop the foralls before inspecting -- the structure of the foreign type.- (bndrs, res_ty) = tcSplitPiTys sig_ty- arg_tys = mapMaybe binderRelevantType_maybe bndrs+ (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty) {- ************************************************************************@@ -457,6 +454,11 @@ | Just (_, res_ty) <- tcSplitIOType_maybe ty = -- Got an IO result type, that's always fine! check (pred_res_ty res_ty) (illegalForeignTyErr result)++ -- We disallow nested foralls in foreign types+ -- (at least, for the time being). See #16702.+ | tcIsForAllTy ty+ = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall") -- Case for non-IO result type with FFI Import | not non_io_result_ok
compiler/typecheck/TcHoleErrors.hs view
@@ -516,21 +516,30 @@ ty = hfType hf matches = hfMatches hf wrap = hfWrap hf- tyApp = sep $ map ((text "@" <>) . pprParendType) wrap+ tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars wrap+ where pprArg b arg = case binderArgFlag b of+ Specified -> text "@" <> pprParendType arg+ -- Do not print type application for inferred+ -- variables (#16456)+ Inferred -> empty+ Required -> pprPanic "pprHoleFit: bad Required"+ (ppr b <+> ppr arg) tyAppVars = sep $ punctuate comma $- map (\(v,t) -> ppr v <+> text "~" <+> pprParendType t) $- zip vars wrap+ zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+>+ text "~" <+> pprParendType t)+ vars wrap++ vars = unwrapTypeVars ty where- vars = unwrapTypeVars ty -- Attempts to get all the quantified type variables in a type, -- e.g.- -- return :: forall (m :: * -> *) Monad m => (forall a . a) -> m a+ -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a) -- into [m, a]- unwrapTypeVars :: Type -> [TyVar]+ unwrapTypeVars :: Type -> [TyCoVarBinder] unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of Just (_, unfunned) -> unwrapTypeVars unfunned _ -> []- where (vars, unforalled) = splitForAllTys t+ where (vars, unforalled) = splitForAllVarBndrs t holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) matches holeDisp = if sMs then holeVs else sep $ replicate (length matches) $ text "_"
compiler/typecheck/TcMatches.hs view
@@ -72,7 +72,7 @@ tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn)- -> ExpRhoType -- Expected type of function+ -> ExpSigmaType -- Expected type of function -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId)) -- Returns type of body tcMatchesFun fn@(L _ fun_name) matches exp_ty
compiler/typecheck/TcMatches.hs-boot view
@@ -2,7 +2,7 @@ import HsSyn ( GRHSs, MatchGroup, LHsExpr ) import TcEvidence( HsWrapper ) import Name ( Name )-import TcType ( ExpRhoType, TcRhoType )+import TcType ( ExpSigmaType, TcRhoType ) import TcRnTypes( TcM ) import SrcLoc ( Located ) import HsExtension ( GhcRn, GhcTcId )@@ -13,5 +13,5 @@ tcMatchesFun :: Located Name -> MatchGroup GhcRn (LHsExpr GhcRn)- -> ExpRhoType+ -> ExpSigmaType -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
compiler/typecheck/TcValidity.hs view
@@ -2031,6 +2031,7 @@ gather_conflicts inj prev_branches cur_branch (acc, n) branch -- n is 0-based index of branch in prev_branches = case injectiveBranches inj cur_branch branch of+ -- Case 1B2 in Note [Verifying injectivity annotation] in FamInstEnv InjectivityUnified ax1 ax2 | ax1 `isDominatedBy` (replace_br prev_branches n ax2) -> (acc, n + 1)
ghc-lib.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-version: 0.20190523.1+version: 0.20190603 license: BSD3 license-file: LICENSE category: Development@@ -84,7 +84,7 @@ transformers == 0.5.*, process >= 1 && < 1.7, hpc == 0.6.*,- ghc-lib-parser == 0.20190523+ ghc-lib-parser == 0.20190603 build-tools: alex >= 3.1, happy >= 1.19.4 other-extensions: BangPatterns@@ -162,6 +162,7 @@ BufWrite, ByteCodeTypes, Class,+ CliOption, CmdLineParser, CmmType, CoAxiom,@@ -201,6 +202,7 @@ FastStringEnv, FieldLabel, FileCleanup,+ FileSettings, Fingerprint, FiniteMap, ForeignCall,@@ -225,8 +227,10 @@ GHCi.RemoteTypes, GHCi.TH.Binary, GhcMonad,+ GhcNameVersion, GhcPrelude, HaddockUtils,+ HeaderInfo, Hooks, HsBinds, HsDecls,@@ -286,6 +290,7 @@ PatSyn, PipelineMonad, PlaceHolder,+ PlainPanic, Platform, PlatformConstants, Plugins,@@ -300,6 +305,7 @@ RdrName, RepType, Rules,+ Settings, SizedSeq, SrcLoc, StringBuffer,@@ -309,6 +315,7 @@ TcRnTypes, TcType, ToIface,+ ToolSettings, TrieMap, TyCoRep, TyCon,@@ -435,7 +442,6 @@ GraphColor GraphOps GraphPpr- HeaderInfo HieAst HieBin HieDebug
ghc-lib/generated/GHCConstantsHaskellWrappers.hs view
@@ -1,250 +1,250 @@ cONTROL_GROUP_CONST_291 :: DynFlags -> Int-cONTROL_GROUP_CONST_291 dflags = pc_CONTROL_GROUP_CONST_291 (sPlatformConstants (settings dflags))+cONTROL_GROUP_CONST_291 dflags = pc_CONTROL_GROUP_CONST_291 (platformConstants dflags) sTD_HDR_SIZE :: DynFlags -> Int-sTD_HDR_SIZE dflags = pc_STD_HDR_SIZE (sPlatformConstants (settings dflags))+sTD_HDR_SIZE dflags = pc_STD_HDR_SIZE (platformConstants dflags) pROF_HDR_SIZE :: DynFlags -> Int-pROF_HDR_SIZE dflags = pc_PROF_HDR_SIZE (sPlatformConstants (settings dflags))+pROF_HDR_SIZE dflags = pc_PROF_HDR_SIZE (platformConstants dflags) bLOCK_SIZE :: DynFlags -> Int-bLOCK_SIZE dflags = pc_BLOCK_SIZE (sPlatformConstants (settings dflags))+bLOCK_SIZE dflags = pc_BLOCK_SIZE (platformConstants dflags) bLOCKS_PER_MBLOCK :: DynFlags -> Int-bLOCKS_PER_MBLOCK dflags = pc_BLOCKS_PER_MBLOCK (sPlatformConstants (settings dflags))+bLOCKS_PER_MBLOCK dflags = pc_BLOCKS_PER_MBLOCK (platformConstants dflags) tICKY_BIN_COUNT :: DynFlags -> Int-tICKY_BIN_COUNT dflags = pc_TICKY_BIN_COUNT (sPlatformConstants (settings dflags))+tICKY_BIN_COUNT dflags = pc_TICKY_BIN_COUNT (platformConstants dflags) oFFSET_StgRegTable_rR1 :: DynFlags -> Int-oFFSET_StgRegTable_rR1 dflags = pc_OFFSET_StgRegTable_rR1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR1 dflags = pc_OFFSET_StgRegTable_rR1 (platformConstants dflags) oFFSET_StgRegTable_rR2 :: DynFlags -> Int-oFFSET_StgRegTable_rR2 dflags = pc_OFFSET_StgRegTable_rR2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR2 dflags = pc_OFFSET_StgRegTable_rR2 (platformConstants dflags) oFFSET_StgRegTable_rR3 :: DynFlags -> Int-oFFSET_StgRegTable_rR3 dflags = pc_OFFSET_StgRegTable_rR3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR3 dflags = pc_OFFSET_StgRegTable_rR3 (platformConstants dflags) oFFSET_StgRegTable_rR4 :: DynFlags -> Int-oFFSET_StgRegTable_rR4 dflags = pc_OFFSET_StgRegTable_rR4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR4 dflags = pc_OFFSET_StgRegTable_rR4 (platformConstants dflags) oFFSET_StgRegTable_rR5 :: DynFlags -> Int-oFFSET_StgRegTable_rR5 dflags = pc_OFFSET_StgRegTable_rR5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR5 dflags = pc_OFFSET_StgRegTable_rR5 (platformConstants dflags) oFFSET_StgRegTable_rR6 :: DynFlags -> Int-oFFSET_StgRegTable_rR6 dflags = pc_OFFSET_StgRegTable_rR6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR6 dflags = pc_OFFSET_StgRegTable_rR6 (platformConstants dflags) oFFSET_StgRegTable_rR7 :: DynFlags -> Int-oFFSET_StgRegTable_rR7 dflags = pc_OFFSET_StgRegTable_rR7 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR7 dflags = pc_OFFSET_StgRegTable_rR7 (platformConstants dflags) oFFSET_StgRegTable_rR8 :: DynFlags -> Int-oFFSET_StgRegTable_rR8 dflags = pc_OFFSET_StgRegTable_rR8 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR8 dflags = pc_OFFSET_StgRegTable_rR8 (platformConstants dflags) oFFSET_StgRegTable_rR9 :: DynFlags -> Int-oFFSET_StgRegTable_rR9 dflags = pc_OFFSET_StgRegTable_rR9 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR9 dflags = pc_OFFSET_StgRegTable_rR9 (platformConstants dflags) oFFSET_StgRegTable_rR10 :: DynFlags -> Int-oFFSET_StgRegTable_rR10 dflags = pc_OFFSET_StgRegTable_rR10 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR10 dflags = pc_OFFSET_StgRegTable_rR10 (platformConstants dflags) oFFSET_StgRegTable_rF1 :: DynFlags -> Int-oFFSET_StgRegTable_rF1 dflags = pc_OFFSET_StgRegTable_rF1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF1 dflags = pc_OFFSET_StgRegTable_rF1 (platformConstants dflags) oFFSET_StgRegTable_rF2 :: DynFlags -> Int-oFFSET_StgRegTable_rF2 dflags = pc_OFFSET_StgRegTable_rF2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF2 dflags = pc_OFFSET_StgRegTable_rF2 (platformConstants dflags) oFFSET_StgRegTable_rF3 :: DynFlags -> Int-oFFSET_StgRegTable_rF3 dflags = pc_OFFSET_StgRegTable_rF3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF3 dflags = pc_OFFSET_StgRegTable_rF3 (platformConstants dflags) oFFSET_StgRegTable_rF4 :: DynFlags -> Int-oFFSET_StgRegTable_rF4 dflags = pc_OFFSET_StgRegTable_rF4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF4 dflags = pc_OFFSET_StgRegTable_rF4 (platformConstants dflags) oFFSET_StgRegTable_rF5 :: DynFlags -> Int-oFFSET_StgRegTable_rF5 dflags = pc_OFFSET_StgRegTable_rF5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF5 dflags = pc_OFFSET_StgRegTable_rF5 (platformConstants dflags) oFFSET_StgRegTable_rF6 :: DynFlags -> Int-oFFSET_StgRegTable_rF6 dflags = pc_OFFSET_StgRegTable_rF6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF6 dflags = pc_OFFSET_StgRegTable_rF6 (platformConstants dflags) oFFSET_StgRegTable_rD1 :: DynFlags -> Int-oFFSET_StgRegTable_rD1 dflags = pc_OFFSET_StgRegTable_rD1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD1 dflags = pc_OFFSET_StgRegTable_rD1 (platformConstants dflags) oFFSET_StgRegTable_rD2 :: DynFlags -> Int-oFFSET_StgRegTable_rD2 dflags = pc_OFFSET_StgRegTable_rD2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD2 dflags = pc_OFFSET_StgRegTable_rD2 (platformConstants dflags) oFFSET_StgRegTable_rD3 :: DynFlags -> Int-oFFSET_StgRegTable_rD3 dflags = pc_OFFSET_StgRegTable_rD3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD3 dflags = pc_OFFSET_StgRegTable_rD3 (platformConstants dflags) oFFSET_StgRegTable_rD4 :: DynFlags -> Int-oFFSET_StgRegTable_rD4 dflags = pc_OFFSET_StgRegTable_rD4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD4 dflags = pc_OFFSET_StgRegTable_rD4 (platformConstants dflags) oFFSET_StgRegTable_rD5 :: DynFlags -> Int-oFFSET_StgRegTable_rD5 dflags = pc_OFFSET_StgRegTable_rD5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD5 dflags = pc_OFFSET_StgRegTable_rD5 (platformConstants dflags) oFFSET_StgRegTable_rD6 :: DynFlags -> Int-oFFSET_StgRegTable_rD6 dflags = pc_OFFSET_StgRegTable_rD6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD6 dflags = pc_OFFSET_StgRegTable_rD6 (platformConstants dflags) oFFSET_StgRegTable_rXMM1 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM1 dflags = pc_OFFSET_StgRegTable_rXMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM1 dflags = pc_OFFSET_StgRegTable_rXMM1 (platformConstants dflags) oFFSET_StgRegTable_rXMM2 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM2 dflags = pc_OFFSET_StgRegTable_rXMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM2 dflags = pc_OFFSET_StgRegTable_rXMM2 (platformConstants dflags) oFFSET_StgRegTable_rXMM3 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM3 dflags = pc_OFFSET_StgRegTable_rXMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM3 dflags = pc_OFFSET_StgRegTable_rXMM3 (platformConstants dflags) oFFSET_StgRegTable_rXMM4 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM4 dflags = pc_OFFSET_StgRegTable_rXMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM4 dflags = pc_OFFSET_StgRegTable_rXMM4 (platformConstants dflags) oFFSET_StgRegTable_rXMM5 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM5 dflags = pc_OFFSET_StgRegTable_rXMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM5 dflags = pc_OFFSET_StgRegTable_rXMM5 (platformConstants dflags) oFFSET_StgRegTable_rXMM6 :: DynFlags -> Int-oFFSET_StgRegTable_rXMM6 dflags = pc_OFFSET_StgRegTable_rXMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM6 dflags = pc_OFFSET_StgRegTable_rXMM6 (platformConstants dflags) oFFSET_StgRegTable_rYMM1 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM1 dflags = pc_OFFSET_StgRegTable_rYMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM1 dflags = pc_OFFSET_StgRegTable_rYMM1 (platformConstants dflags) oFFSET_StgRegTable_rYMM2 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM2 dflags = pc_OFFSET_StgRegTable_rYMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM2 dflags = pc_OFFSET_StgRegTable_rYMM2 (platformConstants dflags) oFFSET_StgRegTable_rYMM3 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM3 dflags = pc_OFFSET_StgRegTable_rYMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM3 dflags = pc_OFFSET_StgRegTable_rYMM3 (platformConstants dflags) oFFSET_StgRegTable_rYMM4 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM4 dflags = pc_OFFSET_StgRegTable_rYMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM4 dflags = pc_OFFSET_StgRegTable_rYMM4 (platformConstants dflags) oFFSET_StgRegTable_rYMM5 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM5 dflags = pc_OFFSET_StgRegTable_rYMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM5 dflags = pc_OFFSET_StgRegTable_rYMM5 (platformConstants dflags) oFFSET_StgRegTable_rYMM6 :: DynFlags -> Int-oFFSET_StgRegTable_rYMM6 dflags = pc_OFFSET_StgRegTable_rYMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM6 dflags = pc_OFFSET_StgRegTable_rYMM6 (platformConstants dflags) oFFSET_StgRegTable_rZMM1 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM1 dflags = pc_OFFSET_StgRegTable_rZMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM1 dflags = pc_OFFSET_StgRegTable_rZMM1 (platformConstants dflags) oFFSET_StgRegTable_rZMM2 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM2 dflags = pc_OFFSET_StgRegTable_rZMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM2 dflags = pc_OFFSET_StgRegTable_rZMM2 (platformConstants dflags) oFFSET_StgRegTable_rZMM3 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM3 dflags = pc_OFFSET_StgRegTable_rZMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM3 dflags = pc_OFFSET_StgRegTable_rZMM3 (platformConstants dflags) oFFSET_StgRegTable_rZMM4 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM4 dflags = pc_OFFSET_StgRegTable_rZMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM4 dflags = pc_OFFSET_StgRegTable_rZMM4 (platformConstants dflags) oFFSET_StgRegTable_rZMM5 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM5 dflags = pc_OFFSET_StgRegTable_rZMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM5 dflags = pc_OFFSET_StgRegTable_rZMM5 (platformConstants dflags) oFFSET_StgRegTable_rZMM6 :: DynFlags -> Int-oFFSET_StgRegTable_rZMM6 dflags = pc_OFFSET_StgRegTable_rZMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM6 dflags = pc_OFFSET_StgRegTable_rZMM6 (platformConstants dflags) oFFSET_StgRegTable_rL1 :: DynFlags -> Int-oFFSET_StgRegTable_rL1 dflags = pc_OFFSET_StgRegTable_rL1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rL1 dflags = pc_OFFSET_StgRegTable_rL1 (platformConstants dflags) oFFSET_StgRegTable_rSp :: DynFlags -> Int-oFFSET_StgRegTable_rSp dflags = pc_OFFSET_StgRegTable_rSp (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rSp dflags = pc_OFFSET_StgRegTable_rSp (platformConstants dflags) oFFSET_StgRegTable_rSpLim :: DynFlags -> Int-oFFSET_StgRegTable_rSpLim dflags = pc_OFFSET_StgRegTable_rSpLim (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rSpLim dflags = pc_OFFSET_StgRegTable_rSpLim (platformConstants dflags) oFFSET_StgRegTable_rHp :: DynFlags -> Int-oFFSET_StgRegTable_rHp dflags = pc_OFFSET_StgRegTable_rHp (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHp dflags = pc_OFFSET_StgRegTable_rHp (platformConstants dflags) oFFSET_StgRegTable_rHpLim :: DynFlags -> Int-oFFSET_StgRegTable_rHpLim dflags = pc_OFFSET_StgRegTable_rHpLim (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHpLim dflags = pc_OFFSET_StgRegTable_rHpLim (platformConstants dflags) oFFSET_StgRegTable_rCCCS :: DynFlags -> Int-oFFSET_StgRegTable_rCCCS dflags = pc_OFFSET_StgRegTable_rCCCS (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCCCS dflags = pc_OFFSET_StgRegTable_rCCCS (platformConstants dflags) oFFSET_StgRegTable_rCurrentTSO :: DynFlags -> Int-oFFSET_StgRegTable_rCurrentTSO dflags = pc_OFFSET_StgRegTable_rCurrentTSO (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCurrentTSO dflags = pc_OFFSET_StgRegTable_rCurrentTSO (platformConstants dflags) oFFSET_StgRegTable_rCurrentNursery :: DynFlags -> Int-oFFSET_StgRegTable_rCurrentNursery dflags = pc_OFFSET_StgRegTable_rCurrentNursery (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCurrentNursery dflags = pc_OFFSET_StgRegTable_rCurrentNursery (platformConstants dflags) oFFSET_StgRegTable_rHpAlloc :: DynFlags -> Int-oFFSET_StgRegTable_rHpAlloc dflags = pc_OFFSET_StgRegTable_rHpAlloc (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHpAlloc dflags = pc_OFFSET_StgRegTable_rHpAlloc (platformConstants dflags) oFFSET_stgEagerBlackholeInfo :: DynFlags -> Int-oFFSET_stgEagerBlackholeInfo dflags = pc_OFFSET_stgEagerBlackholeInfo (sPlatformConstants (settings dflags))+oFFSET_stgEagerBlackholeInfo dflags = pc_OFFSET_stgEagerBlackholeInfo (platformConstants dflags) oFFSET_stgGCEnter1 :: DynFlags -> Int-oFFSET_stgGCEnter1 dflags = pc_OFFSET_stgGCEnter1 (sPlatformConstants (settings dflags))+oFFSET_stgGCEnter1 dflags = pc_OFFSET_stgGCEnter1 (platformConstants dflags) oFFSET_stgGCFun :: DynFlags -> Int-oFFSET_stgGCFun dflags = pc_OFFSET_stgGCFun (sPlatformConstants (settings dflags))+oFFSET_stgGCFun dflags = pc_OFFSET_stgGCFun (platformConstants dflags) oFFSET_Capability_r :: DynFlags -> Int-oFFSET_Capability_r dflags = pc_OFFSET_Capability_r (sPlatformConstants (settings dflags))+oFFSET_Capability_r dflags = pc_OFFSET_Capability_r (platformConstants dflags) oFFSET_bdescr_start :: DynFlags -> Int-oFFSET_bdescr_start dflags = pc_OFFSET_bdescr_start (sPlatformConstants (settings dflags))+oFFSET_bdescr_start dflags = pc_OFFSET_bdescr_start (platformConstants dflags) oFFSET_bdescr_free :: DynFlags -> Int-oFFSET_bdescr_free dflags = pc_OFFSET_bdescr_free (sPlatformConstants (settings dflags))+oFFSET_bdescr_free dflags = pc_OFFSET_bdescr_free (platformConstants dflags) oFFSET_bdescr_blocks :: DynFlags -> Int-oFFSET_bdescr_blocks dflags = pc_OFFSET_bdescr_blocks (sPlatformConstants (settings dflags))+oFFSET_bdescr_blocks dflags = pc_OFFSET_bdescr_blocks (platformConstants dflags) oFFSET_bdescr_flags :: DynFlags -> Int-oFFSET_bdescr_flags dflags = pc_OFFSET_bdescr_flags (sPlatformConstants (settings dflags))+oFFSET_bdescr_flags dflags = pc_OFFSET_bdescr_flags (platformConstants dflags) sIZEOF_CostCentreStack :: DynFlags -> Int-sIZEOF_CostCentreStack dflags = pc_SIZEOF_CostCentreStack (sPlatformConstants (settings dflags))+sIZEOF_CostCentreStack dflags = pc_SIZEOF_CostCentreStack (platformConstants dflags) oFFSET_CostCentreStack_mem_alloc :: DynFlags -> Int-oFFSET_CostCentreStack_mem_alloc dflags = pc_OFFSET_CostCentreStack_mem_alloc (sPlatformConstants (settings dflags))+oFFSET_CostCentreStack_mem_alloc dflags = pc_OFFSET_CostCentreStack_mem_alloc (platformConstants dflags) oFFSET_CostCentreStack_scc_count :: DynFlags -> Int-oFFSET_CostCentreStack_scc_count dflags = pc_OFFSET_CostCentreStack_scc_count (sPlatformConstants (settings dflags))+oFFSET_CostCentreStack_scc_count dflags = pc_OFFSET_CostCentreStack_scc_count (platformConstants dflags) oFFSET_StgHeader_ccs :: DynFlags -> Int-oFFSET_StgHeader_ccs dflags = pc_OFFSET_StgHeader_ccs (sPlatformConstants (settings dflags))+oFFSET_StgHeader_ccs dflags = pc_OFFSET_StgHeader_ccs (platformConstants dflags) oFFSET_StgHeader_ldvw :: DynFlags -> Int-oFFSET_StgHeader_ldvw dflags = pc_OFFSET_StgHeader_ldvw (sPlatformConstants (settings dflags))+oFFSET_StgHeader_ldvw dflags = pc_OFFSET_StgHeader_ldvw (platformConstants dflags) sIZEOF_StgSMPThunkHeader :: DynFlags -> Int-sIZEOF_StgSMPThunkHeader dflags = pc_SIZEOF_StgSMPThunkHeader (sPlatformConstants (settings dflags))+sIZEOF_StgSMPThunkHeader dflags = pc_SIZEOF_StgSMPThunkHeader (platformConstants dflags) oFFSET_StgEntCounter_allocs :: DynFlags -> Int-oFFSET_StgEntCounter_allocs dflags = pc_OFFSET_StgEntCounter_allocs (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_allocs dflags = pc_OFFSET_StgEntCounter_allocs (platformConstants dflags) oFFSET_StgEntCounter_allocd :: DynFlags -> Int-oFFSET_StgEntCounter_allocd dflags = pc_OFFSET_StgEntCounter_allocd (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_allocd dflags = pc_OFFSET_StgEntCounter_allocd (platformConstants dflags) oFFSET_StgEntCounter_registeredp :: DynFlags -> Int-oFFSET_StgEntCounter_registeredp dflags = pc_OFFSET_StgEntCounter_registeredp (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_registeredp dflags = pc_OFFSET_StgEntCounter_registeredp (platformConstants dflags) oFFSET_StgEntCounter_link :: DynFlags -> Int-oFFSET_StgEntCounter_link dflags = pc_OFFSET_StgEntCounter_link (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_link dflags = pc_OFFSET_StgEntCounter_link (platformConstants dflags) oFFSET_StgEntCounter_entry_count :: DynFlags -> Int-oFFSET_StgEntCounter_entry_count dflags = pc_OFFSET_StgEntCounter_entry_count (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_entry_count dflags = pc_OFFSET_StgEntCounter_entry_count (platformConstants dflags) sIZEOF_StgUpdateFrame_NoHdr :: DynFlags -> Int-sIZEOF_StgUpdateFrame_NoHdr dflags = pc_SIZEOF_StgUpdateFrame_NoHdr (sPlatformConstants (settings dflags))+sIZEOF_StgUpdateFrame_NoHdr dflags = pc_SIZEOF_StgUpdateFrame_NoHdr (platformConstants dflags) sIZEOF_StgMutArrPtrs_NoHdr :: DynFlags -> Int-sIZEOF_StgMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgMutArrPtrs_NoHdr (sPlatformConstants (settings dflags))+sIZEOF_StgMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgMutArrPtrs_NoHdr (platformConstants dflags) oFFSET_StgMutArrPtrs_ptrs :: DynFlags -> Int-oFFSET_StgMutArrPtrs_ptrs dflags = pc_OFFSET_StgMutArrPtrs_ptrs (sPlatformConstants (settings dflags))+oFFSET_StgMutArrPtrs_ptrs dflags = pc_OFFSET_StgMutArrPtrs_ptrs (platformConstants dflags) oFFSET_StgMutArrPtrs_size :: DynFlags -> Int-oFFSET_StgMutArrPtrs_size dflags = pc_OFFSET_StgMutArrPtrs_size (sPlatformConstants (settings dflags))+oFFSET_StgMutArrPtrs_size dflags = pc_OFFSET_StgMutArrPtrs_size (platformConstants dflags) sIZEOF_StgSmallMutArrPtrs_NoHdr :: DynFlags -> Int-sIZEOF_StgSmallMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgSmallMutArrPtrs_NoHdr (sPlatformConstants (settings dflags))+sIZEOF_StgSmallMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgSmallMutArrPtrs_NoHdr (platformConstants dflags) oFFSET_StgSmallMutArrPtrs_ptrs :: DynFlags -> Int-oFFSET_StgSmallMutArrPtrs_ptrs dflags = pc_OFFSET_StgSmallMutArrPtrs_ptrs (sPlatformConstants (settings dflags))+oFFSET_StgSmallMutArrPtrs_ptrs dflags = pc_OFFSET_StgSmallMutArrPtrs_ptrs (platformConstants dflags) sIZEOF_StgArrBytes_NoHdr :: DynFlags -> Int-sIZEOF_StgArrBytes_NoHdr dflags = pc_SIZEOF_StgArrBytes_NoHdr (sPlatformConstants (settings dflags))+sIZEOF_StgArrBytes_NoHdr dflags = pc_SIZEOF_StgArrBytes_NoHdr (platformConstants dflags) oFFSET_StgArrBytes_bytes :: DynFlags -> Int-oFFSET_StgArrBytes_bytes dflags = pc_OFFSET_StgArrBytes_bytes (sPlatformConstants (settings dflags))+oFFSET_StgArrBytes_bytes dflags = pc_OFFSET_StgArrBytes_bytes (platformConstants dflags) oFFSET_StgTSO_alloc_limit :: DynFlags -> Int-oFFSET_StgTSO_alloc_limit dflags = pc_OFFSET_StgTSO_alloc_limit (sPlatformConstants (settings dflags))+oFFSET_StgTSO_alloc_limit dflags = pc_OFFSET_StgTSO_alloc_limit (platformConstants dflags) oFFSET_StgTSO_cccs :: DynFlags -> Int-oFFSET_StgTSO_cccs dflags = pc_OFFSET_StgTSO_cccs (sPlatformConstants (settings dflags))+oFFSET_StgTSO_cccs dflags = pc_OFFSET_StgTSO_cccs (platformConstants dflags) oFFSET_StgTSO_stackobj :: DynFlags -> Int-oFFSET_StgTSO_stackobj dflags = pc_OFFSET_StgTSO_stackobj (sPlatformConstants (settings dflags))+oFFSET_StgTSO_stackobj dflags = pc_OFFSET_StgTSO_stackobj (platformConstants dflags) oFFSET_StgStack_sp :: DynFlags -> Int-oFFSET_StgStack_sp dflags = pc_OFFSET_StgStack_sp (sPlatformConstants (settings dflags))+oFFSET_StgStack_sp dflags = pc_OFFSET_StgStack_sp (platformConstants dflags) oFFSET_StgStack_stack :: DynFlags -> Int-oFFSET_StgStack_stack dflags = pc_OFFSET_StgStack_stack (sPlatformConstants (settings dflags))+oFFSET_StgStack_stack dflags = pc_OFFSET_StgStack_stack (platformConstants dflags) oFFSET_StgUpdateFrame_updatee :: DynFlags -> Int-oFFSET_StgUpdateFrame_updatee dflags = pc_OFFSET_StgUpdateFrame_updatee (sPlatformConstants (settings dflags))+oFFSET_StgUpdateFrame_updatee dflags = pc_OFFSET_StgUpdateFrame_updatee (platformConstants dflags) oFFSET_StgFunInfoExtraFwd_arity :: DynFlags -> Int-oFFSET_StgFunInfoExtraFwd_arity dflags = pc_OFFSET_StgFunInfoExtraFwd_arity (sPlatformConstants (settings dflags))+oFFSET_StgFunInfoExtraFwd_arity dflags = pc_OFFSET_StgFunInfoExtraFwd_arity (platformConstants dflags) sIZEOF_StgFunInfoExtraRev :: DynFlags -> Int-sIZEOF_StgFunInfoExtraRev dflags = pc_SIZEOF_StgFunInfoExtraRev (sPlatformConstants (settings dflags))+sIZEOF_StgFunInfoExtraRev dflags = pc_SIZEOF_StgFunInfoExtraRev (platformConstants dflags) oFFSET_StgFunInfoExtraRev_arity :: DynFlags -> Int-oFFSET_StgFunInfoExtraRev_arity dflags = pc_OFFSET_StgFunInfoExtraRev_arity (sPlatformConstants (settings dflags))+oFFSET_StgFunInfoExtraRev_arity dflags = pc_OFFSET_StgFunInfoExtraRev_arity (platformConstants dflags) mAX_SPEC_SELECTEE_SIZE :: DynFlags -> Int-mAX_SPEC_SELECTEE_SIZE dflags = pc_MAX_SPEC_SELECTEE_SIZE (sPlatformConstants (settings dflags))+mAX_SPEC_SELECTEE_SIZE dflags = pc_MAX_SPEC_SELECTEE_SIZE (platformConstants dflags) mAX_SPEC_AP_SIZE :: DynFlags -> Int-mAX_SPEC_AP_SIZE dflags = pc_MAX_SPEC_AP_SIZE (sPlatformConstants (settings dflags))+mAX_SPEC_AP_SIZE dflags = pc_MAX_SPEC_AP_SIZE (platformConstants dflags) mIN_PAYLOAD_SIZE :: DynFlags -> Int-mIN_PAYLOAD_SIZE dflags = pc_MIN_PAYLOAD_SIZE (sPlatformConstants (settings dflags))+mIN_PAYLOAD_SIZE dflags = pc_MIN_PAYLOAD_SIZE (platformConstants dflags) mIN_INTLIKE :: DynFlags -> Int-mIN_INTLIKE dflags = pc_MIN_INTLIKE (sPlatformConstants (settings dflags))+mIN_INTLIKE dflags = pc_MIN_INTLIKE (platformConstants dflags) mAX_INTLIKE :: DynFlags -> Int-mAX_INTLIKE dflags = pc_MAX_INTLIKE (sPlatformConstants (settings dflags))+mAX_INTLIKE dflags = pc_MAX_INTLIKE (platformConstants dflags) mIN_CHARLIKE :: DynFlags -> Int-mIN_CHARLIKE dflags = pc_MIN_CHARLIKE (sPlatformConstants (settings dflags))+mIN_CHARLIKE dflags = pc_MIN_CHARLIKE (platformConstants dflags) mAX_CHARLIKE :: DynFlags -> Int-mAX_CHARLIKE dflags = pc_MAX_CHARLIKE (sPlatformConstants (settings dflags))+mAX_CHARLIKE dflags = pc_MAX_CHARLIKE (platformConstants dflags) mUT_ARR_PTRS_CARD_BITS :: DynFlags -> Int-mUT_ARR_PTRS_CARD_BITS dflags = pc_MUT_ARR_PTRS_CARD_BITS (sPlatformConstants (settings dflags))+mUT_ARR_PTRS_CARD_BITS dflags = pc_MUT_ARR_PTRS_CARD_BITS (platformConstants dflags) mAX_Vanilla_REG :: DynFlags -> Int-mAX_Vanilla_REG dflags = pc_MAX_Vanilla_REG (sPlatformConstants (settings dflags))+mAX_Vanilla_REG dflags = pc_MAX_Vanilla_REG (platformConstants dflags) mAX_Float_REG :: DynFlags -> Int-mAX_Float_REG dflags = pc_MAX_Float_REG (sPlatformConstants (settings dflags))+mAX_Float_REG dflags = pc_MAX_Float_REG (platformConstants dflags) mAX_Double_REG :: DynFlags -> Int-mAX_Double_REG dflags = pc_MAX_Double_REG (sPlatformConstants (settings dflags))+mAX_Double_REG dflags = pc_MAX_Double_REG (platformConstants dflags) mAX_Long_REG :: DynFlags -> Int-mAX_Long_REG dflags = pc_MAX_Long_REG (sPlatformConstants (settings dflags))+mAX_Long_REG dflags = pc_MAX_Long_REG (platformConstants dflags) mAX_XMM_REG :: DynFlags -> Int-mAX_XMM_REG dflags = pc_MAX_XMM_REG (sPlatformConstants (settings dflags))+mAX_XMM_REG dflags = pc_MAX_XMM_REG (platformConstants dflags) mAX_Real_Vanilla_REG :: DynFlags -> Int-mAX_Real_Vanilla_REG dflags = pc_MAX_Real_Vanilla_REG (sPlatformConstants (settings dflags))+mAX_Real_Vanilla_REG dflags = pc_MAX_Real_Vanilla_REG (platformConstants dflags) mAX_Real_Float_REG :: DynFlags -> Int-mAX_Real_Float_REG dflags = pc_MAX_Real_Float_REG (sPlatformConstants (settings dflags))+mAX_Real_Float_REG dflags = pc_MAX_Real_Float_REG (platformConstants dflags) mAX_Real_Double_REG :: DynFlags -> Int-mAX_Real_Double_REG dflags = pc_MAX_Real_Double_REG (sPlatformConstants (settings dflags))+mAX_Real_Double_REG dflags = pc_MAX_Real_Double_REG (platformConstants dflags) mAX_Real_XMM_REG :: DynFlags -> Int-mAX_Real_XMM_REG dflags = pc_MAX_Real_XMM_REG (sPlatformConstants (settings dflags))+mAX_Real_XMM_REG dflags = pc_MAX_Real_XMM_REG (platformConstants dflags) mAX_Real_Long_REG :: DynFlags -> Int-mAX_Real_Long_REG dflags = pc_MAX_Real_Long_REG (sPlatformConstants (settings dflags))+mAX_Real_Long_REG dflags = pc_MAX_Real_Long_REG (platformConstants dflags) rESERVED_C_STACK_BYTES :: DynFlags -> Int-rESERVED_C_STACK_BYTES dflags = pc_RESERVED_C_STACK_BYTES (sPlatformConstants (settings dflags))+rESERVED_C_STACK_BYTES dflags = pc_RESERVED_C_STACK_BYTES (platformConstants dflags) rESERVED_STACK_WORDS :: DynFlags -> Int-rESERVED_STACK_WORDS dflags = pc_RESERVED_STACK_WORDS (sPlatformConstants (settings dflags))+rESERVED_STACK_WORDS dflags = pc_RESERVED_STACK_WORDS (platformConstants dflags) aP_STACK_SPLIM :: DynFlags -> Int-aP_STACK_SPLIM dflags = pc_AP_STACK_SPLIM (sPlatformConstants (settings dflags))+aP_STACK_SPLIM dflags = pc_AP_STACK_SPLIM (platformConstants dflags) wORD_SIZE :: DynFlags -> Int-wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))+wORD_SIZE dflags = pc_WORD_SIZE (platformConstants dflags) dOUBLE_SIZE :: DynFlags -> Int-dOUBLE_SIZE dflags = pc_DOUBLE_SIZE (sPlatformConstants (settings dflags))+dOUBLE_SIZE dflags = pc_DOUBLE_SIZE (platformConstants dflags) cINT_SIZE :: DynFlags -> Int-cINT_SIZE dflags = pc_CINT_SIZE (sPlatformConstants (settings dflags))+cINT_SIZE dflags = pc_CINT_SIZE (platformConstants dflags) cLONG_SIZE :: DynFlags -> Int-cLONG_SIZE dflags = pc_CLONG_SIZE (sPlatformConstants (settings dflags))+cLONG_SIZE dflags = pc_CLONG_SIZE (platformConstants dflags) cLONG_LONG_SIZE :: DynFlags -> Int-cLONG_LONG_SIZE dflags = pc_CLONG_LONG_SIZE (sPlatformConstants (settings dflags))+cLONG_LONG_SIZE dflags = pc_CLONG_LONG_SIZE (platformConstants dflags) bITMAP_BITS_SHIFT :: DynFlags -> Int-bITMAP_BITS_SHIFT dflags = pc_BITMAP_BITS_SHIFT (sPlatformConstants (settings dflags))+bITMAP_BITS_SHIFT dflags = pc_BITMAP_BITS_SHIFT (platformConstants dflags) tAG_BITS :: DynFlags -> Int-tAG_BITS dflags = pc_TAG_BITS (sPlatformConstants (settings dflags))+tAG_BITS dflags = pc_TAG_BITS (platformConstants dflags) wORDS_BIGENDIAN :: DynFlags -> Bool-wORDS_BIGENDIAN dflags = pc_WORDS_BIGENDIAN (sPlatformConstants (settings dflags))+wORDS_BIGENDIAN dflags = pc_WORDS_BIGENDIAN (platformConstants dflags) dYNAMIC_BY_DEFAULT :: DynFlags -> Bool-dYNAMIC_BY_DEFAULT dflags = pc_DYNAMIC_BY_DEFAULT (sPlatformConstants (settings dflags))+dYNAMIC_BY_DEFAULT dflags = pc_DYNAMIC_BY_DEFAULT (platformConstants dflags) lDV_SHIFT :: DynFlags -> Int-lDV_SHIFT dflags = pc_LDV_SHIFT (sPlatformConstants (settings dflags))+lDV_SHIFT dflags = pc_LDV_SHIFT (platformConstants dflags) iLDV_CREATE_MASK :: DynFlags -> Integer-iLDV_CREATE_MASK dflags = pc_ILDV_CREATE_MASK (sPlatformConstants (settings dflags))+iLDV_CREATE_MASK dflags = pc_ILDV_CREATE_MASK (platformConstants dflags) iLDV_STATE_CREATE :: DynFlags -> Integer-iLDV_STATE_CREATE dflags = pc_ILDV_STATE_CREATE (sPlatformConstants (settings dflags))+iLDV_STATE_CREATE dflags = pc_ILDV_STATE_CREATE (platformConstants dflags) iLDV_STATE_USE :: DynFlags -> Integer-iLDV_STATE_USE dflags = pc_ILDV_STATE_USE (sPlatformConstants (settings dflags))+iLDV_STATE_USE dflags = pc_ILDV_STATE_USE (platformConstants dflags)
ghc-lib/generated/ghcversion.h view
@@ -6,7 +6,7 @@ #endif #define __GLASGOW_HASKELL_PATCHLEVEL1__ 0-#define __GLASGOW_HASKELL_PATCHLEVEL2__ 20190522+#define __GLASGOW_HASKELL_PATCHLEVEL2__ 20190603 #define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\ ((ma)*100+(mi)) < __GLASGOW_HASKELL__ || \
ghc-lib/stage1/lib/settings view
@@ -19,7 +19,7 @@ ,("dllwrap command", "/bin/false") ,("windres command", "/bin/false") ,("libtool command", "libtool")-,("unlit command", "$topdir/bin/ghc-lib/stage0/lib/bin/unlit")+,("unlit command", "$topdir/bin/unlit") ,("cross compiling", "NO") ,("target platform string", "x86_64-apple-darwin") ,("target os", "OSDarwin")@@ -37,9 +37,9 @@ ,("Use interpreter", "YES") ,("Use native code generator", "YES") ,("Support SMP", "YES")-,("RTS ways", "YES")+,("RTS ways", "v thr p thr_p debug_p thr_debug_p l thr_l debug thr_debug dyn thr_dyn debug_dyn l_dyn thr_debug_dyn thr_l_dyn") ,("Tables next to code", "YES")-,("Leading underscore", "NO")+,("Leading underscore", "YES") ,("Use LibFFI", "NO") ,("Use Threads", "YES") ,("Use Debugging", "NO")
ghc/GHCi/Leak.hs view
@@ -7,7 +7,6 @@ import Control.Monad import Data.Bits-import DynFlags ( sTargetPlatform ) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC import GHC.Ptr (Ptr (..))@@ -68,7 +67,7 @@ show (maskTagBits addr)) tagBits- | target32Bit (sTargetPlatform (settings dflags)) = 2+ | target32Bit (targetPlatform dflags) = 2 | otherwise = 3 maskTagBits :: Ptr a -> Ptr a
includes/CodeGen.Platform.hs view
@@ -2,7 +2,7 @@ import CmmExpr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc))-import Panic+import PlainPanic #endif import Reg
includes/MachDeps.h view
@@ -34,7 +34,7 @@ * configuration from 'targetPlatform :: DynFlags -> Platform' * record. A few wrappers are already defined and used throughout GHC: * wORD_SIZE :: DynFlags -> Int- * wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))+ * wORD_SIZE dflags = pc_WORD_SIZE (platformConstants dflags) * * Hence we hide these macros from -DSTAGE=1 */