Commit d6a0d7af authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Replace quote by show

parent 2c77b710
......@@ -18,8 +18,8 @@ module Base (
configPath, configFile, sourcePath, programInplacePath,
-- * Miscellaneous utilities
minusOrd, intersectOrd, lookupAll, replaceEq, quote, replaceSeparators,
unifyPath, (-/-), matchVersionedFilePath, putColoured
minusOrd, intersectOrd, lookupAll, replaceEq, replaceSeparators, unifyPath,
(-/-), matchVersionedFilePath, putColoured
) where
import Control.Applicative
......@@ -40,10 +40,11 @@ import System.Info
-- TODO: reexport Stage, etc.?
-- Build system files and paths
-- | Hadrian lives in 'hadrianPath' directory of the GHC tree.
hadrianPath :: FilePath
hadrianPath = "hadrian"
-- TODO: Move this to build directory?
configPath :: FilePath
configPath = hadrianPath -/- "cfg"
......@@ -70,10 +71,6 @@ replaceSeparators = replaceWhen isPathSeparator
replaceWhen :: (a -> Bool) -> a -> [a] -> [a]
replaceWhen p to = map (\from -> if p from then to else from)
-- | Add quotes around a String.
quote :: String -> String
quote s = "\"" ++ s ++ "\""
-- | Normalise a path and convert all path separators to @/@, even on Windows.
unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx
......
......@@ -52,45 +52,45 @@ generateConfigHs = do
, "cTargetPlatformString = TargetPlatform_NAME"
, ""
, "cProjectName :: String"
, "cProjectName = " ++ quote cProjectName
, "cProjectName = " ++ show cProjectName
, "cProjectGitCommitId :: String"
, "cProjectGitCommitId = " ++ quote cProjectGitCommitId
, "cProjectGitCommitId = " ++ show cProjectGitCommitId
, "cProjectVersion :: String"
, "cProjectVersion = " ++ quote cProjectVersion
, "cProjectVersion = " ++ show cProjectVersion
, "cProjectVersionInt :: String"
, "cProjectVersionInt = " ++ quote cProjectVersionInt
, "cProjectVersionInt = " ++ show cProjectVersionInt
, "cProjectPatchLevel :: String"
, "cProjectPatchLevel = " ++ quote cProjectPatchLevel
, "cProjectPatchLevel = " ++ show cProjectPatchLevel
, "cProjectPatchLevel1 :: String"
, "cProjectPatchLevel1 = " ++ quote cProjectPatchLevel1
, "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
, "cProjectPatchLevel2 :: String"
, "cProjectPatchLevel2 = " ++ quote cProjectPatchLevel2
, "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
, "cBooterVersion :: String"
, "cBooterVersion = " ++ quote cBooterVersion
, "cBooterVersion = " ++ show cBooterVersion
, "cStage :: String"
, "cStage = show (STAGE :: Int)"
, "cIntegerLibrary :: String"
, "cIntegerLibrary = " ++ quote (pkgNameString integerLibrary)
, "cIntegerLibrary = " ++ show (pkgNameString integerLibrary)
, "cIntegerLibraryType :: IntegerLibrary"
, "cIntegerLibraryType = " ++ cIntegerLibraryType
, "cSupportsSplitObjs :: String"
, "cSupportsSplitObjs = " ++ quote cSupportsSplitObjs
, "cSupportsSplitObjs = " ++ show cSupportsSplitObjs
, "cGhcWithInterpreter :: String"
, "cGhcWithInterpreter = " ++ quote cGhcWithInterpreter
, "cGhcWithInterpreter = " ++ show cGhcWithInterpreter
, "cGhcWithNativeCodeGen :: String"
, "cGhcWithNativeCodeGen = " ++ quote cGhcWithNativeCodeGen
, "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
, "cGhcWithSMP :: String"
, "cGhcWithSMP = " ++ quote cGhcWithSMP
, "cGhcWithSMP = " ++ show cGhcWithSMP
, "cGhcRTSWays :: String"
, "cGhcRTSWays = " ++ quote cGhcRTSWays
, "cGhcRTSWays = " ++ show cGhcRTSWays
, "cGhcEnableTablesNextToCode :: String"
, "cGhcEnableTablesNextToCode = " ++ quote cGhcEnableTablesNextToCode
, "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode
, "cLeadingUnderscore :: String"
, "cLeadingUnderscore = " ++ quote cLeadingUnderscore
, "cLeadingUnderscore = " ++ show cLeadingUnderscore
, "cGHC_UNLIT_PGM :: String"
, "cGHC_UNLIT_PGM = " ++ quote cGHC_UNLIT_PGM
, "cGHC_UNLIT_PGM = " ++ show cGHC_UNLIT_PGM
, "cGHC_SPLIT_PGM :: String"
, "cGHC_SPLIT_PGM = " ++ quote "ghc-split"
, "cGHC_SPLIT_PGM = " ++ show "ghc-split"
, "cLibFFI :: Bool"
, "cLibFFI = " ++ show cLibFFI
, "cGhcThreaded :: Bool"
......
......@@ -26,9 +26,9 @@ generateGhcBootPlatformH = do
[ "#ifndef __PLATFORM_H__"
, "#define __PLATFORM_H__"
, ""
, "#define BuildPlatform_NAME " ++ quote buildPlatform
, "#define HostPlatform_NAME " ++ quote hostPlatform
, "#define TargetPlatform_NAME " ++ quote targetPlatform
, "#define BuildPlatform_NAME " ++ show buildPlatform
, "#define HostPlatform_NAME " ++ show hostPlatform
, "#define TargetPlatform_NAME " ++ show targetPlatform
, ""
, "#define " ++ cppify buildPlatform ++ "_BUILD 1"
, "#define " ++ cppify hostPlatform ++ "_HOST 1"
......@@ -37,22 +37,22 @@ generateGhcBootPlatformH = do
, "#define " ++ buildArch ++ "_BUILD_ARCH 1"
, "#define " ++ hostArch ++ "_HOST_ARCH 1"
, "#define " ++ targetArch ++ "_TARGET_ARCH 1"
, "#define BUILD_ARCH " ++ quote buildArch
, "#define HOST_ARCH " ++ quote hostArch
, "#define TARGET_ARCH " ++ quote targetArch
, "#define BUILD_ARCH " ++ show buildArch
, "#define HOST_ARCH " ++ show hostArch
, "#define TARGET_ARCH " ++ show targetArch
, ""
, "#define " ++ buildOs ++ "_BUILD_OS 1"
, "#define " ++ hostOs ++ "_HOST_OS 1"
, "#define " ++ targetOs ++ "_TARGET_OS 1"
, "#define BUILD_OS " ++ quote buildOs
, "#define HOST_OS " ++ quote hostOs
, "#define TARGET_OS " ++ quote targetOs
, "#define BUILD_OS " ++ show buildOs
, "#define HOST_OS " ++ show hostOs
, "#define TARGET_OS " ++ show targetOs
, ""
, "#define " ++ buildVendor ++ "_BUILD_VENDOR 1"
, "#define " ++ hostVendor ++ "_HOST_VENDOR 1"
, "#define " ++ targetVendor ++ "_TARGET_VENDOR 1"
, "#define BUILD_VENDOR " ++ quote buildVendor
, "#define HOST_VENDOR " ++ quote hostVendor
, "#define TARGET_VENDOR " ++ quote targetVendor
, "#define BUILD_VENDOR " ++ show buildVendor
, "#define HOST_VENDOR " ++ show hostVendor
, "#define TARGET_VENDOR " ++ show targetVendor
, ""
, "#endif /* __PLATFORM_H__ */" ]
......@@ -30,26 +30,26 @@ generateGhcPlatformH = do
, ""
, "#define " ++ hostArch ++ "_BUILD_ARCH 1"
, "#define " ++ targetArch ++ "_HOST_ARCH 1"
, "#define BUILD_ARCH " ++ quote hostArch
, "#define HOST_ARCH " ++ quote targetArch
, "#define BUILD_ARCH " ++ show hostArch
, "#define HOST_ARCH " ++ show targetArch
, ""
, "#define " ++ hostOs ++ "_BUILD_OS 1"
, "#define " ++ targetOs ++ "_HOST_OS 1"
, "#define BUILD_OS " ++ quote hostOs
, "#define HOST_OS " ++ quote targetOs
, "#define BUILD_OS " ++ show hostOs
, "#define HOST_OS " ++ show targetOs
, ""
, "#define " ++ hostVendor ++ "_BUILD_VENDOR 1"
, "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
, "#define BUILD_VENDOR " ++ quote hostVendor
, "#define HOST_VENDOR " ++ quote targetVendor
, "#define BUILD_VENDOR " ++ show hostVendor
, "#define HOST_VENDOR " ++ show targetVendor
, ""
, "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
, "#define TargetPlatform_TYPE " ++ cppify targetPlatform
, "#define " ++ cppify targetPlatform ++ "_TARGET 1"
, "#define " ++ targetArch ++ "_TARGET_ARCH 1"
, "#define TARGET_ARCH " ++ quote targetArch
, "#define TARGET_ARCH " ++ show targetArch
, "#define " ++ targetOs ++ "_TARGET_OS 1"
, "#define TARGET_OS " ++ quote targetOs
, "#define TARGET_OS " ++ show targetOs
, "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
++
[ "#define UnregisterisedCompiler 1" | ghcUnreg ]
......
......@@ -17,8 +17,8 @@ generateGhcSplit = do
contents <- lift $ readFileLines ghcSplitSource
return . unlines $
[ "#!" ++ perlPath
, "$TARGETPLATFORM = " ++ quote targetPlatform ++ ";"
, "$TARGETPLATFORM = " ++ show targetPlatform ++ ";"
-- I don't see where the ghc-split tool uses TNC, but
-- it's in the build-perl macro.
, "$TABLES_NEXT_TO_CODE = " ++ quote ghcEnableTNC ++ ";"
, "$TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
] ++ contents
......@@ -14,6 +14,6 @@ generateVersionHs = do
return $ unlines
[ "module Version where"
, "version, targetOS, targetARCH :: String"
, "version = " ++ quote projectVersion
, "targetOS = " ++ quote targetOs
, "targetARCH = " ++ quote targetArch ]
, "version = " ++ show projectVersion
, "targetOS = " ++ show targetOs
, "targetARCH = " ++ show targetArch ]
......@@ -66,24 +66,24 @@ rtsPackageArgs = package rts ? do
, way == threaded ? arg "-DTHREADED_RTS"
, (input "//RtsMessages.c" ||^ input "//Trace.c") ?
arg ("-DProjectVersion=" ++ quote projectVersion)
arg ("-DProjectVersion=" ++ show projectVersion)
, input "//RtsUtils.c" ? append
[ "-DProjectVersion=" ++ quote projectVersion
, "-DHostPlatform=" ++ quote hostPlatform
, "-DHostArch=" ++ quote hostArch
, "-DHostOS=" ++ quote hostOs
, "-DHostVendor=" ++ quote hostVendor
, "-DBuildPlatform=" ++ quote buildPlatform
, "-DBuildArch=" ++ quote buildArch
, "-DBuildOS=" ++ quote buildOs
, "-DBuildVendor=" ++ quote buildVendor
, "-DTargetPlatform=" ++ quote targetPlatform
, "-DTargetArch=" ++ quote targetArch
, "-DTargetOS=" ++ quote targetOs
, "-DTargetVendor=" ++ quote targetVendor
, "-DGhcUnregisterised=" ++ quote ghcUnreg
, "-DGhcEnableTablesNextToCode=" ++ quote ghcEnableTNC ]
[ "-DProjectVersion=" ++ show projectVersion
, "-DHostPlatform=" ++ show hostPlatform
, "-DHostArch=" ++ show hostArch
, "-DHostOS=" ++ show hostOs
, "-DHostVendor=" ++ show hostVendor
, "-DBuildPlatform=" ++ show buildPlatform
, "-DBuildArch=" ++ show buildArch
, "-DBuildOS=" ++ show buildOs
, "-DBuildVendor=" ++ show buildVendor
, "-DTargetPlatform=" ++ show targetPlatform
, "-DTargetArch=" ++ show targetArch
, "-DTargetOS=" ++ show targetOs
, "-DTargetVendor=" ++ show targetVendor
, "-DGhcUnregisterised=" ++ show ghcUnreg
, "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]
, input "//Evac.c" ? arg "-funroll-loops"
, input "//Evac_thr.c" ? arg "-funroll-loops"
......@@ -98,10 +98,10 @@ rtsPackageArgs = package rts ? do
, arg rtsConf ]
, builder HsCpp ? append
[ "-DTOP=" ++ quote top
, "-DFFI_INCLUDE_DIR=" ++ quote ffiIncludeDir
, "-DFFI_LIB_DIR=" ++ quote ffiLibraryDir
, "-DFFI_LIB=" ++ quote libffiName ] ]
[ "-DTOP=" ++ show top
, "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
, "-DFFI_LIB_DIR=" ++ show ffiLibraryDir
, "-DFFI_LIB=" ++ show libffiName ] ]
-- # If we're compiling on windows, enforce that we only support XP+
......
......@@ -9,4 +9,4 @@ runGhcPackageArgs = package runGhc ? do
version <- getSetting ProjectVersion
mconcat [ builder Ghc ?
input "//Main.hs" ?
append ["-cpp", "-DVERSION=\"" ++ version ++ "\""] ]
append ["-cpp", "-DVERSION=" ++ show version] ]
......@@ -102,4 +102,4 @@ putBuild = putColoured Vivid White
-- | Customise build success messages (e.g. a package is built successfully).
putSuccess :: String -> Action ()
putSuccess = putColoured Vivid Green
putSuccess = withVerbosity Loud . putColoured Vivid Green
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment