Commit 4c2a3c33 authored by Roman Cheplyaka's avatar Roman Cheplyaka
Browse files

Implement a haskell-suite compiler support

parent 809ba758
......@@ -170,6 +170,7 @@ library
Distribution.Simple.Configure
Distribution.Simple.GHC
Distribution.Simple.Haddock
Distribution.Simple.HaskellSuite
Distribution.Simple.Hpc
Distribution.Simple.Hugs
Distribution.Simple.Install
......
......@@ -79,6 +79,7 @@ import qualified Data.Char as Char (toLower, isDigit, isAlphaNum)
import Control.Monad (when)
data CompilerFlavor = GHC | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC
| HaskellSuite String -- string is the id of the actual compiler
| OtherCompiler String
deriving (Show, Read, Eq, Ord, Typeable, Data)
......@@ -87,6 +88,7 @@ knownCompilerFlavors = [GHC, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC]
instance Text CompilerFlavor where
disp (OtherCompiler name) = Disp.text name
disp (HaskellSuite name) = Disp.text name
disp NHC = Disp.text "nhc98"
disp other = Disp.text (lowercase (show other))
......
......@@ -58,6 +58,7 @@ import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.Build.Macros as Build.Macros
import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
......@@ -470,6 +471,7 @@ buildLib verbosity pkg_descr lbi lib clbi =
Hugs -> Hugs.buildLib verbosity pkg_descr lbi lib clbi
NHC -> NHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
_ -> die "Building is not supported with this compiler."
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
......
......@@ -141,6 +141,7 @@ import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Control.Monad
( when, unless, foldM, filterM )
......@@ -698,6 +699,8 @@ getInstalledPackages verbosity comp packageDBs progconf = do
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
NHC -> NHC.getInstalledPackages verbosity packageDBs progconf
UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
HaskellSuite {} ->
HaskellSuite.getInstalledPackages verbosity packageDBs progconf
flv -> die $ "don't know how to find the installed packages for "
++ display flv
......@@ -878,6 +881,7 @@ configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do
Hugs -> Hugs.configure verbosity hcPath hcPkg conf
NHC -> NHC.configure verbosity hcPath hcPkg conf
UHC -> UHC.configure verbosity hcPath hcPkg conf
HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)
......
module Distribution.Simple.HaskellSuite where
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Version
import Distribution.Simple.Program
import Distribution.Simple.Compiler as Compiler
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.Verbosity
import Distribution.Text
import Distribution.Package
import Distribution.InstalledPackageInfo hiding (includeDirs)
import Distribution.Simple.PackageIndex as PackageIndex
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.System (Platform)
import Distribution.Compat.Exception
import Language.Haskell.Extension
import Distribution.Simple.Program.Builtin
(haskellSuiteProgram, haskellSuitePkgProgram)
configure
:: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration)
configure verbosity mbHcPath hcPkgPath conf0 = do
-- We have no idea how a haskell-suite tool is named, so we require at
-- least some information from the user.
hcPath <-
let msg = "You have to provide name or path of a haskell-suite tool (-w PATH)"
in maybe (die msg) return mbHcPath
when (isJust hcPkgPath) $
warn verbosity "--with-hc-pkg option is ignored for haskell-suite"
(comp, confdCompiler, conf1) <- configureCompiler hcPath conf0
-- Update our pkg tool. It uses the same executable as the compiler, but
-- all command start with "pkg"
(confdPkg, _) <- requireProgram verbosity haskellSuitePkgProgram conf1
let conf2 =
updateProgram
confdPkg
{ programLocation = programLocation confdCompiler
, programDefaultArgs = ["pkg"]
}
conf1
return (comp, Nothing, conf2)
where
configureCompiler hcPath conf0' = do
let
haskellSuiteProgram' =
haskellSuiteProgram
{ programFindLocation = \v _p -> findProgramLocation v hcPath }
-- NB: cannot call requireProgram right away — it'd think that
-- the program is already configured and won't reconfigure it again.
-- Instead, call configureProgram directly first.
conf1 <- configureProgram verbosity haskellSuiteProgram' conf0'
(confdCompiler, conf2) <- requireProgram verbosity haskellSuiteProgram' conf1
extensions <- getExtensions verbosity confdCompiler
languages <- getLanguages verbosity confdCompiler
(compName, compVersion) <-
getCompilerVersion verbosity confdCompiler
let
comp = Compiler {
compilerId = CompilerId (HaskellSuite compName) compVersion,
compilerLanguages = languages,
compilerExtensions = extensions
}
return (comp, confdCompiler, conf2)
hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
hstoolVersion = findProgramVersion "--hspkg-version" id
numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
numericVersion = findProgramVersion "--compiler-version" (last . words)
getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
getCompilerVersion verbosity prog = do
output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"]
let
parts = words output
name = concat $ init parts -- there shouldn't be any spaces in the name anyway
versionStr = last parts
version <-
maybe (die "haskell-suite: couldn't determine compiler version") return $
simpleParse versionStr
return (name, version)
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Compiler.Flag)]
getExtensions verbosity prog = do
extStrs <-
lines <$>
rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
return
[ (ext, "-X" ++ display ext) | Just ext <- map simpleParse extStrs ]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Compiler.Flag)]
getLanguages verbosity prog = do
langStrs <-
lines <$>
rawSystemStdout verbosity (programPath prog) ["--supported-languages"]
return
[ (ext, "-G" ++ display ext) | Just ext <- map simpleParse langStrs ]
-- Other compilers do some kind of a packagedb stack check here. Not sure
-- if we need something like that as well.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf =
liftM (PackageIndex.fromList . concat) $ forM packagedbs $ \packagedb ->
do str <-
getDbProgramOutput verbosity haskellSuitePkgProgram conf
["dump", packageDbOpt packagedb]
`catchExit` \_ -> die $ "pkg dump failed"
case parsePackages str of
Right ok -> return ok
_ -> die "failed to parse output of 'pkg dump'"
where
parsePackages str =
let parsed = map parseInstalledPackageInfo (splitPkgs str)
in case [ msg | ParseFailed msg <- parsed ] of
[] -> Right [ pkg | ParseOk _ pkg <- parsed ]
msgs -> Left msgs
splitPkgs :: String -> [String]
splitPkgs = map unlines . splitWith ("---" ==) . lines
where
splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith p xs = ys : case zs of
[] -> []
_:ws -> splitWith p ws
where (ys,zs) = break p xs
buildLib
:: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
-- In future, there should be a mechanism for the compiler to request any
-- number of the above parameters (or their parts) — in particular,
-- pieces of PackageDescription.
--
-- For now, we only pass those that we know are used.
let odir = buildDir lbi
bi = libBuildInfo lib
srcDirs = hsSourceDirs bi ++ [odir]
dbStack = withPackageDB lbi
language = fromMaybe Haskell98 (defaultLanguage bi)
conf = withPrograms lbi
pkgid = packageId pkg_descr
runDbProgram verbosity haskellSuiteProgram conf $
[ "compile", "--build-dir", odir ] ++
concat [ ["-i", d] | d <- srcDirs ] ++
concat [ ["-I", d] | d <- [autogenModulesDir lbi, odir] ++ includeDirs bi ] ++
[ packageDbOpt pkgDb | pkgDb <- dbStack ] ++
[ "--package-name", display pkgid ] ++
concat [ ["--package-id", display ipkgid ]
| (ipkgid, _) <- componentPackageDeps clbi ] ++
["-G", display language] ++
concat [ ["-X", display ex] | ex <- usedExtensions bi ] ++
[ display modu | modu <- libModules lib ]
installLib
:: Verbosity
-> LocalBuildInfo
-> FilePath -- ^install location
-> FilePath -- ^install location for dynamic librarys
-> FilePath -- ^Build location
-> PackageDescription
-> Library
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
let conf = withPrograms lbi
runDbProgram verbosity haskellSuitePkgProgram conf $
[ "install-library"
, "--build-dir", builtDir
, "--target-dir", targetDir
, "--dynlib-target-dir", dynlibTargetDir
, "--package-id", display $ packageId pkg
] ++ map display (libModules lib)
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
(hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram (withPrograms lbi)
runProgramInvocation verbosity $
(programInvocation hspkg
["update", packageDbOpt $ last packageDbs])
{ progInvokeInput = Just $ showInstalledPackageInfo installedPkgInfo }
initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO ()
initPackageDB verbosity conf dbPath =
runDbProgram verbosity haskellSuitePkgProgram conf
["init", dbPath]
packageDbOpt :: PackageDB -> String
packageDbOpt GlobalPackageDB = "--global"
packageDbOpt UserPackageDB = "--user"
packageDbOpt (SpecificPackageDB db) = "--package-db=" ++ db
......@@ -67,6 +67,7 @@ import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Control.Monad (when, unless)
import System.Directory
......@@ -175,6 +176,9 @@ install pkg_descr lbi flags = do
NHC -> do withLibLBI pkg_descr lbi $ NHC.installLib verbosity libPref buildPref (packageId pkg_descr)
withExe pkg_descr $ NHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref)
UHC -> do withLib pkg_descr $ UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
HaskellSuite {} ->
withLib pkg_descr $
HaskellSuite.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
_ -> die $ "installing with "
++ display (compilerFlavor (compiler lbi))
++ " is not implemented"
......
......@@ -540,45 +540,18 @@ platformDefines :: LocalBuildInfo -> [String]
platformDefines lbi =
case compilerFlavor comp of
GHC ->
let ghcOS = case hostOS of
Linux -> ["linux"]
Windows -> ["mingw32"]
OSX -> ["darwin"]
FreeBSD -> ["freebsd"]
OpenBSD -> ["openbsd"]
NetBSD -> ["netbsd"]
Solaris -> ["solaris2"]
AIX -> ["aix"]
HPUX -> ["hpux"]
IRIX -> ["irix"]
HaLVM -> []
IOS -> ["ios"]
OtherOS _ -> []
ghcArch = case hostArch of
I386 -> ["i386"]
X86_64 -> ["x86_64"]
PPC -> ["powerpc"]
PPC64 -> ["powerpc64"]
Sparc -> ["sparc"]
Arm -> ["arm"]
Mips -> ["mips"]
SH -> []
IA64 -> ["ia64"]
S390 -> ["s390"]
Alpha -> ["alpha"]
Hppa -> ["hppa"]
Rs6000 -> ["rs6000"]
M68k -> ["m68k"]
Vax -> ["vax"]
OtherArch _ -> []
in ["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++
["-D" ++ os ++ "_BUILD_OS=1"] ++
["-D" ++ arch ++ "_BUILD_ARCH=1"] ++
map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") ghcOS ++
map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") ghcArch
["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++
["-D" ++ os ++ "_BUILD_OS=1"] ++
["-D" ++ arch ++ "_BUILD_ARCH=1"] ++
map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++
map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
JHC -> ["-D__JHC__=" ++ versionInt version]
NHC -> ["-D__NHC__=" ++ versionInt version]
Hugs -> ["-D__HUGS__"]
HaskellSuite {} ->
["-D__HASKELL_SUITE__"] ++
map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++
map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
_ -> []
where
comp = compiler lbi
......@@ -599,6 +572,37 @@ platformDefines lbi =
_ : _ : _ -> ""
_ -> "0"
in s1 ++ middle ++ s2
osStr = case hostOS of
Linux -> ["linux"]
Windows -> ["mingw32"]
OSX -> ["darwin"]
FreeBSD -> ["freebsd"]
OpenBSD -> ["openbsd"]
NetBSD -> ["netbsd"]
Solaris -> ["solaris2"]
AIX -> ["aix"]
HPUX -> ["hpux"]
IRIX -> ["irix"]
HaLVM -> []
IOS -> ["ios"]
OtherOS _ -> []
archStr = case hostArch of
I386 -> ["i386"]
X86_64 -> ["x86_64"]
PPC -> ["powerpc"]
PPC64 -> ["powerpc64"]
Sparc -> ["sparc"]
Arm -> ["arm"]
Mips -> ["mips"]
SH -> []
IA64 -> ["ia64"]
S390 -> ["s390"]
Alpha -> ["alpha"]
Hppa -> ["hppa"]
Rs6000 -> ["rs6000"]
M68k -> ["m68k"]
Vax -> ["vax"]
OtherArch _ -> []
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi = pp { platformIndependent = True }
......
......@@ -25,6 +25,8 @@ module Distribution.Simple.Program.Builtin (
jhcProgram,
hugsProgram,
ffihugsProgram,
haskellSuiteProgram,
haskellSuitePkgProgram,
uhcProgram,
gccProgram,
ranlibProgram,
......@@ -66,6 +68,8 @@ builtinPrograms =
, ghcPkgProgram
, hugsProgram
, ffihugsProgram
, haskellSuiteProgram
, haskellSuitePkgProgram
, nhcProgram
, hmakeProgram
, jhcProgram
......@@ -175,6 +179,39 @@ hugsProgram = simpleProgram "hugs"
ffihugsProgram :: Program
ffihugsProgram = simpleProgram "ffihugs"
-- This represents a haskell-suite compiler. Of course, the compiler
-- itself probably is not called "haskell-suite", so this is not a real
-- program. (But we don't know statically the name of the actual compiler,
-- so this is the best we can do.)
--
-- Having this Program value serves two purposes:
--
-- 1. We can accept options for the compiler in the form of
--
-- --haskell-suite-option(s)=...
--
-- 2. We can find a program later using this static id (with
-- requireProgram).
--
-- The path to the real compiler is found and recorded in the ProgramDb
-- during the configure phase.
haskellSuiteProgram :: Program
haskellSuiteProgram = (simpleProgram "haskell-suite") {
-- pretend that the program exists, otherwise it won't be in the
-- "configured" state
programFindLocation =
\_verbosity _searchPath -> return $ Just "haskell-suite-dummy-location"
}
-- This represent a haskell-suite package manager. See the comments for
-- haskellSuiteProgram.
haskellSuitePkgProgram :: Program
haskellSuitePkgProgram = (simpleProgram "haskell-suite-pkg") {
programFindLocation =
\_verbosity _searchPath -> return $ Just "haskell-suite-pkg-dummy-location"
}
happyProgram :: Program
happyProgram = (simpleProgram "happy") {
programFindVersion = findProgramVersion "--version" $ \str ->
......
......@@ -76,6 +76,7 @@ import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Distribution.Simple.Compiler
( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor
, PackageDBStack, registrationPackageDB )
......@@ -214,6 +215,7 @@ initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath
initPackageDB verbosity comp conf dbPath =
case (compilerFlavor comp) of
GHC -> GHC.initPackageDB verbosity conf dbPath
HaskellSuite {} -> HaskellSuite.initPackageDB verbosity conf dbPath
_ -> die "Distribution.Simple.Register.initPackageDB: \
\not implemented for this compiler"
......@@ -246,6 +248,8 @@ registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs = do
UHC -> UHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs
JHC -> notice verbosity "Registering for jhc (nothing to do)"
NHC -> notice verbosity "Registering for nhc98 (nothing to do)"
HaskellSuite {} ->
HaskellSuite.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs
_ -> die "Registering is not implemented for this compiler"
......
......@@ -375,7 +375,12 @@ configureOptions showOrParseArgs =
, (Flag JHC, ([] , ["jhc"]), "compile with JHC")
, (Flag LHC, ([] , ["lhc"]), "compile with LHC")
, (Flag Hugs,([] , ["hugs"]), "compile with Hugs")
, (Flag UHC, ([] , ["uhc"]), "compile with UHC")])
, (Flag UHC, ([] , ["uhc"]), "compile with UHC")
-- "haskell-suite" compiler id string will be replaced
-- by a more specific one during the configure stage
, (Flag (HaskellSuite "haskell-suite"), ([] , ["haskell-suite"]),
"compile with a haskell-suite compiler")])
,option "w" ["with-compiler"]
"give the path to a particular compiler"
......
Markdown is supported
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