alar ([info]nealar) wrote,
@ 2009-05-26 21:43:00
Previous Entry  Add to memories!  Tell a Friend  Next Entry
Current music:Nightmares on wax
Entry tags:cabal, dll, haskell, win, вопрос, тудейное

Кабала
Можно ли с помощью кабалы, а именно, build-type: Simple, собрать DLL? С помощью build-type: Make , ясное дело, её собрать можно, но тогда непонятно, зачем, собственно, нужна кабала. Да и забыл я, как мэйкфайлы пишут, слишком мало практики было.


[info]iakovz и гугл нашли мне вот такой файл: http://www.haskell.org/haskellwiki/Cabal
Фактически, оно, после сборки итогового .o, в которое компилируется пакет, выполняет 2 команды:
$(GHC) --mk-dll -o $(DLLFILE) $(OFILE) $(PACKAGES)
cp $(DLLFILE) $(PKGNAME)\$(DLLFILE)
, где
$(OFILE) = HS$(PKGNAME)$(PKGVER).o
$(DLLFILE) = $(PKGNAME).dll
$(PACKAGES) - зависимости пакета, в виде "-package $(PKGNAME)$(PKGVER)"
--mk-dll - устаревший флаг, теперь он называется -shared.
$(GHC),$(PKGNAME),$(PKGVER) и зависимости медленно и печально извлекаются из кабальных структур данных
cp - программа, которая не всегда есть в наличии под Windows.
Больше ничего этот скрипт не делает. Остальное делает Distribution.Simple.
Что поправить, чтоб учесть изменения в структурах кабалы я уже понял, а куда запихнуть зависимости, которые не в виде пакетов, а в виде внешних библиотек - ещё нет. Но самый сложный вопрос - каноничное место, куда надо класть итоговую DLL. И куда воткнуть .def-файл, который в кабале вообще не предусмотрен.

Фактически, правильный собственный кабальный сборщик делается заменой buildHook в simpleUserHooks со стандартного defaultBuildHook на свой. Но,

{- из Distribution.Simple -}
defaultBuildHook :: PackageDescription -> LocalBuildInfo
-> UserHooks -> BuildFlags -> IO ()
defaultBuildHook pkg_descr localbuildinfo hooks flags = do
let distPref = fromFlag $ buildDistPref flags
build pkg_descr localbuildinfo flags (allSuffixHandlers hooks)
when (hasLibs pkg_descr) $
writeInstalledConfig distPref pkg_descr localbuildinfo False Nothing
{- из Distribution.Simple.Build -}
build :: PackageDescription -- ^mostly information from the .cabal file
-> LocalBuildInfo -- ^Configuration information
-> BuildFlags -- ^Flags that the user passed to build
-> [ PPSuffixHandler ] -- ^preprocessors to run before compiling
-> IO ()
build pkg_descr lbi flags suffixes = do
let distPref = fromFlag (buildDistPref flags)
verbosity = fromFlag (buildVerbosity flags)
initialBuildSteps distPref pkg_descr lbi verbosity suffixes
setupMessage verbosity "Building" (packageId pkg_descr)
case compilerFlavor (compiler lbi) of
GHC -> GHC.build pkg_descr lbi verbosity
JHC -> JHC.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.")
{- из Distribution.Simple.GHC -}
build :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
build pkg_descr lbi verbosity = do
let pref = buildDir lbi
pkgid = packageId pkg_descr
runGhcProg = rawSystemProgramConf verbosity ghcProgram (withPrograms lbi)
ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi)
ifProfLib = when (withProfLib lbi)
ifSharedLib = when (withSharedLib lbi)
ifGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi)

-- Build lib
withLib pkg_descr () $ \lib -> do
info verbosity "Building library..."

libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)

let libTargetDir = pref
forceVanillaLib = TemplateHaskell `elem` extensions libBi
-- TH always needs vanilla libs, even when building for profiling

createDirectoryIfMissingVerbose verbosity True libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recurive modules?
let ghcArgs =
["-package-name", display pkgid ]
++ constructGHCCmdLine lbi libBi libTargetDir verbosity
++ map display (libModules pkg_descr)
ghcArgsProf = ghcArgs
++ ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
]
++ ghcProfOptions libBi
ghcArgsShared = ghcArgs
++ ["-dynamic",
"-hisuf", "dyn_hi",
"-osuf", "dyn_o", "-fPIC"
]
++ ghcSharedOptions libBi
unless (null (libModules pkg_descr)) $
do ifVanillaLib forceVanillaLib (runGhcProg ghcArgs)
ifProfLib (runGhcProg ghcArgsProf)
ifSharedLib (runGhcProg ghcArgsShared)

-- build any C sources
unless (null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_ [do let (odir,args) = constructCcCmdLine lbi libBi pref
filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
runGhcProg args
ifSharedLib (runGhcProg (args ++ ["-fPIC", "-osuf dyn_o"]))
| filename <- cSources libBi]

-- link:
info verbosity "Linking..."
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi)
vanillaLibFilePath = libTargetDir </> mkLibName pkgid
profileLibFilePath = libTargetDir </> mkProfLibName pkgid
sharedLibFilePath = libTargetDir </> mkSharedLibName pkgid
(compilerId (compiler lbi))
ghciLibFilePath = libTargetDir </> mkGHCiLibName pkgid

stubObjs <- fmap catMaybes $ sequence
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules pkg_descr ]
stubProfObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules pkg_descr ]
stubSharedObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| x <- libModules pkg_descr ]

hObjs <- getHaskellObjects pkg_descr libBi lbi
pref objExtension True
hProfObjs <-
if (withProfLib lbi)
then getHaskellObjects pkg_descr libBi lbi
pref ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if (withSharedLib lbi)
then getHaskellObjects pkg_descr libBi lbi
pref ("dyn_" ++ objExtension) False
else return []

unless (null hObjs && null cObjs && null stubObjs) $ do
-- first remove library files if they exists
sequence_
[ removeFile libFilePath `catchIO` \_ -> return ()
| libFilePath <- [vanillaLibFilePath, profileLibFilePath
,sharedLibFilePath, ghciLibFilePath] ]

let arVerbosity | verbosity >= deafening = "v"
| verbosity >= normal = ""
| otherwise = "c"
arArgs = ["q"++ arVerbosity]
++ [vanillaLibFilePath]
arObjArgs =
hObjs
++ map (pref </>) cObjs
++ stubObjs
arProfArgs = ["q"++ arVerbosity]
++ [profileLibFilePath]
arProfObjArgs =
hProfObjs
++ map (pref </>) cObjs
++ stubProfObjs
ldArgs = ["-r"]
++ ["-o", ghciLibFilePath <.> "tmp"]
ldObjArgs =
hObjs
++ map (pref </>) cObjs
++ stubObjs
ghcSharedObjArgs =
hSharedObjs
++ map (pref </>) cSharedObjs
++ stubSharedObjs
-- After the relocation lib is created we invoke ghc -shared
-- with the dependencies spelled out as -package arguments
-- and ghc invokes the linker with the proper library paths
ghcSharedLinkArgs =
>>> [ "-no-auto-link-packages",
>>> "-shared",
>>> "-dynamic",
>>> "-o", sharedLibFilePath ]
++ ghcSharedObjArgs
++ ["-package-name", display pkgid ]
++ (concat [ ["-package", display pkg] | pkg <- packageDeps lbi ])
++ ["-l"++extraLib | extraLib <- extraLibs libBi]
++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]

runLd ldLibName args = do
exists <- doesFileExist ldLibName
-- This method is called iteratively by xargs. The
-- output goes to .tmp, and any existing file
-- named is included when linking. The
-- output is renamed to .
rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
(args ++ if exists then [ldLibName] else [])
renameFile (ldLibName <.> "tmp") ldLibName

runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi)

--TODO: discover this at configure time or runtime on unix
-- The value is 32k on Windows and posix specifies a minimum of 4k
-- but all sensible unixes use more than 4k.
-- we could use getSysVar ArgumentLimit but that's in the unix lib
maxCommandLineSize = 30 * 1024

ifVanillaLib False $ xargs maxCommandLineSize
runAr arArgs arObjArgs

ifProfLib $ xargs maxCommandLineSize
runAr arProfArgs arProfObjArgs

ifGHCiLib $ xargs maxCommandLineSize
(runLd ghciLibFilePath) ldArgs ldObjArgs

ifSharedLib $ runGhcProg ghcSharedLinkArgs

-- build any executables
withExe pkg_descr $ \exe@Executable { exeName = exeName', modulePath = modPath } -> do
info verbosity $ "Building executable: " ++ exeName' ++ "..."

exeBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfExe lbi) (buildInfo exe)

-- exeNameReal, the name that GHC really uses (with .exe on Windows)
let exeNameReal = exeName' <.>
(if null $ takeExtension exeName' then exeExtension else "")

let targetDir = pref </> exeName'
let exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
-- TODO: do we need to put hs-boot files into place for mutually recursive modules?
-- FIX: what about exeName.hi-boot?

-- build executables
unless (null (cSources exeBi)) $ do
info verbosity "Building C Sources."
sequence_ [do let (odir,args) = constructCcCmdLine lbi exeBi
exeDir filename verbosity
createDirectoryIfMissingVerbose verbosity True odir
runGhcProg args
| filename <- cSources exeBi]

srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath

let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
let binArgs linkExe profExe =
(if linkExe
then ["-o", targetDir </> exeNameReal]
else ["-c"])
++ constructGHCCmdLine lbi exeBi exeDir verbosity
++ [exeDir </> x | x <- cObjs]
++ [srcMainFile]
++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi]
++ ["-l"++lib | lib <- extraLibs exeBi]
++ ["-L"++libDir | libDir <- extraLibDirs exeBi]
++ concat [["-framework", f] | f <- PD.frameworks exeBi]
++ if profExe
then ["-prof",
"-hisuf", "p_hi",
"-osuf", "p_o"
] ++ ghcProfOptions exeBi
else []

