diff options
author | Ian Lynagh <igloo@earth.li> | 2011-10-19 13:32:11 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2011-10-19 14:10:21 +0100 |
commit | 38c8b565ff8d8011e26af8ae4b03800ca29d3f38 (patch) | |
tree | 4c39b6a15d61bc551845d4e1423b28995e1a6257 /compiler | |
parent | 013a3e3b79a86e377c6c94b34f6313d58363c6b3 (diff) | |
download | haskell-38c8b565ff8d8011e26af8ae4b03800ca29d3f38.tar.gz |
Put the target platform in the settings file
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/HsVersions.h | 1 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 7 | ||||
-rw-r--r-- | compiler/main/SysTools.lhs | 13 | ||||
-rw-r--r-- | compiler/utils/Platform.hs | 82 | ||||
-rw-r--r-- | compiler/utils/Util.lhs | 7 |
5 files changed, 29 insertions, 81 deletions
diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h index f730c7eded..b6f92ae2e7 100644 --- a/compiler/HsVersions.h +++ b/compiler/HsVersions.h @@ -15,7 +15,6 @@ you will screw up the layout where they are used in case expressions! /* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */ #include "ghc_boot_platform.h" -#include "../includes/stg/ArchSpecific.h" /* This macro indicates that the target OS supports ELF-like shared libraries */ #if linux_TARGET_OS || freebsd_TARGET_OS || openbsd_TARGET_OS || solaris2_TARGET_OS diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 866301376d..e482c2df54 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -45,6 +45,7 @@ module DynFlags ( -- ** System tool settings and locations Settings(..), + targetPlatform, ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, @@ -456,7 +457,6 @@ data DynFlags = DynFlags { floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating -- See CoreMonad.FloatOutSwitches - targetPlatform :: Platform.Platform, -- ^ The platform we're compiling for. Used by the NCG. cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, @@ -569,6 +569,7 @@ data DynFlags = DynFlags { } data Settings = Settings { + sTargetPlatform :: Platform, -- Filled in by SysTools sGhcUsagePath :: FilePath, -- Filled in by SysTools sGhciUsagePath :: FilePath, -- ditto sTopDir :: FilePath, @@ -605,6 +606,9 @@ data Settings = Settings { } +targetPlatform :: DynFlags -> Platform +targetPlatform dflags = sTargetPlatform (settings dflags) + ghcUsagePath :: DynFlags -> FilePath ghcUsagePath dflags = sGhcUsagePath (settings dflags) ghciUsagePath :: DynFlags -> FilePath @@ -818,7 +822,6 @@ defaultDynFlags mySettings = floatLamArgs = Just 0, -- Default: float only if no fvs strictnessBefore = [], - targetPlatform = defaultTargetPlatform, cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 55ab4f9c01..6f22d1af15 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -47,6 +47,7 @@ import Config import Outputable import ErrUtils import Panic +import Platform import Util import DynFlags import StaticFlags @@ -182,6 +183,14 @@ initSysTools mbMinusB _ -> xs Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) + readSetting key = case lookup key mySettings of + Just xs -> + case maybeRead xs of + Just v -> return v + Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs) + Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) + ; targetArch <- readSetting "target arch" + ; targetOS <- readSetting "target os" ; myExtraGccViaCFlags <- getSetting "GCC extra via C opts" -- On Windows, mingw is distributed with GHC, -- so we look in TopDir/../mingw/bin @@ -241,6 +250,10 @@ initSysTools mbMinusB lo_prog = "opt" ; return $ Settings { + sTargetPlatform = Platform { + platformArch = targetArch, + platformOS = targetOS + }, sTmpDir = normalise tmpdir, sGhcUsagePath = ghc_usage_msg_path, sGhciUsagePath = ghci_usage_msg_path, diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs index 362d7822d0..373c7bec33 100644 --- a/compiler/utils/Platform.hs +++ b/compiler/utils/Platform.hs @@ -1,7 +1,5 @@ -- | A description of the platform we're compiling for. --- In the future, this module should be the only one that references --- the evil #defines for each TARGET_ARCH and TARGET_OS -- module Platform ( Platform(..), @@ -10,7 +8,6 @@ module Platform ( ArmISA(..), ArmISAExt(..), - defaultTargetPlatform, target32Bit, osElfTarget ) @@ -19,16 +16,13 @@ where import Panic -#include "HsVersions.h" - - -- | Contains enough information for the native code generator to emit -- code for this platform. data Platform = Platform { platformArch :: Arch , platformOS :: OS } - deriving (Show, Eq) + deriving (Read, Show, Eq) -- | Architectures that the native code generator knows about. @@ -45,7 +39,7 @@ data Arch | ArchARM { armISA :: ArmISA , armISAExt :: [ArmISAExt] } - deriving (Show, Eq) + deriving (Read, Show, Eq) -- | Operating systems that the native code generator knows about. @@ -58,7 +52,7 @@ data OS | OSMinGW32 | OSFreeBSD | OSOpenBSD - deriving (Show, Eq) + deriving (Read, Show, Eq) -- | ARM Instruction Set Architecture and Extensions -- @@ -66,7 +60,7 @@ data ArmISA = ARMv5 | ARMv6 | ARMv7 - deriving (Show, Eq) + deriving (Read, Show, Eq) data ArmISAExt = VFPv2 @@ -74,7 +68,7 @@ data ArmISAExt | VFPv3D16 | NEON | IWMMX2 - deriving (Show, Eq) + deriving (Read, Show, Eq) target32Bit :: Platform -> Bool @@ -98,69 +92,3 @@ osElfTarget OSDarwin = False osElfTarget OSMinGW32 = False osElfTarget OSUnknown = panic "Don't know if OSUnknown is elf" - --- | This is the target platform as far as the #ifdefs are concerned. --- These are set in includes/ghcplatform.h by the autoconf scripts -defaultTargetPlatform :: Platform -defaultTargetPlatform - = Platform defaultTargetArch defaultTargetOS - - --- | Move the evil TARGET_ARCH #ifdefs into Haskell land. -defaultTargetArch :: Arch -#if i386_TARGET_ARCH -defaultTargetArch = ArchX86 -#elif x86_64_TARGET_ARCH -defaultTargetArch = ArchX86_64 -#elif powerpc_TARGET_ARCH -defaultTargetArch = ArchPPC -#elif powerpc64_TARGET_ARCH -defaultTargetArch = ArchPPC_64 -#elif sparc_TARGET_ARCH -defaultTargetArch = ArchSPARC -#elif arm_TARGET_ARCH -defaultTargetArch = ArchARM defaultTargetArmISA defaultTargetArmISAExt -#else -defaultTargetArch = ArchUnknown -#endif - - --- | Move the evil TARGET_OS #ifdefs into Haskell land. -defaultTargetOS :: OS -#if linux_TARGET_OS -defaultTargetOS = OSLinux -#elif darwin_TARGET_OS -defaultTargetOS = OSDarwin -#elif solaris2_TARGET_OS -defaultTargetOS = OSSolaris2 -#elif mingw32_TARGET_OS -defaultTargetOS = OSMinGW32 -#elif freebsd_TARGET_OS -defaultTargetOS = OSFreeBSD -#elif kfreebsdgnu_TARGET_OS -defaultTargetOS = OSFreeBSD -#elif openbsd_TARGET_OS -defaultTargetOS = OSOpenBSD -#else -defaultTargetOS = OSUnknown -#endif - -#if arm_TARGET_ARCH -defaultTargetArmISA :: ArmISA -#if defined(arm_HOST_ARCH_PRE_ARMv6) -defaultTargetArmISA = ARMv5 -#elif defined(arm_HOST_ARCH_PRE_ARMv7) -defaultTargetArmISA = ARMv6 -#else -defaultTargetArmISA = ARMv7 -#endif - -defaultTargetArmISAExt :: [ArmISAExt] -#if defined(arm_TARGET_ARCH) && !defined(arm_HOST_ARCH_PRE_ARMv7) -/* wild guess really, in case of ARMv7 we assume both VFPv3 and NEON presented - however this is not true for SoCs like NVidia Tegra2 and Marvell Dove */ -defaultTargetArmISAExt = [VFPv3, NEON] -#else -defaultTargetArmISAExt = [] -#endif -#endif /* arm_TARGET_ARCH */ diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index f7d3361267..dccb52dbb7 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -69,7 +69,7 @@ module Util ( readRational, -- * read helpers - maybeReadFuzzy, + maybeRead, maybeReadFuzzy, -- * IO-ish utilities createDirectoryHierarchy, @@ -989,6 +989,11 @@ readRational top_s ----------------------------------------------------------------------------- -- read helpers +maybeRead :: Read a => String -> Maybe a +maybeRead str = case reads str of + [(x, "")] -> Just x + _ -> Nothing + maybeReadFuzzy :: Read a => String -> Maybe a maybeReadFuzzy str = case reads str of [(x, s)] |