diff options
Diffstat (limited to 'hadrian/src/Oracles')
| -rw-r--r-- | hadrian/src/Oracles/Flag.hs | 74 | ||||
| -rw-r--r-- | hadrian/src/Oracles/ModuleFiles.hs | 160 | ||||
| -rw-r--r-- | hadrian/src/Oracles/PackageData.hs | 66 | ||||
| -rw-r--r-- | hadrian/src/Oracles/Setting.hs | 236 |
4 files changed, 0 insertions, 536 deletions
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs deleted file mode 100644 index 1bd4dfeefd..0000000000 --- a/hadrian/src/Oracles/Flag.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Oracles.Flag ( - Flag (..), flag, crossCompiling, platformSupportsSharedLibs, - ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects - ) where - -import Hadrian.Oracles.TextFile - -import Base -import Oracles.Setting - -data Flag = ArSupportsAtFile - | CrossCompiling - | GccIsClang - | GhcUnregisterised - | LeadingUnderscore - | SolarisBrokenShld - | SplitObjectsBroken - | WithLibdw - | HaveLibMingwEx - | UseSystemFfi - --- Note, if a flag is set to empty string we treat it as set to NO. This seems --- fragile, but some flags do behave like this, e.g. GccIsClang. -flag :: Flag -> Action Bool -flag f = do - let key = case f of - ArSupportsAtFile -> "ar-supports-at-file" - CrossCompiling -> "cross-compiling" - GccIsClang -> "gcc-is-clang" - GhcUnregisterised -> "ghc-unregisterised" - LeadingUnderscore -> "leading-underscore" - SolarisBrokenShld -> "solaris-broken-shld" - SplitObjectsBroken -> "split-objects-broken" - WithLibdw -> "with-libdw" - HaveLibMingwEx -> "have-lib-mingw-ex" - UseSystemFfi -> "use-system-ffi" - value <- lookupValueOrError configFile key - when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " - ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." - return $ value == "YES" - -crossCompiling :: Action Bool -crossCompiling = flag CrossCompiling - -platformSupportsSharedLibs :: Action Bool -platformSupportsSharedLibs = do - badPlatform <- anyTargetPlatform [ "powerpc-unknown-linux" - , "x86_64-unknown-mingw32" - , "i386-unknown-mingw32" ] - solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ] - solarisBroken <- flag SolarisBrokenShld - return $ not (badPlatform || solaris && solarisBroken) - -ghcWithSMP :: Action Bool -ghcWithSMP = do - goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "arm"] - ghcUnreg <- flag GhcUnregisterised - return $ goodArch && not ghcUnreg - -ghcWithNativeCodeGen :: Action Bool -ghcWithNativeCodeGen = do - goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc"] - badOs <- anyTargetOs ["ios", "aix"] - ghcUnreg <- flag GhcUnregisterised - return $ goodArch && not badOs && not ghcUnreg - -supportsSplitObjects :: Action Bool -supportsSplitObjects = do - broken <- flag SplitObjectsBroken - ghcUnreg <- flag GhcUnregisterised - goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc" ] - goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "darwin", "solaris2" - , "freebsd", "dragonfly", "netbsd", "openbsd" ] - return $ not broken && not ghcUnreg && goodArch && goodOs diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs deleted file mode 100644 index c7175dbc1c..0000000000 --- a/hadrian/src/Oracles/ModuleFiles.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module Oracles.ModuleFiles ( - decodeModule, encodeModule, findGenerator, hsSources, hsObjects, moduleFilesOracle - ) where - -import qualified Data.HashMap.Strict as Map - -import Base -import Builder -import Context -import GHC -import Oracles.PackageData - -newtype ModuleFiles = ModuleFiles (Stage, Package) - deriving (Binary, Eq, Hashable, NFData, Show, Typeable) -type instance RuleResult ModuleFiles = [Maybe FilePath] - -newtype Generator = Generator (Stage, Package, FilePath) - deriving (Binary, Eq, Hashable, NFData, Show, Typeable) -type instance RuleResult Generator = Maybe FilePath - --- | We scan for the following Haskell source extensions when looking for module --- files. Note, we do not list "*.(l)hs-boot" files here, as they can never --- appear by themselves and always have accompanying "*.(l)hs" master files. -haskellExtensions :: [String] -haskellExtensions = [".hs", ".lhs"] - --- | Non-Haskell source extensions and corresponding builders. -otherExtensions :: [(String, Builder)] -otherExtensions = [ (".x" , Alex ) - , (".y" , Happy ) - , (".ly" , Happy ) - , (".hsc", Hsc2Hs) ] - --- | We match the following file patterns when looking for module files. -moduleFilePatterns :: [FilePattern] -moduleFilePatterns = map ("*" ++) $ haskellExtensions ++ map fst otherExtensions - --- | Given a FilePath determine the corresponding builder. -determineBuilder :: FilePath -> Maybe Builder -determineBuilder file = lookup (takeExtension file) otherExtensions - --- | Given a module name extract the directory and file name, e.g.: --- --- > decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity") --- > decodeModule "Prelude" == ("", "Prelude") -decodeModule :: String -> (FilePath, String) -decodeModule modName = (intercalate "/" (init xs), last xs) - where - xs = words $ replaceEq '.' ' ' modName - --- | Given the directory and file name find the corresponding module name, e.g.: --- --- > encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity" --- > encodeModule "" "Prelude" == "Prelude" --- > uncurry encodeModule (decodeModule name) == name -encodeModule :: FilePath -> String -> String -encodeModule dir file - | dir == "" = takeBaseName file - | otherwise = replaceEq '/' '.' dir ++ '.' : takeBaseName file - --- | Find the generator for a given 'Context' and a source file. For example: --- findGenerator (Context Stage1 compiler vanilla) --- "_build/stage1/compiler/build/Lexer.hs" --- == Just ("compiler/parser/Lexer.x", Alex) --- findGenerator (Context Stage1 base vanilla) --- "_build/stage1/base/build/Prelude.hs" --- == Nothing -findGenerator :: Context -> FilePath -> Action (Maybe (FilePath, Builder)) -findGenerator Context {..} file = do - maybeSource <- askOracle $ Generator (stage, package, file) - return $ do - source <- maybeSource - builder <- determineBuilder source - return (source, builder) - --- | Find all Haskell source files for a given 'Context'. -hsSources :: Context -> Action [FilePath] -hsSources context = do - let modFile (m, Nothing ) = generatedFile context m - modFile (m, Just file ) - | takeExtension file `elem` haskellExtensions = return file - | otherwise = generatedFile context m - mapM modFile =<< contextFiles context - --- | Find all Haskell object files for a given 'Context'. Note: this is a much --- simpler function compared to 'hsSources', because all object files live in --- the build directory regardless of whether they are generated or not. -hsObjects :: Context -> Action [FilePath] -hsObjects context = do - path <- buildPath context - modules <- pkgDataList (Modules path) - -- GHC.Prim module is only for documentation, we do not actually build it. - mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules) - --- | Generated module files live in the 'Context' specific build directory. -generatedFile :: Context -> String -> Action FilePath -generatedFile context moduleName = do - path <- buildPath context - return $ path -/- moduleSource moduleName - -moduleSource :: String -> FilePath -moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" - --- | Module files for a given 'Context'. -contextFiles :: Context -> Action [(String, Maybe FilePath)] -contextFiles context@Context {..} = do - path <- buildPath context - modules <- fmap sort . pkgDataList $ Modules path - zip modules <$> askOracle (ModuleFiles (stage, package)) - --- | This is an important oracle whose role is to find and cache module source --- files. It takes a 'Stage' and a 'Package', looks up corresponding source --- directories @dirs@ and a sorted list of module names @modules@, and for each --- module, e.g. @A.B.C@, returns a 'FilePath' of the form @dir/A/B/C.extension@, --- such that @dir@ belongs to @dirs@, and file @dir/A/B/C.extension@ exists, or --- 'Nothing' if there is no such file. If more than one matching file is found --- an error is raised. For example, for 'Stage1' and 'compiler', @dirs@ will --- contain ["compiler/codeGen", "compiler/parser"], and @modules@ will contain --- ["CodeGen.Platform.ARM", "Config", "Lexer"]; the oracle will produce a list --- containing [Just "compiler/codeGen/CodeGen/Platform/ARM.hs", Nothing, --- Just "compiler/parser/Lexer.x"]. The oracle ignores @.(l)hs-boot@ files. -moduleFilesOracle :: Rules () -moduleFilesOracle = void $ do - void . addOracle $ \(ModuleFiles (stage, package)) -> do - let context = vanillaContext stage package - path <- buildPath context - srcDirs <- pkgDataList $ SrcDirs path - modules <- fmap sort . pkgDataList $ Modules path - autogen <- autogenPath context - let dirs = autogen : map (pkgPath package -/-) srcDirs - modDirFiles = groupSort $ map decodeModule modules - result <- concatForM dirs $ \dir -> do - todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles - forM todo $ \(mDir, mFiles) -> do - let fullDir = unifyPath $ dir -/- mDir - files <- getDirectoryFiles fullDir moduleFilePatterns - let cmp f = compare (dropExtension f) - found = intersectOrd cmp files mFiles - return (map (fullDir -/-) found, mDir) - let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ] - multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ] - unless (null multi) $ do - let (m, f1, f2) = head multi - error $ "Module " ++ m ++ " has more than one source file: " - ++ f1 ++ " and " ++ f2 ++ "." - return $ lookupAll modules pairs - - -- Optimisation: we discard Haskell files here, because they are never used - -- as generators, and hence would be discarded in 'findGenerator' anyway. - generators <- newCache $ \(stage, package) -> do - let context = vanillaContext stage package - files <- contextFiles context - list <- sequence [ (,src) <$> generatedFile context modName - | (modName, Just src) <- files - , takeExtension src `notElem` haskellExtensions ] - return $ Map.fromList list - - addOracle $ \(Generator (stage, package, file)) -> - Map.lookup file <$> generators (stage, package) diff --git a/hadrian/src/Oracles/PackageData.hs b/hadrian/src/Oracles/PackageData.hs deleted file mode 100644 index cdfe9bfb48..0000000000 --- a/hadrian/src/Oracles/PackageData.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Oracles.PackageData ( - PackageData (..), PackageDataList (..), pkgData, pkgDataList - ) where - -import Hadrian.Oracles.TextFile - -import Base - -newtype PackageData = BuildGhciLib FilePath - -data PackageDataList = AsmSrcs FilePath - | CcArgs FilePath - | CSrcs FilePath - | CmmSrcs FilePath - | CppArgs FilePath - | DepCcArgs FilePath - | DepExtraLibs FilePath - | DepIds FilePath - | DepIncludeDirs FilePath - | DepLdArgs FilePath - | DepLibDirs FilePath - | DepNames FilePath - | Deps FilePath - | HiddenModules FilePath - | HsArgs FilePath - | IncludeDirs FilePath - | LdArgs FilePath - | Modules FilePath - | SrcDirs FilePath - -askPackageData :: FilePath -> String -> Action String -askPackageData path = lookupValueOrEmpty (path -/- "package-data.mk") - --- | For each @PackageData path@ the file 'path/package-data.mk' contains a line --- of the form 'path_VERSION = 1.2.3.4'. @pkgData (PackageData path)@ is an --- Action that consults the file and returns "1.2.3.4". -pkgData :: PackageData -> Action String -pkgData packageData = case packageData of - BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB" - --- | @PackageDataList path@ is used for multiple string options separated by --- spaces, such as @path_MODULES = Data.Array Data.Array.Base ...@. --- @pkgListData Modules@ therefore returns ["Data.Array", "Data.Array.Base", ...] -pkgDataList :: PackageDataList -> Action [String] -pkgDataList packageData = fmap (map unquote . words) $ case packageData of - AsmSrcs path -> askPackageData path "S_SRCS" - CcArgs path -> askPackageData path "CC_OPTS" - CSrcs path -> askPackageData path "C_SRCS" - CmmSrcs path -> askPackageData path "CMM_SRCS" - CppArgs path -> askPackageData path "CPP_OPTS" - DepCcArgs path -> askPackageData path "DEP_CC_OPTS" - DepExtraLibs path -> askPackageData path "DEP_EXTRA_LIBS" - DepIds path -> askPackageData path "DEP_IPIDS" - DepIncludeDirs path -> askPackageData path "DEP_INCLUDE_DIRS_SINGLE_QUOTED" - DepLibDirs path -> askPackageData path "DEP_LIB_DIRS_SINGLE_QUOTED" - DepLdArgs path -> askPackageData path "DEP_LD_OPTS" - DepNames path -> askPackageData path "DEP_NAMES" - Deps path -> askPackageData path "DEPS" - HiddenModules path -> askPackageData path "HIDDEN_MODULES" - HsArgs path -> askPackageData path "HC_OPTS" - IncludeDirs path -> askPackageData path "INCLUDE_DIRS" - LdArgs path -> askPackageData path "LD_OPTS" - Modules path -> askPackageData path "MODULES" - SrcDirs path -> askPackageData path "HS_SRC_DIRS" - where - unquote = dropWhile (== '\'') . dropWhileEnd (== '\'') diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs deleted file mode 100644 index aa49011e1e..0000000000 --- a/hadrian/src/Oracles/Setting.hs +++ /dev/null @@ -1,236 +0,0 @@ -module Oracles.Setting ( - configFile, Setting (..), SettingList (..), setting, settingList, getSetting, - getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, - ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors, - ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost, - topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf - ) where - -import Hadrian.Expression -import Hadrian.Oracles.TextFile -import Hadrian.Oracles.Path - -import Base - --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). --- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'. --- @setting TargetOs@ looks up the config file and returns "mingw32". --- 'SettingList' is used for multiple string values separated by spaces, such --- as @gmp-include-dirs = a b@. --- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"]. -data Setting = BuildArch - | BuildOs - | BuildPlatform - | BuildVendor - | CcClangBackend - | CcLlvmBackend - | DynamicExtension - | GhcMajorVersion - | GhcMinorVersion - | GhcPatchLevel - | GhcVersion - | GhcSourcePath - | HostArch - | HostOs - | HostPlatform - | HostVendor - | ProjectGitCommitId - | ProjectName - | ProjectVersion - | ProjectVersionInt - | ProjectPatchLevel - | ProjectPatchLevel1 - | ProjectPatchLevel2 - | TargetArch - | TargetOs - | TargetPlatform - | TargetPlatformFull - | TargetVendor - | LlvmTarget - | FfiIncludeDir - | FfiLibDir - | GmpIncludeDir - | GmpLibDir - | IconvIncludeDir - | IconvLibDir - | CursesLibDir - -- Paths to where GHC is installed (ref: mk/install.mk) - | InstallPrefix - | InstallBinDir - | InstallLibDir - | InstallDataRootDir - -- Command lines for invoking the @install@ utility - | Install - | InstallData - | InstallProgram - | InstallScript - | InstallDir - -- Command line for creating a symbolic link - | LnS - -data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage - | ConfGccLinkerArgs Stage - | ConfLdLinkerArgs Stage - | HsCppArgs - --- | Maps 'Setting's to names in @cfg/system.config.in@. -setting :: Setting -> Action String -setting key = lookupValueOrError configFile $ case key of - BuildArch -> "build-arch" - BuildOs -> "build-os" - BuildPlatform -> "build-platform" - BuildVendor -> "build-vendor" - CcClangBackend -> "cc-clang-backend" - CcLlvmBackend -> "cc-llvm-backend" - DynamicExtension -> "dynamic-extension" - GhcMajorVersion -> "ghc-major-version" - GhcMinorVersion -> "ghc-minor-version" - GhcPatchLevel -> "ghc-patch-level" - GhcVersion -> "ghc-version" - GhcSourcePath -> "ghc-source-path" - HostArch -> "host-arch" - HostOs -> "host-os" - HostPlatform -> "host-platform" - HostVendor -> "host-vendor" - ProjectGitCommitId -> "project-git-commit-id" - ProjectName -> "project-name" - ProjectVersion -> "project-version" - ProjectVersionInt -> "project-version-int" - ProjectPatchLevel -> "project-patch-level" - ProjectPatchLevel1 -> "project-patch-level1" - ProjectPatchLevel2 -> "project-patch-level2" - TargetArch -> "target-arch" - TargetOs -> "target-os" - TargetPlatform -> "target-platform" - TargetPlatformFull -> "target-platform-full" - TargetVendor -> "target-vendor" - LlvmTarget -> "llvm-target" - FfiIncludeDir -> "ffi-include-dir" - FfiLibDir -> "ffi-lib-dir" - GmpIncludeDir -> "gmp-include-dir" - GmpLibDir -> "gmp-lib-dir" - IconvIncludeDir -> "iconv-include-dir" - IconvLibDir -> "iconv-lib-dir" - CursesLibDir -> "curses-lib-dir" - InstallPrefix -> "install-prefix" - InstallBinDir -> "install-bindir" - InstallLibDir -> "install-libdir" - InstallDataRootDir -> "install-datarootdir" - Install -> "install" - InstallDir -> "install-dir" - InstallProgram -> "install-program" - InstallScript -> "install-script" - InstallData -> "install-data" - LnS -> "ln-s" - -settingList :: SettingList -> Action [String] -settingList key = fmap words $ lookupValueOrError configFile $ case key of - ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage - ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage - ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage - HsCppArgs -> "hs-cpp-args" - --- | Get a configuration setting. -getSetting :: Setting -> Expr c b String -getSetting = expr . setting - --- | Get a list of configuration settings. -getSettingList :: SettingList -> Args c b -getSettingList = expr . settingList - -matchSetting :: Setting -> [String] -> Action Bool -matchSetting key values = (`elem` values) <$> setting key - -anyTargetPlatform :: [String] -> Action Bool -anyTargetPlatform = matchSetting TargetPlatformFull - -anyTargetOs :: [String] -> Action Bool -anyTargetOs = matchSetting TargetOs - -anyTargetArch :: [String] -> Action Bool -anyTargetArch = matchSetting TargetArch - -anyHostOs :: [String] -> Action Bool -anyHostOs = matchSetting HostOs - -iosHost :: Action Bool -iosHost = anyHostOs ["ios"] - -osxHost :: Action Bool -osxHost = anyHostOs ["darwin"] - -windowsHost :: Action Bool -windowsHost = anyHostOs ["mingw32", "cygwin32"] - -ghcWithInterpreter :: Action Bool -ghcWithInterpreter = do - goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2" - , "freebsd", "dragonfly", "netbsd", "openbsd" - , "darwin", "kfreebsdgnu" ] - goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc" - , "sparc64", "arm" ] - return $ goodOs && goodArch - -ghcEnableTablesNextToCode :: Action Bool -ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"] - -useLibFFIForAdjustors :: Action Bool -useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"] - --- | Canonicalised GHC version number, used for integer version comparisons. We --- expand GhcMinorVersion to two digits by adding a leading zero if necessary. -ghcCanonVersion :: Action String -ghcCanonVersion = do - ghcMajorVersion <- setting GhcMajorVersion - ghcMinorVersion <- setting GhcMinorVersion - let leadingZero = [ '0' | length ghcMinorVersion == 1 ] - return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion - --- ref: https://ghc.haskell.org/trac/ghc/wiki/Building/Installing#HowGHCfindsitsfiles --- | On Windows we normally build a relocatable installation, which assumes that --- the library directory @libdir@ is in a fixed location relative to the GHC --- binary, namely @../lib@. -relocatableBuild :: Action Bool -relocatableBuild = windowsHost - -installDocDir :: Action String -installDocDir = do - version <- setting ProjectVersion - dataDir <- setting InstallDataRootDir - return $ dataDir -/- ("doc/ghc-" ++ version) - --- | Path to the GHC source tree. -topDirectory :: Action FilePath -topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath - --- ref: mk/install.mk:101 --- TODO: CroosCompilePrefix --- | Unix: override @libdir@ and @datadir@ to put GHC-specific files in a --- subdirectory with the version number included. -installGhcLibDir :: Action String -installGhcLibDir = do - rBuild <- relocatableBuild - libdir <- setting InstallLibDir - if rBuild then return libdir - else do - version <- setting ProjectVersion - return $ libdir -/- ("ghc-" ++ version) - --- TODO: find out why we need version number in the dynamic suffix --- The current theory: dynamic libraries are eventually placed in a single --- giant directory in the load path of the dynamic linker, and hence we must --- distinguish different versions of GHC. In contrast static libraries live --- in their own per-package directory and hence do not need a unique filename. --- We also need to respect the system's dynamic extension, e.g. .dll or .so. -libsuf :: Way -> Action String -libsuf way = - if not (wayUnit Dynamic way) - then return $ waySuffix way ++ ".a" -- e.g., _p.a - else do - extension <- setting DynamicExtension -- e.g., .dll or .so - version <- setting ProjectVersion -- e.g., 7.11.20141222 - let prefix = wayPrefix $ removeWayUnit Dynamic way - -- e.g., p_ghc7.11.20141222.dll (the result) - return $ prefix ++ "-ghc" ++ version ++ extension |