-- For building exe's for profiling that use TH we actually
-- have to build twice, once without profiling and the again
-- with profiling. This is because the code that TH needs to
-- run at compile time needs to be the vanilla ABI so it can
-- be loaded up and run by the compiler.
when (withProfExe lbi && TemplateHaskell `elem` extensions exeBi)
(runGhcProg (binArgs False False))

runGhcProg (binArgs True (withProfExe lbi))


Выделенные ">>>" строчки нуждаются в замене. Для сборки DLL достаточно флага -shared, а остальное - лишнее. Ради этого переписывать 3 исходных модуля (ведь на верхнем уровне нам доступны только userHooks) в свой кабальный скрипт - это перебор. Создавать свою версию модуля Distribution.Simple и связанных библиотек - развалится, как только кто-нибудь (хотя бы cabal-install) обновит кабалу из hackage. Создавать свой клон кабалы под названием Distribution.VerySimple - порвёт совместимость с кабальными инструментами, ведь наш пакет будет ставиться не cabal-install, а нашей собственной библиотекой. Можно, конечно, сделать бутстрап - сначала кабала собирает пакет Distribution.VerySimple (он у нас будет указан как зависимость), а потом строчка import Distribution.VerySimple в Setup.hs у нашего пакета ставит всё на место.
Оказалось, над проблемой бьются лучшие умы: http://hackage.haskell.org/trac/hackage/ticket/148
Короче, .bat-файл для сборки DLL - не такая уж плохая штука.
Слегка причёсанный Setup.hs из гугла:

import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription
import System.Cmd
import System.Directory
import Data.List
import Distribution.Text


main = defaultMainWithHooks (simpleUserHooks { postBuild = buildDll })
where
buildDll _ _ pkg info = do
putStrLn "Building Dll..."
setCurrentDirectory (buildDir info)
let buildCmd = concat $ intersperse " " [ghcExe,"-shared","-o",dllFile,oFile,packages]
dllFile = display (pkgName (package pkg)) ++ ".dll"
oFile = "HS" ++ (name pkg) ++ ".o"
packages = concat $ intersperse " " $ map showPackage $ packageDeps info
-- эта строчка лишняя
cpDllCmd = "cp " ++ dllFile ++ " " ++ (name pkg) ++ "\\" ++ dllFile
ghcExe = display $ compilerFlavor $ compiler $ info

showPackage :: PackageIdentifier -> String
showPackage pi = "-package " ++ display pi
name :: PackageDescription -> String
name = display . package

putStrLn buildCmd
system buildCmd
-- и эти 2 тоже
putStrLn cpDllCmd
system cpDllCmd
return ()

Но он ещё не умеет учитывать сишные исходники и дополнительные библиотеки.




(Read 13 comments) - (Post a new comment)


[info]nealar
2009-05-27 09:19 am UTC (link)
Прошу помощи: где бы подсмотреть makefile, который собирает пакет, хотя бы частично похожий на кабальный.

(Reply to this) (Parent)(Thread)


[info]thesz
2009-05-27 09:33 am UTC (link)
Я только по Makefile.

Из всей кабалы я знаю только rughc Setup.hs.

(Reply to this) (Parent)(Thread)


[info]nealar
2009-05-27 10:26 am UTC (link)
Я про Makefile и спрашиваю. У всей кабалы, похоже, смысл только в том, чтобы файлы положить по тем путям, которые в настройках указаны. Чтобы эти настройки передать в make, они используют ./configure, а я его вообще боюсь. И вообще заявляют, что поддержку Distribution.Make они когда-нибудь бросят. :(

(Reply to this) (Parent)(Thread)


[info]thesz
2009-05-27 07:44 pm UTC (link)
Я в том смысле, что не представляю, что такое "пакет кабалы".

(Reply to this) (Parent)(Thread)


[info]nealar
2009-05-27 08:17 pm UTC (link)
Ясно. Попробую сам. Но я правильно прописать зависимость от кабальных настроек точно не сумею. Будет всё ставиться куда-нибудь мне под нос.

(Reply to this) (Parent)


(Read 13 comments) - (Post a new comment)

Create an Account
Forgot your login or password?
Login w/ OpenID
English • Español • Deutsch • Русский…