Commit 2f0fd6af authored by David Himmelstrup's avatar David Himmelstrup
Browse files

Semi-decent lhc support.

parent 33b07c44
......@@ -85,6 +85,7 @@ Library
Distribution.Simple.Install,
Distribution.Simple.InstallDirs,
Distribution.Simple.JHC,
Distribution.Simple.LHC,
Distribution.Simple.LocalBuildInfo,
Distribution.Simple.NHC,
Distribution.Simple.PackageIndex,
......
......@@ -73,12 +73,12 @@ import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (toLower, isDigit, isAlphaNum)
import Control.Monad (when)
data CompilerFlavor = GHC | NHC | YHC | Hugs | HBC | Helium | JHC
data CompilerFlavor = GHC | NHC | YHC | Hugs | HBC | Helium | JHC | LHC
| OtherCompiler String
deriving (Show, Read, Eq, Ord)
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors = [GHC, NHC, YHC, Hugs, HBC, Helium, JHC]
knownCompilerFlavors = [GHC, NHC, YHC, Hugs, HBC, Helium, JHC, LHC]
instance Text CompilerFlavor where
disp (OtherCompiler name) = Disp.text name
......
......@@ -60,6 +60,7 @@ module Distribution.Simple.Build (
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
......@@ -114,6 +115,7 @@ build pkg_descr lbi flags suffixes = do
case compilerFlavor (compiler lbi) of
GHC -> GHC.build pkg_descr lbi verbosity
JHC -> JHC.build pkg_descr lbi verbosity
LHC -> LHC.build pkg_descr lbi verbosity
Hugs -> Hugs.build pkg_descr lbi verbosity
NHC -> NHC.build pkg_descr lbi verbosity
_ -> die ("Building is not supported with this compiler.")
......
......@@ -116,6 +116,7 @@ import Distribution.Verbosity
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
......@@ -340,6 +341,7 @@ configure (pkg_descr0, pbi) cfg
dep_pkgs <- case flavor of
GHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
JHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
LHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
_ -> return bogusDependencies
packageDependsIndex <-
......@@ -515,6 +517,7 @@ getInstalledPackages verbosity comp packageDb progconf = do
case compilerFlavor comp of
GHC -> Just `fmap` GHC.getInstalledPackages verbosity packageDb progconf
JHC -> Just `fmap` JHC.getInstalledPackages verbosity packageDb progconf
LHC -> Just `fmap` LHC.getInstalledPackages verbosity packageDb progconf
_ -> return Nothing
-- -----------------------------------------------------------------------------
......@@ -631,6 +634,8 @@ configCompiler (Just hcFlavor) hcPath hcPkg conf verbosity = do
case hcFlavor of
GHC -> GHC.configure verbosity hcPath hcPkg conf
JHC -> JHC.configure verbosity hcPath hcPkg conf
LHC -> do (_,ghcConf) <- GHC.configure verbosity Nothing hcPkg conf
LHC.configure verbosity hcPath Nothing ghcConf
Hugs -> Hugs.configure verbosity hcPath hcPkg conf
NHC -> NHC.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
......
......@@ -63,6 +63,7 @@ import Distribution.Simple.Setup (CopyFlags(..), CopyDest(..), fromFlag)
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import Control.Monad (when, unless)
......@@ -162,6 +163,8 @@ install pkg_descr lbi flags = do
GHC.installExe flags lbi installDirs pretendInstallDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
JHC -> do withLib pkg_descr () $ JHC.installLib verbosity libPref buildPref pkg_descr
withExe pkg_descr $ JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr
LHC -> do withLib pkg_descr () $ LHC.installLib verbosity libPref buildPref pkg_descr
withExe pkg_descr $ LHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr
Hugs -> do
let targetProgPref = progdir (absoluteInstallDirs pkg_descr lbi NoCopyDest)
let scratchPref = scratchDir lbi
......
......@@ -217,7 +217,8 @@ type InstallDirTemplates = InstallDirs PathTemplate
defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs comp userInstall hasLibs = do
windowsProgramFilesDir <- getWindowsProgramFilesDir
userInstallPrefix <- getAppUserDataDirectory "cabal"
userInstallPrefix <- getAppUserDataDirectory "cabal"
lhcPrefix <- getAppUserDataDirectory "lhc"
return $ fmap toPathTemplate $ InstallDirs {
prefix = if userInstall
then userInstallPrefix
......@@ -227,10 +228,14 @@ defaultInstallDirs comp userInstall hasLibs = do
bindir = "$prefix" </> "bin",
libdir = case buildOS of
Windows -> "$prefix"
_other -> "$prefix" </> "lib",
_other -> case comp of
LHC -> if userInstall then lhcPrefix
else "/usr/local/lib"
_other -> "$prefix" </> "lib",
libsubdir = case comp of
Hugs -> "hugs" </> "packages" </> "$pkg"
JHC -> "$compiler"
LHC -> "$compiler"
_other -> "$pkgid" </> "$compiler",
dynlibdir = "$libdir",
libexecdir = case buildOS of
......
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.LHC
-- Copyright : Isaac Jones 2003-2006
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This module contains most of the LHC-specific code for configuring, building
-- and installing packages.
{- Copyright (c) 2003-2005, Isaac Jones
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.LHC (
configure, getInstalledPackages, build, installLib, installExe,
getLhcLibDirsFromVersion
) where
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..),
withLib,
Executable(..), withExe, Library(..),
libModules, hcOptions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(package) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
( autogenModulesDir, exeExtension )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..)
, PackageDB(..), Flag, extensionsToFlags )
import Language.Haskell.Extension (Extension(..))
import Distribution.Simple.Program ( ConfiguredProgram(..), lhcProgram,
ProgramConfiguration, userMaybeSpecifyPath,
requireProgram, lookupProgram, userSpecifyArgs,
rawSystemProgram, rawSystemProgramStdoutConf )
import Distribution.Version ( VersionRange(AnyVersion) )
import Data.Version ( Version(..) )
import Distribution.Package
( Package(..), packageName, packageVersion )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, copyFileVerbose, writeFileAtomic
, die, info, intercalate )
import System.FilePath ( (</>) )
import System.Directory ( getAppUserDataDirectory )
import Distribution.Verbosity
import Distribution.Text
( Text(parse), display )
import Distribution.Compat.ReadP
( readP_to_S, many, skipSpaces )
import Data.List ( nub )
import Data.Char ( isSpace )
import qualified Distribution.Simple.GHC as GHC
-- -----------------------------------------------------------------------------
-- Configuring
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
configure verbosity hcPath _hcPkgPath conf = do
(lhcProg, conf') <- requireProgram verbosity lhcProgram AnyVersion
(userMaybeSpecifyPath "lhc" hcPath conf)
let Just version = programVersion lhcProg
comp = Compiler {
compilerId = CompilerId LHC version,
compilerExtensions = lhcLanguageExtensions
}
return (comp, conf')
-- | The flags for the supported extensions
lhcLanguageExtensions :: [(Extension, Flag)]
lhcLanguageExtensions =
[(TypeSynonymInstances , "")
,(ForeignFunctionInterface , "")
,(NoImplicitPrelude , "--noprelude")
,(CPP , "-fcpp")
]
getLhcLibDirs verbosity conf
= do (lhc,conf') <- requireProgram verbosity lhcProgram AnyVersion conf
getLhcLibDirsFromVersion (programVersion lhc)
getLhcLibDirsFromVersion (Just (Version (x:y:_) tags))
= do let v = Version [x,y] tags
app <- getAppUserDataDirectory "lhc"
return ("/usr/lib/lhc-"++display v,app ++ "/"++display v)
getLhcLibDirsFromVersion _
= return ("","")
getInstalledPackages :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
getInstalledPackages verbosity packagedb conf = do
(globalDir, userDir) <- getLhcLibDirs verbosity conf
let extraArgs = [ "--no-user-package-conf", "--global-conf="++globalDir </> "package.conf"
, "--package-conf=" ++ case packagedb of
SpecificPackageDB path -> path
_ -> userDir </> "package.conf"]
GHC.getInstalledPackages verbosity GlobalPackageDB $ userSpecifyArgs "ghc-pkg" extraArgs conf
-- -----------------------------------------------------------------------------
-- Building
-- | Building a package for LHC.
-- Currently C source files are not supported.
build :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
build pkg_descr lbi verbosity = do
let Just lhcProg = lookupProgram lhcProgram (withPrograms lbi)
withLib pkg_descr () $ \lib -> do
info verbosity "Building library..."
let libBi = libBuildInfo lib
let args = constructLHCCmdLine lbi libBi (buildDir lbi) verbosity
let pkgid = display (packageId pkg_descr)
pfile = buildDir lbi </> "lhc-pkg.conf"
hlfile= buildDir lbi </> (pkgid ++ ".hl")
writeFileAtomic pfile $ lhcPkgConf pkg_descr
rawSystemProgram verbosity lhcProg $ args ++ ["-c","--build-hl="++pfile, "-o", hlfile]
withExe pkg_descr $ \exe -> do
info verbosity ("Building executable "++exeName exe)
let exeBi = buildInfo exe
let out = buildDir lbi </> exeName exe
let args = constructLHCCmdLine lbi exeBi (buildDir lbi) verbosity
rawSystemProgram verbosity lhcProg (["-o",out] ++ args ++ [modulePath exe])
constructLHCCmdLine :: LocalBuildInfo -> BuildInfo -> FilePath -> Verbosity -> [String]
constructLHCCmdLine lbi bi _odir verbosity =
(if verbosity >= deafening then ["-v"] else [])
++ extensionsToFlags (compiler lbi) (extensions bi)
++ hcOptions LHC bi
++ ["--noauto","-i-"]
++ ["--ho-dir",buildDir lbi]
++ concat [["-i", l] | l <- nub (hsSourceDirs bi)]
++ ["-i", autogenModulesDir lbi]
++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
++ (concat [ ["-p", display pkg] | pkg <- packageDeps lbi ])
lhcPkgConf :: PackageDescription -> String
lhcPkgConf pd =
let sline name sel = name ++ ": "++sel pd
Just lib = library pd
comma = intercalate "," . map display
in unlines [sline "name" (display . packageName)
,sline "version" (display . packageVersion)
,"exposed-modules: " ++ (comma (PD.exposedModules lib))
,"hidden-modules: " ++ (comma (otherModules $ libBuildInfo lib))
]
installLib :: Verbosity -> FilePath -> FilePath -> PackageDescription -> Library -> IO ()
installLib verb dest build_dir pkg_descr _ = do
let p = display (packageId pkg_descr)++".hl"
createDirectoryIfMissingVerbose verb True dest
copyFileVerbose verb (build_dir </> p) (dest </> p)
installExe :: Verbosity -> FilePath -> FilePath -> (FilePath,FilePath) -> PackageDescription -> Executable -> IO ()
installExe verb dest build_dir (progprefix,progsuffix) _ exe = do
let exe_name = exeName exe
src = exe_name </> exeExtension
out = (progprefix ++ exe_name ++ progsuffix) </> exeExtension
createDirectoryIfMissingVerbose verb True dest
copyFileVerbose verb (build_dir </> src) (dest </> out)
......@@ -80,6 +80,7 @@ module Distribution.Simple.Program (
, nhcProgram
, hmakeProgram
, jhcProgram
, lhcProgram
, hugsProgram
, ffihugsProgram
, gccProgram
......@@ -556,6 +557,7 @@ builtinPrograms =
, nhcProgram
, hmakeProgram
, jhcProgram
, lhcProgram
-- preprocessors
, hscolourProgram
, haddockProgram
......@@ -622,6 +624,17 @@ jhcProgram = (simpleProgram "jhc") {
_ -> ""
}
lhcProgram :: Program
lhcProgram = (simpleProgram "lhc") {
programFindVersion = findProgramVersion "--version" $ \str ->
-- invoking "lhc --version" gives a string like
-- "lhc 0.3.20080208 (wubgipkamcep-2)
-- compiled by ghc-6.8 on a x86_64 running linux"
case words str of
(_:ver:_) -> reverse $ drop 1 $ dropWhile (/='.') $ reverse ver
_ -> ""
}
-- AArgh! Finding the version of hugs or ffihugs is almost impossible.
hugsProgram :: Program
hugsProgram = simpleProgram "hugs"
......
......@@ -66,7 +66,7 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),
absoluteInstallDirs)
import Distribution.Simple.BuildPaths (haddockName)
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor, PackageDB(..) )
( CompilerFlavor(..), compilerFlavor, compilerVersion, PackageDB(..) )
import Distribution.Simple.Program (ConfiguredProgram, programPath,
programArgs, rawSystemProgram,
lookupProgram, ghcPkgProgram)
......@@ -80,6 +80,7 @@ import Distribution.Package
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, InstalledPackageInfo_(InstalledPackageInfo)
, showInstalledPackageInfo )
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, copyFileVerbose, writeFileAtomic
......@@ -174,6 +175,35 @@ register pkg_descr lbi regFlags
createDirectoryIfMissingVerbose verbosity True (libdir installDirs)
copyFileVerbose verbosity (installedPkgConfigFile distPref)
(libdir installDirs </> "package.conf")
LHC -> do
(globalDir, userDir) <- LHC.getLhcLibDirsFromVersion (Just (compilerVersion (compiler lbi)))
let config_flags = [ "--force", "--no-user-package-conf", "--global-conf="++globalDir </> "package.conf"
, "--package-conf=" ++ case packageDB of
SpecificPackageDB path -> path
_ -> userDir </> "package.conf"]
let instConf | genPkgConf = genPkgConfigFile
| inplace = inplacePkgConfigFile distPref
| otherwise = installedPkgConfigFile distPref
when (genPkgConf || not genScript) $ do
info verbosity ("create " ++ instConf)
writeInstalledConfig distPref pkg_descr lbi inplace (Just instConf)
let register_flags = let conf = if genScript && not isWindows
then ["-"]
else [instConf]
in "update" : conf
let allFlags = config_flags ++ register_flags
let Just pkgTool = lookupProgram ghcPkgProgram (withPrograms lbi)
case () of
_ | genPkgConf -> return ()
| genScript ->
do cfg <- showInstalledConfig distPref pkg_descr lbi inplace
rawSystemPipe pkgTool regScriptLocation cfg allFlags
_ -> rawSystemProgram verbosity pkgTool allFlags
JHC -> notice verbosity "registering for JHC (nothing to do)"
NHC -> notice verbosity "registering nhc98 (nothing to do)"
_ -> die "only registering with GHC/Hugs/jhc/nhc98 is implemented"
......
......@@ -331,6 +331,7 @@ configureOptions showOrParseArgs =
(choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC")
, (Flag NHC, ([] , ["nhc98"]), "compile with NHC")
, (Flag JHC, ([] , ["jhc"]), "compile with JHC")
, (Flag LHC, ([] , ["lhc"]), "compile with LHC")
, (Flag Hugs,([] , ["hugs"]), "compile with Hugs")])
,option "w" ["with-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