Copyright | Isaac Jones 2003-2004 |
---|---|
License | BSD3 |
Maintainer | cabal-devel@haskell.org |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
This should be a much more sophisticated abstraction than it is. Currently
it's just a bit of data about the compiler, like it's flavour and name and
version. The reason it's just data is because currently it has to be in
Read
and Show
so it can be saved along with the LocalBuildInfo
. The
only interesting bit of info it contains is a mapping between language
extensions and compiler command line flags. This module also defines a
PackageDB
type which is used to refer to package databases. Most compilers
only know about a single global package collection but GHC has a global and
per-user one and it lets you create arbitrary other package databases. We do
not yet fully support this latter feature.
- module Distribution.Compiler
- data Compiler = Compiler {
- compilerId :: CompilerId
- compilerAbiTag :: AbiTag
- compilerCompat :: [CompilerId]
- compilerLanguages :: [(Language, Flag)]
- compilerExtensions :: [(Extension, Flag)]
- compilerProperties :: Map String String
- showCompilerId :: Compiler -> String
- showCompilerIdWithAbi :: Compiler -> String
- compilerFlavor :: Compiler -> CompilerFlavor
- compilerVersion :: Compiler -> Version
- compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
- compilerInfo :: Compiler -> CompilerInfo
- data PackageDB
- type PackageDBStack = [PackageDB]
- registrationPackageDB :: PackageDBStack -> PackageDB
- absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack
- absolutePackageDBPath :: PackageDB -> IO PackageDB
- data OptimisationLevel
- flagToOptimisationLevel :: Maybe String -> OptimisationLevel
- data DebugInfoLevel
- flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
- type Flag = String
- languageToFlags :: Compiler -> Maybe Language -> [Flag]
- unsupportedLanguages :: Compiler -> [Language] -> [Language]
- extensionsToFlags :: Compiler -> [Extension] -> [Flag]
- unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
- parmakeSupported :: Compiler -> Bool
- reexportedModulesSupported :: Compiler -> Bool
- renamingPackageFlagsSupported :: Compiler -> Bool
- unifiedIPIDRequired :: Compiler -> Bool
- packageKeySupported :: Compiler -> Bool
- unitIdSupported :: Compiler -> Bool
- data ProfDetailLevel
- knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
- flagToProfDetailLevel :: String -> ProfDetailLevel
- showProfDetailLevel :: ProfDetailLevel -> String
Haskell implementations
module Distribution.Compiler
Compiler | |
|
Eq Compiler | |
Read Compiler | |
Show Compiler | |
Generic Compiler | |
Binary Compiler | |
type Rep Compiler = D1 (MetaData "Compiler" "Distribution.Simple.Compiler" "Cabal-1.23.1.0" False) (C1 (MetaCons "Compiler" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "compilerId") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 CompilerId)) ((:*:) (S1 (MetaSel (Just Symbol "compilerAbiTag") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AbiTag)) (S1 (MetaSel (Just Symbol "compilerCompat") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [CompilerId])))) ((:*:) (S1 (MetaSel (Just Symbol "compilerLanguages") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(Language, Flag)])) ((:*:) (S1 (MetaSel (Just Symbol "compilerExtensions") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(Extension, Flag)])) (S1 (MetaSel (Just Symbol "compilerProperties") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map String String))))))) |
showCompilerId :: Compiler -> String Source
compilerVersion :: Compiler -> Version Source
Support for package databases
Some compilers have a notion of a database of available packages. For some there is just one global db of packages, other compilers support a per-user or an arbitrary db specified at some location in the file system. This can be used to build isloated environments of packages, for example to build a collection of related packages without installing them globally.
Eq PackageDB | |
Ord PackageDB | |
Read PackageDB | |
Show PackageDB | |
Generic PackageDB | |
Binary PackageDB | |
type Rep PackageDB = D1 (MetaData "PackageDB" "Distribution.Simple.Compiler" "Cabal-1.23.1.0" False) ((:+:) (C1 (MetaCons "GlobalPackageDB" PrefixI False) U1) ((:+:) (C1 (MetaCons "UserPackageDB" PrefixI False) U1) (C1 (MetaCons "SpecificPackageDB" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FilePath))))) |
type PackageDBStack = [PackageDB] Source
We typically get packages from several databases, and stack them together. This type lets us be explicit about that stacking. For example typical stacks include:
[GlobalPackageDB] [GlobalPackageDB, UserPackageDB] [GlobalPackageDB, SpecificPackageDB "package.conf.inplace"]
Note that the GlobalPackageDB
is invariably at the bottom since it
contains the rts, base and other special compiler-specific packages.
We are not restricted to using just the above combinations. In particular we can use several custom package dbs and the user package db together.
When it comes to writing, the top most (last) package is used.
registrationPackageDB :: PackageDBStack -> PackageDB Source
Return the package that we should register into. This is the package db at the top of the stack.
absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack Source
Make package paths absolute
Support for optimisation levels
data OptimisationLevel Source
Some compilers support optimising. Some have different levels. For compilers that do not the level is just capped to the level they do support.
Bounded OptimisationLevel | |
Enum OptimisationLevel | |
Eq OptimisationLevel | |
Read OptimisationLevel | |
Show OptimisationLevel | |
Generic OptimisationLevel | |
Binary OptimisationLevel | |
type Rep OptimisationLevel = D1 (MetaData "OptimisationLevel" "Distribution.Simple.Compiler" "Cabal-1.23.1.0" False) ((:+:) (C1 (MetaCons "NoOptimisation" PrefixI False) U1) ((:+:) (C1 (MetaCons "NormalOptimisation" PrefixI False) U1) (C1 (MetaCons "MaximumOptimisation" PrefixI False) U1))) |
Support for debug info levels
data DebugInfoLevel Source
Some compilers support emitting debug info. Some have different levels. For compilers that do not the level is just capped to the level they do support.
Bounded DebugInfoLevel | |
Enum DebugInfoLevel | |
Eq DebugInfoLevel | |
Read DebugInfoLevel | |
Show DebugInfoLevel | |
Generic DebugInfoLevel | |
Binary DebugInfoLevel | |
type Rep DebugInfoLevel = D1 (MetaData "DebugInfoLevel" "Distribution.Simple.Compiler" "Cabal-1.23.1.0" False) ((:+:) ((:+:) (C1 (MetaCons "NoDebugInfo" PrefixI False) U1) (C1 (MetaCons "MinimalDebugInfo" PrefixI False) U1)) ((:+:) (C1 (MetaCons "NormalDebugInfo" PrefixI False) U1) (C1 (MetaCons "MaximalDebugInfo" PrefixI False) U1))) |
Support for language extensions
unsupportedLanguages :: Compiler -> [Language] -> [Language] Source
extensionsToFlags :: Compiler -> [Extension] -> [Flag] Source
For the given compiler, return the flags for the supported extensions.
unsupportedExtensions :: Compiler -> [Extension] -> [Extension] Source
For the given compiler, return the extensions it does not support.
parmakeSupported :: Compiler -> Bool Source
Does this compiler support parallel --make mode?
reexportedModulesSupported :: Compiler -> Bool Source
Does this compiler support reexported-modules?
renamingPackageFlagsSupported :: Compiler -> Bool Source
Does this compiler support thinning/renaming on package flags?
unifiedIPIDRequired :: Compiler -> Bool Source
Does this compiler have unified IPIDs (so no package keys)
packageKeySupported :: Compiler -> Bool Source
Does this compiler support package keys?
unitIdSupported :: Compiler -> Bool Source
Does this compiler support unit IDs?
Support for profiling detail levels
data ProfDetailLevel Source
Some compilers (notably GHC) support profiling and can instrument programs so the system can account costs to different functions. There are different levels of detail that can be used for this accounting. For compilers that do not support this notion or the particular detail levels, this is either ignored or just capped to some similar level they do support.
ProfDetailNone | |
ProfDetailDefault | |
ProfDetailExportedFunctions | |
ProfDetailToplevelFunctions | |
ProfDetailAllFunctions | |
ProfDetailOther String |
Eq ProfDetailLevel | |
Read ProfDetailLevel | |
Show ProfDetailLevel | |
Generic ProfDetailLevel | |
Binary ProfDetailLevel | |
type Rep ProfDetailLevel = D1 (MetaData "ProfDetailLevel" "Distribution.Simple.Compiler" "Cabal-1.23.1.0" False) ((:+:) ((:+:) (C1 (MetaCons "ProfDetailNone" PrefixI False) U1) ((:+:) (C1 (MetaCons "ProfDetailDefault" PrefixI False) U1) (C1 (MetaCons "ProfDetailExportedFunctions" PrefixI False) U1))) ((:+:) (C1 (MetaCons "ProfDetailToplevelFunctions" PrefixI False) U1) ((:+:) (C1 (MetaCons "ProfDetailAllFunctions" PrefixI False) U1) (C1 (MetaCons "ProfDetailOther" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))))) |
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] Source