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 Flag, 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 67 -- * Support for profiling detail levels 68 ProfDetailLevel(..), 69 knownProfDetailLevels, 70 flagToProfDetailLevel, 71 showProfDetailLevel, 72 ) where 73 74import Prelude () 75import Distribution.Compat.Prelude 76import Distribution.Pretty 77 78import Distribution.Compiler 79import Distribution.Version 80import Language.Haskell.Extension 81import Distribution.Simple.Utils 82 83import Control.Monad (join) 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, Flag)], 97 -- ^ Supported language standards. 98 compilerExtensions :: [(Extension, Maybe Flag)], 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 -> NoCallStackIO PackageDBStack 210absolutePackageDBPaths = traverse absolutePackageDBPath 211 212absolutePackageDBPath :: PackageDB -> NoCallStackIO 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 -> [Flag] 283languageToFlags comp = filter (not . null) 284 . catMaybes . map (languageToFlag comp) 285 . maybe [Haskell98] (\x->[x]) 286 287languageToFlag :: Compiler -> Language -> Maybe Flag 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 Flag = String 298 299-- |For the given compiler, return the flags for the supported extensions. 300extensionsToFlags :: Compiler -> [Extension] -> [Flag] 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 Flag 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 Flag) 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-- | Utility function for GHC only features 385ghcSupported :: String -> Compiler -> Bool 386ghcSupported key comp = 387 case compilerFlavor comp of 388 GHC -> checkProp 389 GHCJS -> checkProp 390 _ -> False 391 where checkProp = 392 case Map.lookup key (compilerProperties comp) of 393 Just "YES" -> True 394 _ -> False 395 396-- ------------------------------------------------------------ 397-- * Profiling detail level 398-- ------------------------------------------------------------ 399 400-- | Some compilers (notably GHC) support profiling and can instrument 401-- programs so the system can account costs to different functions. There are 402-- different levels of detail that can be used for this accounting. 403-- For compilers that do not support this notion or the particular detail 404-- levels, this is either ignored or just capped to some similar level 405-- they do support. 406-- 407data ProfDetailLevel = ProfDetailNone 408 | ProfDetailDefault 409 | ProfDetailExportedFunctions 410 | ProfDetailToplevelFunctions 411 | ProfDetailAllFunctions 412 | ProfDetailOther String 413 deriving (Eq, Generic, Read, Show, Typeable) 414 415instance Binary ProfDetailLevel 416instance Structured ProfDetailLevel 417 418flagToProfDetailLevel :: String -> ProfDetailLevel 419flagToProfDetailLevel "" = ProfDetailDefault 420flagToProfDetailLevel s = 421 case lookup (lowercase s) 422 [ (name, value) 423 | (primary, aliases, value) <- knownProfDetailLevels 424 , name <- primary : aliases ] 425 of Just value -> value 426 Nothing -> ProfDetailOther s 427 428knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] 429knownProfDetailLevels = 430 [ ("default", [], ProfDetailDefault) 431 , ("none", [], ProfDetailNone) 432 , ("exported-functions", ["exported"], ProfDetailExportedFunctions) 433 , ("toplevel-functions", ["toplevel", "top"], ProfDetailToplevelFunctions) 434 , ("all-functions", ["all"], ProfDetailAllFunctions) 435 ] 436 437showProfDetailLevel :: ProfDetailLevel -> String 438showProfDetailLevel dl = case dl of 439 ProfDetailNone -> "none" 440 ProfDetailDefault -> "default" 441 ProfDetailExportedFunctions -> "exported-functions" 442 ProfDetailToplevelFunctions -> "toplevel-functions" 443 ProfDetailAllFunctions -> "all-functions" 444 ProfDetailOther other -> other 445