1{-# LANGUAGE DeriveGeneric #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Simple.Compiler 7-- Copyright : Isaac Jones 2003-2004 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This should be a much more sophisticated abstraction than it is. Currently 14-- it's just a bit of data about the compiler, like its flavour and name and 15-- version. The reason it's just data is because currently it has to be in 16-- 'Read' and 'Show' so it can be saved along with the 'LocalBuildInfo'. The 17-- only interesting bit of info it contains is a mapping between language 18-- extensions and compiler command line flags. This module also defines a 19-- 'PackageDB' type which is used to refer to package databases. Most compilers 20-- only know about a single global package collection but GHC has a global and 21-- per-user one and it lets you create arbitrary other package databases. We do 22-- not yet fully support this latter feature. 23 24module Distribution.Simple.Compiler ( 25 -- * Haskell implementations 26 module Distribution.Compiler, 27 Compiler(..), 28 showCompilerId, showCompilerIdWithAbi, 29 compilerFlavor, compilerVersion, 30 compilerCompatFlavor, 31 compilerCompatVersion, 32 compilerInfo, 33 34 -- * Support for package databases 35 PackageDB(..), 36 PackageDBStack, 37 registrationPackageDB, 38 absolutePackageDBPaths, 39 absolutePackageDBPath, 40 41 -- * Support for optimisation levels 42 OptimisationLevel(..), 43 flagToOptimisationLevel, 44 45 -- * Support for debug info levels 46 DebugInfoLevel(..), 47 flagToDebugInfoLevel, 48 49 -- * Support for language extensions 50 CompilerFlag, 51 languageToFlags, 52 unsupportedLanguages, 53 extensionsToFlags, 54 unsupportedExtensions, 55 parmakeSupported, 56 reexportedModulesSupported, 57 renamingPackageFlagsSupported, 58 unifiedIPIDRequired, 59 packageKeySupported, 60 unitIdSupported, 61 coverageSupported, 62 profilingSupported, 63 backpackSupported, 64 arResponseFilesSupported, 65 libraryDynDirSupported, 66 libraryVisibilitySupported, 67 68 -- * Support for profiling detail levels 69 ProfDetailLevel(..), 70 knownProfDetailLevels, 71 flagToProfDetailLevel, 72 showProfDetailLevel, 73 ) where 74 75import Prelude () 76import Distribution.Compat.Prelude 77import Distribution.Pretty 78 79import Distribution.Compiler 80import Distribution.Version 81import Language.Haskell.Extension 82import Distribution.Simple.Utils 83 84import qualified Data.Map as Map (lookup) 85import System.Directory (canonicalizePath) 86 87data Compiler = Compiler { 88 compilerId :: CompilerId, 89 -- ^ Compiler flavour and version. 90 compilerAbiTag :: AbiTag, 91 -- ^ Tag for distinguishing incompatible ABI's on the same 92 -- architecture/os. 93 compilerCompat :: [CompilerId], 94 -- ^ Other implementations that this compiler claims to be 95 -- compatible with. 96 compilerLanguages :: [(Language, CompilerFlag)], 97 -- ^ Supported language standards. 98 compilerExtensions :: [(Extension, Maybe CompilerFlag)], 99 -- ^ Supported extensions. 100 compilerProperties :: Map String String 101 -- ^ A key-value map for properties not covered by the above fields. 102 } 103 deriving (Eq, Generic, Typeable, Show, Read) 104 105instance Binary Compiler 106instance Structured Compiler 107 108showCompilerId :: Compiler -> String 109showCompilerId = prettyShow . compilerId 110 111showCompilerIdWithAbi :: Compiler -> String 112showCompilerIdWithAbi comp = 113 prettyShow (compilerId comp) ++ 114 case compilerAbiTag comp of 115 NoAbiTag -> [] 116 AbiTag xs -> '-':xs 117 118compilerFlavor :: Compiler -> CompilerFlavor 119compilerFlavor = (\(CompilerId f _) -> f) . compilerId 120 121compilerVersion :: Compiler -> Version 122compilerVersion = (\(CompilerId _ v) -> v) . compilerId 123 124 125-- | Is this compiler compatible with the compiler flavour we're interested in? 126-- 127-- For example this checks if the compiler is actually GHC or is another 128-- compiler that claims to be compatible with some version of GHC, e.g. GHCJS. 129-- 130-- > if compilerCompatFlavor GHC compiler then ... else ... 131-- 132compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool 133compilerCompatFlavor flavor comp = 134 flavor == compilerFlavor comp 135 || flavor `elem` [ flavor' | CompilerId flavor' _ <- compilerCompat comp ] 136 137 138-- | Is this compiler compatible with the compiler flavour we're interested in, 139-- and if so what version does it claim to be compatible with. 140-- 141-- For example this checks if the compiler is actually GHC-7.x or is another 142-- compiler that claims to be compatible with some GHC-7.x version. 143-- 144-- > case compilerCompatVersion GHC compiler of 145-- > Just (Version (7:_)) -> ... 146-- > _ -> ... 147-- 148compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version 149compilerCompatVersion flavor comp 150 | compilerFlavor comp == flavor = Just (compilerVersion comp) 151 | otherwise = 152 listToMaybe [ v | CompilerId fl v <- compilerCompat comp, fl == flavor ] 153 154compilerInfo :: Compiler -> CompilerInfo 155compilerInfo c = CompilerInfo (compilerId c) 156 (compilerAbiTag c) 157 (Just . compilerCompat $ c) 158 (Just . map fst . compilerLanguages $ c) 159 (Just . map fst . compilerExtensions $ c) 160 161-- ------------------------------------------------------------ 162-- * Package databases 163-- ------------------------------------------------------------ 164 165-- |Some compilers have a notion of a database of available packages. 166-- For some there is just one global db of packages, other compilers 167-- support a per-user or an arbitrary db specified at some location in 168-- the file system. This can be used to build isloated environments of 169-- packages, for example to build a collection of related packages 170-- without installing them globally. 171-- 172data PackageDB = GlobalPackageDB 173 | UserPackageDB 174 | SpecificPackageDB FilePath 175 deriving (Eq, Generic, Ord, Show, Read, Typeable) 176 177instance Binary PackageDB 178instance Structured PackageDB 179 180-- | We typically get packages from several databases, and stack them 181-- together. This type lets us be explicit about that stacking. For example 182-- typical stacks include: 183-- 184-- > [GlobalPackageDB] 185-- > [GlobalPackageDB, UserPackageDB] 186-- > [GlobalPackageDB, SpecificPackageDB "package.conf.inplace"] 187-- 188-- Note that the 'GlobalPackageDB' is invariably at the bottom since it 189-- contains the rts, base and other special compiler-specific packages. 190-- 191-- We are not restricted to using just the above combinations. In particular 192-- we can use several custom package dbs and the user package db together. 193-- 194-- When it comes to writing, the top most (last) package is used. 195-- 196type PackageDBStack = [PackageDB] 197 198-- | Return the package that we should register into. This is the package db at 199-- the top of the stack. 200-- 201registrationPackageDB :: PackageDBStack -> PackageDB 202registrationPackageDB dbs = case safeLast dbs of 203 Nothing -> error "internal error: empty package db set" 204 Just p -> p 205 206-- | Make package paths absolute 207 208 209absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack 210absolutePackageDBPaths = traverse absolutePackageDBPath 211 212absolutePackageDBPath :: PackageDB -> IO PackageDB 213absolutePackageDBPath GlobalPackageDB = return GlobalPackageDB 214absolutePackageDBPath UserPackageDB = return UserPackageDB 215absolutePackageDBPath (SpecificPackageDB db) = 216 SpecificPackageDB `liftM` canonicalizePath db 217 218-- ------------------------------------------------------------ 219-- * Optimisation levels 220-- ------------------------------------------------------------ 221 222-- | Some compilers support optimising. Some have different levels. 223-- For compilers that do not the level is just capped to the level 224-- they do support. 225-- 226data OptimisationLevel = NoOptimisation 227 | NormalOptimisation 228 | MaximumOptimisation 229 deriving (Bounded, Enum, Eq, Generic, Read, Show, Typeable) 230 231instance Binary OptimisationLevel 232instance Structured OptimisationLevel 233 234flagToOptimisationLevel :: Maybe String -> OptimisationLevel 235flagToOptimisationLevel Nothing = NormalOptimisation 236flagToOptimisationLevel (Just s) = case reads s of 237 [(i, "")] 238 | i >= fromEnum (minBound :: OptimisationLevel) 239 && i <= fromEnum (maxBound :: OptimisationLevel) 240 -> toEnum i 241 | otherwise -> error $ "Bad optimisation level: " ++ show i 242 ++ ". Valid values are 0..2" 243 _ -> error $ "Can't parse optimisation level " ++ s 244 245-- ------------------------------------------------------------ 246-- * Debug info levels 247-- ------------------------------------------------------------ 248 249-- | Some compilers support emitting debug info. Some have different 250-- levels. For compilers that do not the level is just capped to the 251-- level they do support. 252-- 253data DebugInfoLevel = NoDebugInfo 254 | MinimalDebugInfo 255 | NormalDebugInfo 256 | MaximalDebugInfo 257 deriving (Bounded, Enum, Eq, Generic, Read, Show, Typeable) 258 259instance Binary DebugInfoLevel 260instance Structured DebugInfoLevel 261 262flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel 263flagToDebugInfoLevel Nothing = NormalDebugInfo 264flagToDebugInfoLevel (Just s) = case reads s of 265 [(i, "")] 266 | i >= fromEnum (minBound :: DebugInfoLevel) 267 && i <= fromEnum (maxBound :: DebugInfoLevel) 268 -> toEnum i 269 | otherwise -> error $ "Bad debug info level: " ++ show i 270 ++ ". Valid values are 0..3" 271 _ -> error $ "Can't parse debug info level " ++ s 272 273-- ------------------------------------------------------------ 274-- * Languages and Extensions 275-- ------------------------------------------------------------ 276 277unsupportedLanguages :: Compiler -> [Language] -> [Language] 278unsupportedLanguages comp langs = 279 [ lang | lang <- langs 280 , isNothing (languageToFlag comp lang) ] 281 282languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag] 283languageToFlags comp = filter (not . null) 284 . catMaybes . map (languageToFlag comp) 285 . maybe [Haskell98] (\x->[x]) 286 287languageToFlag :: Compiler -> Language -> Maybe CompilerFlag 288languageToFlag comp ext = lookup ext (compilerLanguages comp) 289 290 291-- |For the given compiler, return the extensions it does not support. 292unsupportedExtensions :: Compiler -> [Extension] -> [Extension] 293unsupportedExtensions comp exts = 294 [ ext | ext <- exts 295 , isNothing (extensionToFlag' comp ext) ] 296 297type CompilerFlag = String 298 299-- |For the given compiler, return the flags for the supported extensions. 300extensionsToFlags :: Compiler -> [Extension] -> [CompilerFlag] 301extensionsToFlags comp = nub . filter (not . null) 302 . catMaybes . map (extensionToFlag comp) 303 304-- | Looks up the flag for a given extension, for a given compiler. 305-- Ignores the subtlety of extensions which lack associated flags. 306extensionToFlag :: Compiler -> Extension -> Maybe CompilerFlag 307extensionToFlag comp ext = join (extensionToFlag' comp ext) 308 309-- | Looks up the flag for a given extension, for a given compiler. 310-- However, the extension may be valid for the compiler but not have a flag. 311-- For example, NondecreasingIndentation is enabled by default on GHC 7.0.4, 312-- hence it is considered a supported extension but not an accepted flag. 313-- 314-- The outer layer of Maybe indicates whether the extensions is supported, while 315-- the inner layer indicates whether it has a flag. 316-- When building strings, it is often more convenient to use 'extensionToFlag', 317-- which ignores the difference. 318extensionToFlag' :: Compiler -> Extension -> Maybe (Maybe CompilerFlag) 319extensionToFlag' comp ext = lookup ext (compilerExtensions comp) 320 321-- | Does this compiler support parallel --make mode? 322parmakeSupported :: Compiler -> Bool 323parmakeSupported = ghcSupported "Support parallel --make" 324 325-- | Does this compiler support reexported-modules? 326reexportedModulesSupported :: Compiler -> Bool 327reexportedModulesSupported = ghcSupported "Support reexported-modules" 328 329-- | Does this compiler support thinning/renaming on package flags? 330renamingPackageFlagsSupported :: Compiler -> Bool 331renamingPackageFlagsSupported = ghcSupported 332 "Support thinning and renaming package flags" 333 334-- | Does this compiler have unified IPIDs (so no package keys) 335unifiedIPIDRequired :: Compiler -> Bool 336unifiedIPIDRequired = ghcSupported "Requires unified installed package IDs" 337 338-- | Does this compiler support package keys? 339packageKeySupported :: Compiler -> Bool 340packageKeySupported = ghcSupported "Uses package keys" 341 342-- | Does this compiler support unit IDs? 343unitIdSupported :: Compiler -> Bool 344unitIdSupported = ghcSupported "Uses unit IDs" 345 346-- | Does this compiler support Backpack? 347backpackSupported :: Compiler -> Bool 348backpackSupported = ghcSupported "Support Backpack" 349 350-- | Does this compiler support a package database entry with: 351-- "dynamic-library-dirs"? 352libraryDynDirSupported :: Compiler -> Bool 353libraryDynDirSupported comp = case compilerFlavor comp of 354 GHC -> 355 -- Not just v >= mkVersion [8,0,1,20161022], as there 356 -- are many GHC 8.1 nightlies which don't support this. 357 ((v >= mkVersion [8,0,1,20161022] && v < mkVersion [8,1]) || 358 v >= mkVersion [8,1,20161021]) 359 _ -> False 360 where 361 v = compilerVersion comp 362 363-- | Does this compiler's "ar" command supports response file 364-- arguments (i.e. @file-style arguments). 365arResponseFilesSupported :: Compiler -> Bool 366arResponseFilesSupported = ghcSupported "ar supports at file" 367 368-- | Does this compiler support Haskell program coverage? 369coverageSupported :: Compiler -> Bool 370coverageSupported comp = 371 case compilerFlavor comp of 372 GHC -> True 373 GHCJS -> True 374 _ -> False 375 376-- | Does this compiler support profiling? 377profilingSupported :: Compiler -> Bool 378profilingSupported comp = 379 case compilerFlavor comp of 380 GHC -> True 381 GHCJS -> True 382 _ -> False 383 384-- | Does this compiler support a package database entry with: 385-- "visibility"? 386libraryVisibilitySupported :: Compiler -> Bool 387libraryVisibilitySupported comp = case compilerFlavor comp of 388 GHC -> v >= mkVersion [8,8] 389 _ -> False 390 where 391 v = compilerVersion comp 392 393-- | Utility function for GHC only features 394ghcSupported :: String -> Compiler -> Bool 395ghcSupported key comp = 396 case compilerFlavor comp of 397 GHC -> checkProp 398 GHCJS -> checkProp 399 _ -> False 400 where checkProp = 401 case Map.lookup key (compilerProperties comp) of 402 Just "YES" -> True 403 _ -> False 404 405-- ------------------------------------------------------------ 406-- * Profiling detail level 407-- ------------------------------------------------------------ 408 409-- | Some compilers (notably GHC) support profiling and can instrument 410-- programs so the system can account costs to different functions. There are 411-- different levels of detail that can be used for this accounting. 412-- For compilers that do not support this notion or the particular detail 413-- levels, this is either ignored or just capped to some similar level 414-- they do support. 415-- 416data ProfDetailLevel = ProfDetailNone 417 | ProfDetailDefault 418 | ProfDetailExportedFunctions 419 | ProfDetailToplevelFunctions 420 | ProfDetailAllFunctions 421 | ProfDetailOther String 422 deriving (Eq, Generic, Read, Show, Typeable) 423 424instance Binary ProfDetailLevel 425instance Structured ProfDetailLevel 426 427flagToProfDetailLevel :: String -> ProfDetailLevel 428flagToProfDetailLevel "" = ProfDetailDefault 429flagToProfDetailLevel s = 430 case lookup (lowercase s) 431 [ (name, value) 432 | (primary, aliases, value) <- knownProfDetailLevels 433 , name <- primary : aliases ] 434 of Just value -> value 435 Nothing -> ProfDetailOther s 436 437knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] 438knownProfDetailLevels = 439 [ ("default", [], ProfDetailDefault) 440 , ("none", [], ProfDetailNone) 441 , ("exported-functions", ["exported"], ProfDetailExportedFunctions) 442 , ("toplevel-functions", ["toplevel", "top"], ProfDetailToplevelFunctions) 443 , ("all-functions", ["all"], ProfDetailAllFunctions) 444 ] 445 446showProfDetailLevel :: ProfDetailLevel -> String 447showProfDetailLevel dl = case dl of 448 ProfDetailNone -> "none" 449 ProfDetailDefault -> "default" 450 ProfDetailExportedFunctions -> "exported-functions" 451 ProfDetailToplevelFunctions -> "toplevel-functions" 452 ProfDetailAllFunctions -> "all-functions" 453 ProfDetailOther other -> other 454