Replace quote by show
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Tue, 17 May 2016 23:11:12 +0000 (00:11 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Tue, 17 May 2016 23:29:41 +0000 (00:29 +0100)
src/Base.hs
src/Rules/Generators/ConfigHs.hs
src/Rules/Generators/GhcBootPlatformH.hs
src/Rules/Generators/GhcPlatformH.hs
src/Rules/Generators/GhcSplit.hs
src/Rules/Generators/VersionHs.hs
src/Settings/Packages/Rts.hs
src/Settings/Packages/RunGhc.hs
src/Settings/User.hs

index 8f02865..97a4516 100644 (file)
@@ -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
index d992336..12eb909 100644 (file)
@@ -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"
index 4087cd9..b9ff4d6 100644 (file)
@@ -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__ */" ]
index aba6c36..fac01af 100644 (file)
@@ -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 ]
index 1ae239a..788acbf 100644 (file)
@@ -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
index 84a544f..dbfcd5a 100644 (file)
@@ -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 ]
index 38d4b9c..476cdb4 100644 (file)
@@ -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+
index b10ed01..3e86f92 100644 (file)
@@ -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] ]
index 16c7c25..60aeb89 100644 (file)
@@ -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