From c1efb8d247d6da6ca20daf7ce322dc2f91047a54 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Fri, 11 May 2018 22:16:41 -0400 Subject: [PATCH 1/9] Correcting missing linking objects from non-library components. --- .../Distribution/PackageDescription/Check.hs | 34 ++++++---- Cabal/Distribution/Simple/BuildTarget.hs | 2 + Cabal/Distribution/Simple/GHC.hs | 64 ++++++++++++++----- Cabal/Distribution/Simple/GHC/IPI642.hs | 2 + Cabal/Distribution/Simple/GHC/Internal.hs | 10 +++ Cabal/Distribution/Simple/JHC.hs | 2 + Cabal/Distribution/Simple/PreProcess.hs | 11 ++-- Cabal/Distribution/Simple/Register.hs | 1 + Cabal/Distribution/Simple/SrcDist.hs | 2 +- .../Types/InstalledPackageInfo.hs | 1 + .../InstalledPackageInfo/FieldGrammar.hs | 1 + .../Types/InstalledPackageInfo/Lens.hs | 4 ++ 12 files changed, 98 insertions(+), 36 deletions(-) diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 87c10b8a818..06bb5307a0e 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -165,6 +165,7 @@ checkConfiguredPackage pkg = ++ checkSourceRepos pkg ++ checkGhcOptions pkg ++ checkCCOptions pkg + ++ checkCxxOptions pkg ++ checkCPPOptions pkg ++ checkPaths pkg ++ checkCabalVersion pkg @@ -960,17 +961,23 @@ checkGhcOptions pkg = disable e = Just (DisableExtension e) checkCCOptions :: PackageDescription -> [PackageCheck] -checkCCOptions pkg = +checkCCOptions = checkCLikeOptions "C" "cc-options" ccOptions + +checkCxxOptions :: PackageDescription -> [PackageCheck] +checkCxxOptions = checkCLikeOptions "C++" "cxx-options" cxxOptions + +checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] +checkCLikeOptions label prefix accessor pkg = catMaybes [ - checkAlternatives "cc-options" "include-dirs" - [ (flag, dir) | flag@('-':'I':dir) <- all_ccOptions ] + checkAlternatives prefix "include-dirs" + [ (flag, dir) | flag@('-':'I':dir) <- all_cLikeOptions ] - , checkAlternatives "cc-options" "extra-libraries" - [ (flag, lib) | flag@('-':'l':lib) <- all_ccOptions ] + , checkAlternatives prefix "extra-libraries" + [ (flag, lib) | flag@('-':'l':lib) <- all_cLikeOptions ] - , checkAlternatives "cc-options" "extra-lib-dirs" - [ (flag, dir) | flag@('-':'L':dir) <- all_ccOptions ] + , checkAlternatives prefix "extra-lib-dirs" + [ (flag, dir) | flag@('-':'L':dir) <- all_cLikeOptions ] , checkAlternatives "ld-options" "extra-libraries" [ (flag, lib) | flag@('-':'l':lib) <- all_ldOptions ] @@ -980,19 +987,18 @@ checkCCOptions pkg = , checkCCFlags [ "-O", "-Os", "-O0", "-O1", "-O2", "-O3" ] $ PackageDistSuspicious $ - "'cc-options: -O[n]' is generally not needed. When building with " - ++ " optimisations Cabal automatically adds '-O2' for C code. " - ++ "Setting it yourself interferes with the --disable-optimization " - ++ "flag." + "'"++prefix++": -O[n]' is generally not needed. When building with " + ++ " optimisations Cabal automatically adds '-O2' for "++label++" code. " + ++ "Setting it yourself interferes with the --disable-optimization flag." ] - where all_ccOptions = [ opts | bi <- allBuildInfo pkg - , opts <- ccOptions bi ] + where all_cLikeOptions = [ opts | bi <- allBuildInfo pkg + , opts <- accessor bi ] all_ldOptions = [ opts | bi <- allBuildInfo pkg , opts <- ldOptions bi ] checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkCCFlags flags = check (any (`elem` flags) all_ccOptions) + checkCCFlags flags = check (any (`elem` flags) all_cLikeOptions) checkCPPOptions :: PackageDescription -> [PackageCheck] checkCPPOptions pkg = diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index cfa91c01c7b..e3aa8ef5f9b 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -453,6 +453,7 @@ data ComponentInfo = ComponentInfo { cinfoAsmFiles:: [FilePath], cinfoCmmFiles:: [FilePath], cinfoCFiles :: [FilePath], + cinfoCxxFiles:: [FilePath], cinfoJsFiles :: [FilePath] } @@ -469,6 +470,7 @@ pkgComponentInfo pkg = cinfoAsmFiles= asmSources bi, cinfoCmmFiles= cmmSources bi, cinfoCFiles = cSources bi, + cinfoCxxFiles= cxxSources bi, cinfoJsFiles = jsSources bi } | c <- pkgComponents pkg diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 96376e3e386..c446327d8ad 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -657,19 +657,19 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do info verbosity "Building C++ Sources..." sequence_ [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo - lbi libBi clbi libTargetDir filename + lbi libBi clbi libTargetDir filename vanillaCxxOpts = if isGhcDynamic then baseCxxOpts { ghcOptFPic = toFlag True } else baseCxxOpts profCxxOpts = vanillaCxxOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptObjSuffix = toFlag "p_o" - } + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } sharedCxxOpts = vanillaCxxOpts `mappend` mempty { - ghcOptFPic = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptObjSuffix = toFlag "dyn_o" - } + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } odir = fromFlag (ghcOptObjDir vanillaCxxOpts) createDirectoryIfMissingVerbose verbosity True odir let runGhcProgIfNeeded cxxOpts = do @@ -1088,7 +1088,7 @@ gbuildSources :: Verbosity -> Version -- ^ specVersion -> FilePath -> GBuildMode - -> IO ([FilePath], [FilePath], [ModuleName]) + -> IO ([FilePath], [FilePath], [FilePath], [ModuleName]) gbuildSources verbosity specVer tmpDir bm = case bm of GBuildExe exe -> exeSources exe @@ -1096,7 +1096,7 @@ gbuildSources verbosity specVer tmpDir bm = GBuildFLib flib -> return $ flibSources flib GReplFLib flib -> return $ flibSources flib where - exeSources :: Executable -> IO ([FilePath], [FilePath], [ModuleName]) + exeSources :: Executable -> IO ([FilePath], [FilePath], [FilePath], [ModuleName]) exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do main <- findFile (tmpDir : hsSourceDirs bnfo) modPath let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe @@ -1121,15 +1121,15 @@ gbuildSources verbosity specVer tmpDir bm = ++ display mainModName ++ "' listed in 'other-modules' illegally!" - return (cSources bnfo, [main], + return (cSources bnfo, cxxSources bnfo, [main], filter (/= mainModName) (exeModules exe)) - else return (cSources bnfo, [main], exeModules exe) - else return (main : cSources bnfo, [], exeModules exe) + else return (cSources bnfo, cxxSources bnfo, [main], exeModules exe) + else return (main : cSources bnfo, main : cxxSources bnfo, [], exeModules exe) - flibSources :: ForeignLib -> ([FilePath], [FilePath], [ModuleName]) + flibSources :: ForeignLib -> ([FilePath], [FilePath], [FilePath], [ModuleName]) flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = - (cSources bnfo, [], foreignLibModules flib) + (cSources bnfo, cxxSources bnfo, [], foreignLibModules flib) isHaskell :: FilePath -> Bool isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] @@ -1168,12 +1168,13 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do | otherwise = mempty rpaths <- getRPaths lbi clbi - (cSrcs, inputFiles, inputModules) <- gbuildSources verbosity + (cSrcs, cxxSrcs, inputFiles, inputModules) <- gbuildSources verbosity (specVersion pkg_descr) tmpDir bm let isGhcDynamic = isDynamic comp dynamicTooSupported = supportsDynamicToo comp cObjs = map (`replaceExtension` objExtension) cSrcs + cxxObjs = map (`replaceExtension` objExtension) cxxSrcs needDynamic = gbuildNeedDynamic lbi bm needProfiling = withProfExe lbi @@ -1223,7 +1224,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs bnfo, ghcOptInputFiles = toNubListR - [tmpDir x | x <- cObjs] + [tmpDir x | x <- cObjs ++ cxxObjs] } dynLinkerOpts = mempty { ghcOptRPaths = rpaths @@ -1283,6 +1284,34 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do runGhcProg compileOpts { ghcOptNoLink = toFlag True , ghcOptNumJobs = numJobs } + -- build any C++ sources + unless (null cxxSrcs) $ do + info verbosity "Building C++ Sources..." + sequence_ + [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo + lbi bnfo clbi tmpDir filename + vanillaCxxOpts = if isGhcDynamic + -- Dynamic GHC requires C++ sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCxxOpts { ghcOptFPic = toFlag True } + else baseCxxOpts + profCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True + } + sharedCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly + } + opts | needProfiling = profCxxOpts + | needDynamic = sharedCxxOpts + | otherwise = vanillaCxxOpts + odir = fromFlag (ghcOptObjDir opts) + createDirectoryIfMissingVerbose verbosity True odir + needsRecomp <- checkNeedsRecompilation filename opts + when needsRecomp $ + runGhcProg opts + | filename <- cxxSrcs ] + -- build any C sources unless (null cSrcs) $ do info verbosity "Building C Sources..." @@ -1757,6 +1786,7 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do hasLib = not $ null (allLibModules lib clbi) && null (cSources (libBuildInfo lib)) + && null (cxxSources (libBuildInfo lib)) has_code = not (componentIsIndefinite clbi) whenHasCode = when has_code whenVanilla = when (hasLib && withVanillaLib lbi) diff --git a/Cabal/Distribution/Simple/GHC/IPI642.hs b/Cabal/Distribution/Simple/GHC/IPI642.hs index 8b275035e93..46def94e992 100644 --- a/Cabal/Distribution/Simple/GHC/IPI642.hs +++ b/Cabal/Distribution/Simple/GHC/IPI642.hs @@ -57,6 +57,7 @@ data InstalledPackageInfo = InstalledPackageInfo { depends :: [PackageIdentifier], hugsOptions :: [String], ccOptions :: [String], + cxxOptions :: [String], ldOptions :: [String], frameworkDirs :: [FilePath], frameworks :: [String], @@ -105,6 +106,7 @@ toCurrent ipi@InstalledPackageInfo{} = Current.depends = map (Current.mkLegacyUnitId . convertPackageId) (depends ipi), Current.abiDepends = [], Current.ccOptions = ccOptions ipi, + Current.cxxOptions = cxxOptions ipi, Current.ldOptions = ldOptions ipi, Current.frameworkDirs = frameworkDirs ipi, Current.frameworks = frameworks ipi, diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 08adc9c117c..2e2a6cf04dd 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -294,6 +294,16 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename = NormalDebugInfo -> ["-g"] MaximalDebugInfo -> ["-g3"]) ++ PD.ccOptions bi, + ghcOptCxxOptions = toNubListR $ + (case withOptimization lbi of + NoOptimisation -> [] + _ -> ["-O2"]) ++ + (case withDebugInfo lbi of + NoDebugInfo -> [] + MinimalDebugInfo -> ["-g1"] + NormalDebugInfo -> ["-g"] + MaximalDebugInfo -> ["-g3"]) ++ + PD.cxxOptions bi, ghcOptObjDir = toFlag odir } diff --git a/Cabal/Distribution/Simple/JHC.hs b/Cabal/Distribution/Simple/JHC.hs index 52e0726521a..39e3413d2b8 100644 --- a/Cabal/Distribution/Simple/JHC.hs +++ b/Cabal/Distribution/Simple/JHC.hs @@ -152,6 +152,8 @@ constructJHCCmdLine lbi bi clbi _odir verbosity = ++ concat [["-i", l] | l <- nub (hsSourceDirs bi)] ++ ["-i", autogenComponentModulesDir lbi clbi] ++ ["-i", autogenPackageModulesDir lbi] + -- Perhaps we need to add the cxxOptions here too? + -- Don't know enough about JHC ++ ["-optc" ++ opt | opt <- PD.ccOptions bi] -- It would be better if JHC would accept package names with versions, -- but JHC-0.7.2 doesn't accept this. diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index 33b94ab56f6..30c740b4f1a 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -423,7 +423,8 @@ ppHsc2hs bi lbi clbi = ++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs bi ] ++ [ "--cflag=-I" ++ buildDir lbi dir | dir <- PD.includeDirs bi ] ++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi - ++ PD.cppOptions bi ] + ++ PD.cppOptions bi + ++ PD.cxxOptions bi ] ++ [ "--cflag=" ++ opt | opt <- [ "-I" ++ autogenComponentModulesDir lbi clbi, "-I" ++ autogenPackageModulesDir lbi, @@ -438,7 +439,8 @@ ppHsc2hs bi lbi clbi = ++ [ "--cflag=" ++ opt | pkg <- pkgs , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] - ++ [ opt | opt <- Installed.ccOptions pkg ] ] + ++ [ opt | opt <- Installed.ccOptions pkg + ++ Installed.cxxOptions pkg ] ] ++ [ "--lflag=" ++ opt | pkg <- pkgs , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ] @@ -501,7 +503,8 @@ ppC2hs bi lbi clbi = ++ [ "--cppopts=" ++ opt | pkg <- pkgs , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] - ++ [ opt | opt@('-':c:_) <- Installed.ccOptions pkg + ++ [ opt | opt@('-':c:_) <- (Installed.ccOptions pkg ++ + Installed.cxxOptions pkg) , c `elem` "DIU" ] ] --TODO: install .chi files for packages, so we can --include -- those dirs here, for the dependencies @@ -525,7 +528,7 @@ getCppOptions bi lbi = platformDefines lbi ++ cppOptions bi ++ ["-I" ++ dir | dir <- PD.includeDirs bi] - ++ [opt | opt@('-':c:_) <- PD.ccOptions bi, c `elem` "DIU"] + ++ [opt | opt@('-':c:_) <- PD.ccOptions bi ++ PD.cxxOptions bi, c `elem` "DIU"] platformDefines :: LocalBuildInfo -> [String] platformDefines lbi = diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 56474eb4b5b..5565d78c188 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -443,6 +443,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi IPI.ccOptions = [], -- Note. NOT ccOptions bi! -- We don't want cc-options to be propagated -- to C compilations in other packages. + IPI.cxxOptions = [], -- Also. NOT cxxOptions bi! IPI.ldOptions = ldOptions bi, IPI.frameworks = frameworks bi, IPI.frameworkDirs = extraFrameworkDirs bi, diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index 862a68e3be2..ebc61159410 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/Cabal/Distribution/Simple/SrcDist.hs @@ -449,7 +449,7 @@ allSourcesBuildInfo verbosity bi pps modules = do in findFileWithExtension fileExts (hsSourceDirs bi) file | module_ <- modules ++ otherModules bi ] - return $ sources ++ catMaybes bootFiles ++ cSources bi ++ jsSources bi + return $ sources ++ catMaybes bootFiles ++ cSources bi ++ cxxSources bi ++ jsSources bi where nonEmpty x _ [] = x diff --git a/Cabal/Distribution/Types/InstalledPackageInfo.hs b/Cabal/Distribution/Types/InstalledPackageInfo.hs index 008ac74dc57..6e4e247a6ac 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo.hs @@ -80,6 +80,7 @@ data InstalledPackageInfo depends :: [UnitId], abiDepends :: [AbiDependency], ccOptions :: [String], + cxxOptions :: [String], ldOptions :: [String], frameworkDirs :: [FilePath], frameworks :: [String], diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index b4a132f55ba..9b3279cb142 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -92,6 +92,7 @@ ipiFieldGrammar = mkInstalledPackageInfo <+> monoidalFieldAla "depends" (alaList FSep) L.depends <+> monoidalFieldAla "abi-depends" (alaList FSep) L.abiDepends <+> monoidalFieldAla "cc-options" (alaList' FSep Token) L.ccOptions + <+> monoidalFieldAla "cxx-options" (alaList' FSep Token) L.cxxOptions <+> monoidalFieldAla "ld-options" (alaList' FSep Token) L.ldOptions <+> monoidalFieldAla "framework-dirs" (alaList' FSep FilePathNT) L.frameworkDirs <+> monoidalFieldAla "frameworks" (alaList' FSep Token) L.frameworks diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs index 36609b01148..3896e07ef76 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -153,6 +153,10 @@ ccOptions :: Lens' InstalledPackageInfo [String] ccOptions f s = fmap (\x -> s { T.ccOptions = x }) (f (T.ccOptions s)) {-# INLINE ccOptions #-} +cxxOptions :: Lens' InstalledPackageInfo [String] +cxxOptions f s = fmap (\x -> s { T.cxxOptions = x }) (f (T.cxxOptions s)) +{-# INLINE cxxOptions #-} + ldOptions :: Lens' InstalledPackageInfo [String] ldOptions f s = fmap (\x -> s { T.ldOptions = x }) (f (T.ldOptions s)) {-# INLINE ldOptions #-} From 849d7ce5c5215c26bd9046704788d2eb8974862c Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Sat, 12 May 2018 09:20:00 -0400 Subject: [PATCH 2/9] Removing C++ flags getting passed to C compiler. --- Cabal/Distribution/Simple/GHC/Internal.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 2e2a6cf04dd..08adc9c117c 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -294,16 +294,6 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename = NormalDebugInfo -> ["-g"] MaximalDebugInfo -> ["-g3"]) ++ PD.ccOptions bi, - ghcOptCxxOptions = toNubListR $ - (case withOptimization lbi of - NoOptimisation -> [] - _ -> ["-O2"]) ++ - (case withDebugInfo lbi of - NoDebugInfo -> [] - MinimalDebugInfo -> ["-g1"] - NormalDebugInfo -> ["-g"] - MaximalDebugInfo -> ["-g3"]) ++ - PD.cxxOptions bi, ghcOptObjDir = toFlag odir } From 7396231597249b4820e8057f1392f0f6dccbbd99 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Sat, 12 May 2018 09:22:49 -0400 Subject: [PATCH 3/9] Correcting local variable name. --- Cabal/Distribution/Simple/GHC/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 08adc9c117c..a4ad7ead715 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -302,7 +302,7 @@ componentCxxGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> GhcOptions -componentCxxGhcOptions verbosity _implInfo lbi bi cxxlbi odir filename = +componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename = mempty { -- Respect -v0, but don't crank up verbosity on GHC if -- Cabal verbosity is requested. For that, use --ghc-option=-v instead! @@ -320,7 +320,7 @@ componentCxxGhcOptions verbosity _implInfo lbi bi cxxlbi odir filename = ++ [buildDir lbi dir | dir <- PD.includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages cxxlbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, ghcOptCxxOptions = toNubListR $ (case withOptimization lbi of NoOptimisation -> [] From e4730ec6a9a7226ee06a383b19d6aa3e863b6d90 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Sat, 12 May 2018 09:28:15 -0400 Subject: [PATCH 4/9] Correcting local variable name, again. --- Cabal/Distribution/Simple/GHC/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index a4ad7ead715..5e70fa93110 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -310,7 +310,7 @@ componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename = ghcOptMode = toFlag GhcModeCompile, ghcOptInputFiles = toNubListR [filename], - ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi cxxlbi + ghcOptCppIncludePath = toNubListR $ [autogenComponentModulesDir lbi clbi ,autogenPackageModulesDir lbi ,odir] -- includes relative to the package From e5836e3a5a18a80734bf86ff14fe630d18c73fa2 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Sat, 12 May 2018 10:19:56 -0400 Subject: [PATCH 5/9] Not supplying C++ options to hsc2hs & c2hs to prevernt erroneous warnings. --- Cabal/Distribution/Simple/PreProcess.hs | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index 30c740b4f1a..78e77df8bf9 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -424,7 +424,13 @@ ppHsc2hs bi lbi clbi = ++ [ "--cflag=-I" ++ buildDir lbi dir | dir <- PD.includeDirs bi ] ++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi ++ PD.cppOptions bi - ++ PD.cxxOptions bi ] + -- hsc2hs uses the C ABI + -- We assume that there are only C sources + -- and C++ functions are exported via a C + -- interface and wrapped in a C source file. + -- Therefore we do not supply C++ flags + -- because there will not be C++ sources + {- ++ PD.cxxOptions bi -} ] ++ [ "--cflag=" ++ opt | opt <- [ "-I" ++ autogenComponentModulesDir lbi clbi, "-I" ++ autogenPackageModulesDir lbi, @@ -440,7 +446,7 @@ ppHsc2hs bi lbi clbi = | pkg <- pkgs , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] ++ [ opt | opt <- Installed.ccOptions pkg - ++ Installed.cxxOptions pkg ] ] + {- ++ Installed.cxxOptions pkg -} ] ] ++ [ "--lflag=" ++ opt | pkg <- pkgs , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ] @@ -503,8 +509,15 @@ ppC2hs bi lbi clbi = ++ [ "--cppopts=" ++ opt | pkg <- pkgs , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] - ++ [ opt | opt@('-':c:_) <- (Installed.ccOptions pkg ++ - Installed.cxxOptions pkg) + ++ [ opt | opt@('-':c:_) <- Installed.ccOptions pkg + -- c2hs uses the C ABI + -- We assume that there are only C sources + -- and C++ functions are exported via a C + -- interface and wrapped in a C source file. + -- Therefore we do not supply C++ flags + -- because there will not be C++ sources + -- + -- ++ Installed.cxxOptions pkg , c `elem` "DIU" ] ] --TODO: install .chi files for packages, so we can --include -- those dirs here, for the dependencies From 1ca8d241730ba79593d8caa2433b7b0db71fdbbd Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Sat, 12 May 2018 14:11:54 -0400 Subject: [PATCH 6/9] Updating changelog, Adding test case for issue #5309 --- Cabal/ChangeLog.md | 5 + Cabal/Distribution/Simple/GHC.hs | 69 ++++- .../Types/InstalledPackageInfo.hs | 1 + Cabal/tests/CheckTests.hs | 2 + Cabal/tests/ParserTests/ipi/Includes2.expr | 1 + .../ipi/internal-preprocessor-test.expr | 1 + .../ParserTests/ipi/issue-2276-ghc-9885.expr | 1 + Cabal/tests/ParserTests/ipi/transformers.expr | 1 + .../cc-options-with-optimization.cabal | 15 + .../cc-options-with-optimization.check | 1 + .../cxx-options-with-optimization.cabal | 15 + .../cxx-options-with-optimization.check | 1 + .../PackageTests/Regression/T5309/T5309.cabal | 149 ++++++++++ .../PackageTests/Regression/T5309/app/Main.hs | 9 + .../PackageTests/Regression/T5309/cabal.out | 57 ++++ .../Regression/T5309/cabal.project | 2 + .../Regression/T5309/cabal.test.hs | 5 + .../lib/Bio/Character/Exportable/Class.hs | 56 ++++ .../Regression/T5309/lib/Data/TCM/Memoized.hs | 45 +++ .../T5309/lib/Data/TCM/Memoized/FFI.hsc | 280 ++++++++++++++++++ .../T5309/memoized-tcm/costMatrix.cpp | 93 ++++++ .../T5309/memoized-tcm/costMatrix.h | 201 +++++++++++++ .../T5309/memoized-tcm/costMatrixWrapper.c | 28 ++ .../T5309/memoized-tcm/costMatrixWrapper.h | 24 ++ .../memoized-tcm/dynamicCharacterOperations.c | 35 +++ .../memoized-tcm/dynamicCharacterOperations.h | 36 +++ 26 files changed, 1117 insertions(+), 16 deletions(-) create mode 100644 Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal create mode 100644 Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check create mode 100644 Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal create mode 100644 Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/T5309.cabal create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/app/Main.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/cabal.out create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/cabal.project create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/lib/Bio/Character/Exportable/Class.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized.hs create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized/FFI.hsc create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.cpp create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.h create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.c create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.c create mode 100644 cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.h diff --git a/Cabal/ChangeLog.md b/Cabal/ChangeLog.md index 334c6f3650f..783ffb6fd1d 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -20,6 +20,11 @@ `Distribution.Simple.Glob` and `FileGlob` has been made abstract. (#5284, #3178, et al.) + * Fixed `cxx-options` and `cxx-sources` buildinfo fields for + separate compilation of C++ source files to correctly build and link + non-library components (#5309). + * Reduced warnings generated by hsc2hs and c2hs when `cxx-options` field + is present in a component. ---- diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index c446327d8ad..3a68595ad5c 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -666,10 +666,10 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptObjSuffix = toFlag "p_o" } sharedCxxOpts = vanillaCxxOpts `mappend` mempty { - ghcOptFPic = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptObjSuffix = toFlag "dyn_o" - } + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } odir = fromFlag (ghcOptObjDir vanillaCxxOpts) createDirectoryIfMissingVerbose verbosity True odir let runGhcProgIfNeeded cxxOpts = do @@ -1083,12 +1083,27 @@ decodeMainIsArg arg -- 'tail' drops the char satisfying 'pred' where (r_suf, r_pre) = break pred' (reverse str) --- | Return C sources, GHC input files and GHC input modules + +-- | A collection of: +-- * C input files +-- * C++ input files +-- * GHC input files +-- * GHC input modules +-- +-- Used to correctly build and link sources. +data BuildSources = BuildSources { + cSourcesFiles :: [FilePath], + cxxSourceFiles :: [FilePath], + inputSourceFiles :: [FilePath], + inputSourceModules :: [ModuleName] + } + +-- | Locate and return the 'BuildSources' required to build and link. gbuildSources :: Verbosity -> Version -- ^ specVersion -> FilePath -> GBuildMode - -> IO ([FilePath], [FilePath], [FilePath], [ModuleName]) + -> IO BuildSources gbuildSources verbosity specVer tmpDir bm = case bm of GBuildExe exe -> exeSources exe @@ -1096,7 +1111,7 @@ gbuildSources verbosity specVer tmpDir bm = GBuildFLib flib -> return $ flibSources flib GReplFLib flib -> return $ flibSources flib where - exeSources :: Executable -> IO ([FilePath], [FilePath], [FilePath], [ModuleName]) + exeSources :: Executable -> IO BuildSources exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do main <- findFile (tmpDir : hsSourceDirs bnfo) modPath let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe @@ -1121,15 +1136,34 @@ gbuildSources verbosity specVer tmpDir bm = ++ display mainModName ++ "' listed in 'other-modules' illegally!" - return (cSources bnfo, cxxSources bnfo, [main], - filter (/= mainModName) (exeModules exe)) + return BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [main], + inputSourceModules = filter (/= mainModName) $ exeModules exe + } - else return (cSources bnfo, cxxSources bnfo, [main], exeModules exe) - else return (main : cSources bnfo, main : cxxSources bnfo, [], exeModules exe) + else return BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [main], + inputSourceModules = exeModules exe + } + else return BuildSources { + cSourcesFiles = main : cSources bnfo, + cxxSourceFiles = main : cxxSources bnfo, + inputSourceFiles = [], + inputSourceModules = exeModules exe + } - flibSources :: ForeignLib -> ([FilePath], [FilePath], [FilePath], [ModuleName]) + flibSources :: ForeignLib -> BuildSources flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = - (cSources bnfo, cxxSources bnfo, [], foreignLibModules flib) + BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [], + inputSourceModules = foreignLibModules flib + } isHaskell :: FilePath -> Bool isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] @@ -1168,10 +1202,13 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do | otherwise = mempty rpaths <- getRPaths lbi clbi - (cSrcs, cxxSrcs, inputFiles, inputModules) <- gbuildSources verbosity - (specVersion pkg_descr) tmpDir bm + buildSources <- gbuildSources verbosity (specVersion pkg_descr) tmpDir bm - let isGhcDynamic = isDynamic comp + let cSrcs = cSourcesFiles buildSources + cxxSrcs = cxxSourceFiles buildSources + inputFiles = inputSourceFiles buildSources + inputModules = inputSourceModules buildSources + isGhcDynamic = isDynamic comp dynamicTooSupported = supportsDynamicToo comp cObjs = map (`replaceExtension` objExtension) cSrcs cxxObjs = map (`replaceExtension` objExtension) cxxSrcs diff --git a/Cabal/Distribution/Types/InstalledPackageInfo.hs b/Cabal/Distribution/Types/InstalledPackageInfo.hs index 6e4e247a6ac..d95d86fdf7a 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo.hs @@ -160,6 +160,7 @@ emptyInstalledPackageInfo depends = [], abiDepends = [], ccOptions = [], + cxxOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], diff --git a/Cabal/tests/CheckTests.hs b/Cabal/tests/CheckTests.hs index 86a94d4d4ce..a4dabd5f847 100644 --- a/Cabal/tests/CheckTests.hs +++ b/Cabal/tests/CheckTests.hs @@ -33,6 +33,8 @@ checkTests = testGroup "regressions" , checkTest "pre-1.6-glob.cabal" , checkTest "pre-3.0-globstar.cabal" , checkTest "bad-glob-syntax.cabal" + , checkTest "cc-options-with-optimization.cabal" + , checkTest "cxx-options-with-optimization.cabal" ] checkTest :: FilePath -> TestTree diff --git a/Cabal/tests/ParserTests/ipi/Includes2.expr b/Cabal/tests/ParserTests/ipi/Includes2.expr index 6b76b3f560e..0d3a02d8d48 100644 --- a/Cabal/tests/ParserTests/ipi/Includes2.expr +++ b/Cabal/tests/ParserTests/ipi/Includes2.expr @@ -7,6 +7,7 @@ InstalledPackageInfo ccOptions = [], compatPackageKey = "Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n", copyright = "", + cxxOptions = [], dataDir = "/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2", depends = [`UnitId "base-4.10.1.0"`, `UnitId "Includes2-0.1.0.0-inplace-mysql"`], diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr index 6f9ecf21b1c..bc5ae42582d 100644 --- a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -6,6 +6,7 @@ InstalledPackageInfo ccOptions = [], compatPackageKey = "internal-preprocessor-test-0.1.0.0", copyright = "", + cxxOptions = [], dataDir = "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess", depends = [`UnitId "base-4.8.2.0-0d6d1084fbc041e1cded9228e80e264d"`], description = "See https://github.com/haskell/cabal/issues/1541#issuecomment-30155513", diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr index 0a867b53cf3..f39d1e71d41 100644 --- a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -6,6 +6,7 @@ InstalledPackageInfo ccOptions = [], compatPackageKey = "transformers-0.5.2.0", copyright = "", + cxxOptions = [], dataDir = "/opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0", depends = [`UnitId "base-4.10.1.0"`], description = concat diff --git a/Cabal/tests/ParserTests/ipi/transformers.expr b/Cabal/tests/ParserTests/ipi/transformers.expr index ba0830b148e..429883f3d38 100644 --- a/Cabal/tests/ParserTests/ipi/transformers.expr +++ b/Cabal/tests/ParserTests/ipi/transformers.expr @@ -4,6 +4,7 @@ InstalledPackageInfo author = "Andy Gill, Ross Paterson", category = "Control", ccOptions = [], + cxxOptions = [], compatPackageKey = "transformers-0.5.2.0", copyright = "", dataDir = "/opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0", diff --git a/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal new file mode 100644 index 00000000000..6eb8cec6814 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +category: test +description: test a build check involving C++-options field +license: BSD-3-Clause +maintainer: me@example.com +name: cxx-options-with-optimization +synopsis: test a build check +version: 1 + +library + build-depends: base >= 4.9 && <4.10 + cc-options: -O2 + default-language: Haskell2010 + exposed-modules: Prelude + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check new file mode 100644 index 00000000000..16cfdb25554 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check @@ -0,0 +1 @@ +'cc-options: -O[n]' is generally not needed. When building with optimisations Cabal automatically adds '-O2' for C code. Setting it yourself interferes with the --disable-optimization flag. diff --git a/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal new file mode 100644 index 00000000000..d081a5dd6fd --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +category: test +description: test a build check involving C++-options field +license: BSD-3-Clause +maintainer: me@example.com +name: cxx-options-with-optimization +synopsis: test a build check +version: 1 + +library + build-depends: base >= 4.9 && <4.10 + cxx-options: -O2 + default-language: Haskell2010 + exposed-modules: Prelude + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check new file mode 100644 index 00000000000..822bea388f5 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check @@ -0,0 +1 @@ +'cxx-options: -O[n]' is generally not needed. When building with optimisations Cabal automatically adds '-O2' for C++ code. Setting it yourself interferes with the --disable-optimization flag. diff --git a/cabal-testsuite/PackageTests/Regression/T5309/T5309.cabal b/cabal-testsuite/PackageTests/Regression/T5309/T5309.cabal new file mode 100644 index 00000000000..a19f4360c34 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/T5309.cabal @@ -0,0 +1,149 @@ +cabal-version: 2.2 +category: Example +build-type: Simple + +name: T5309 +version: 1.0.0.0 + +author: Alex Washburn +maintainer: github@recursion.ninja +copyright: 2018 Alex Washburn (recursion.ninja) + +synopsis: A binding to a C++ hashtable for thread-safe memoization. + +description: This package is designed to provide a "minimal working example" + to test the cxx-sources and the cxx-options buildinfo flags. + The code was pulled out PCG, https://github.com/amnh/pcg + + +common ffi-build-info + + -- We must provide the full relative path to every C file that the project depends on. + c-sources: memoized-tcm/costMatrixWrapper.c + memoized-tcm/dynamicCharacterOperations.c + + cc-options: --std=c11 + + cxx-sources: memoized-tcm/costMatrix.cpp + + cxx-options: --std=c++11 + + default-language: Haskell2010 + + -- This library is required for the C++ standard template library. + extra-libraries: stdc++ + + -- Here we list all directories that contain C header files that the FFI tools will need + -- to locate when preprocessing the C files. Without listing the directories containing + -- the C header files here, the FFI preprocession (hsc2hs, c2hs,etc.) will fail to locate + -- the requisite files. + -- Note also, that the parent directory of the nessicary C header files must be specified. + -- The preprocesser will not recursively look in subdirectories for C header files! + include-dirs: memoized-tcm + + +common language-spec + + build-depends: base >=4.5.1 +-- , lens + + default-language: Haskell2010 + + ghc-options: -O2 -Wall + + +common lib-build-info + + hs-source-dirs: lib + + -- Modules exported by the library. + other-modules: Bio.Character.Exportable.Class + Data.TCM.Memoized + Data.TCM.Memoized.FFI + + +library + + import: ffi-build-info + , language-spec + + -- Modules exported by the library. + exposed-modules: Bio.Character.Exportable.Class + Data.TCM.Memoized + Data.TCM.Memoized.FFI + + hs-source-dirs: lib + + +executable exe-no-lib + + import: ffi-build-info + , language-spec + , lib-build-info + + main-is: Main.hs + + hs-source-dirs: app + + +executable exe-with-lib + + import: language-spec + + main-is: Main.hs + + build-depends: T5309 + + hs-source-dirs: app + + +benchmark bench-no-lib + + import: ffi-build-info + , language-spec + , lib-build-info + + main-is: Main.hs + + type: exitcode-stdio-1.0 + + hs-source-dirs: app + + +benchmark bench-with-lib + + import: language-spec + + main-is: Main.hs + + type: exitcode-stdio-1.0 + + build-depends: T5309 + + hs-source-dirs: app + + +test-suite test-no-lib + + import: ffi-build-info + , language-spec + , lib-build-info + + main-is: Main.hs + + type: exitcode-stdio-1.0 + + hs-source-dirs: app + + +test-suite test-with-lib + + import: language-spec + + main-is: Main.hs + + type: exitcode-stdio-1.0 + + build-depends: T5309 + + hs-source-dirs: app diff --git a/cabal-testsuite/PackageTests/Regression/T5309/app/Main.hs b/cabal-testsuite/PackageTests/Regression/T5309/app/Main.hs new file mode 100644 index 00000000000..076ddb8062d --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/app/Main.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} + +module Main (main) where + +import Data.TCM.Memoized + + +main :: IO () +main = generateMemoizedTransitionCostMatrix 5 (const (const 1)) `seq` return () diff --git a/cabal-testsuite/PackageTests/Regression/T5309/cabal.out b/cabal-testsuite/PackageTests/Regression/T5309/cabal.out new file mode 100644 index 00000000000..0606b721819 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/cabal.out @@ -0,0 +1,57 @@ +# cabal new-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - T5309-1.0.0.0 (lib) (first run) + - T5309-1.0.0.0 (exe:exe-no-lib) (first run) + - T5309-1.0.0.0 (exe:exe-with-lib) (first run) +Configuring library for T5309-1.0.0.0.. +Preprocessing library for T5309-1.0.0.0.. +Building library for T5309-1.0.0.0.. +Configuring executable 'exe-no-lib' for T5309-1.0.0.0.. +Preprocessing executable 'exe-no-lib' for T5309-1.0.0.0.. +Building executable 'exe-no-lib' for T5309-1.0.0.0.. +Configuring executable 'exe-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Preprocessing executable 'exe-with-lib' for T5309-1.0.0.0.. +Building executable 'exe-with-lib' for T5309-1.0.0.0.. +# cabal new-test +Build profile: -w ghc- -O1 +In order, the following will be built: + - T5309-1.0.0.0 (test:test-no-lib) (first run) + - T5309-1.0.0.0 (test:test-with-lib) (first run) +Configuring test suite 'test-no-lib' for T5309-1.0.0.0.. +Preprocessing test suite 'test-no-lib' for T5309-1.0.0.0.. +Building test suite 'test-no-lib' for T5309-1.0.0.0.. +Running 1 test suites... +Test suite test-no-lib: RUNNING... +Test suite test-no-lib: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/T5309-1.0.0.0/t/test-no-lib/test/T5309-1.0.0.0-test-no-lib.log +1 of 1 test suites (1 of 1 test cases) passed. +Configuring test suite 'test-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Preprocessing test suite 'test-with-lib' for T5309-1.0.0.0.. +Building test suite 'test-with-lib' for T5309-1.0.0.0.. +Running 1 test suites... +Test suite test-with-lib: RUNNING... +Test suite test-with-lib: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/T5309-1.0.0.0/t/test-with-lib/test/T5309-1.0.0.0-test-with-lib.log +1 of 1 test suites (1 of 1 test cases) passed. +# cabal new-bench +Build profile: -w ghc- -O1 +In order, the following will be built: + - T5309-1.0.0.0 (bench:bench-no-lib) (first run) + - T5309-1.0.0.0 (bench:bench-with-lib) (first run) +Configuring benchmark 'bench-no-lib' for T5309-1.0.0.0.. +Preprocessing benchmark 'bench-no-lib' for T5309-1.0.0.0.. +Building benchmark 'bench-no-lib' for T5309-1.0.0.0.. +Running 1 benchmarks... +Benchmark bench-no-lib: RUNNING... +Benchmark bench-no-lib: FINISH +Configuring benchmark 'bench-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Preprocessing benchmark 'bench-with-lib' for T5309-1.0.0.0.. +Building benchmark 'bench-with-lib' for T5309-1.0.0.0.. +Running 1 benchmarks... +Benchmark bench-with-lib: RUNNING... +Benchmark bench-with-lib: FINISH diff --git a/cabal-testsuite/PackageTests/Regression/T5309/cabal.project b/cabal-testsuite/PackageTests/Regression/T5309/cabal.project new file mode 100644 index 00000000000..8834d04402a --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/cabal.project @@ -0,0 +1,2 @@ +packages: + ./ diff --git a/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs b/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs new file mode 100644 index 00000000000..24b7ebfed3b --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + cabal "new-build" ["all"] + cabal "new-test" ["all"] + cabal "new-bench" ["all"] diff --git a/cabal-testsuite/PackageTests/Regression/T5309/lib/Bio/Character/Exportable/Class.hs b/cabal-testsuite/PackageTests/Regression/T5309/lib/Bio/Character/Exportable/Class.hs new file mode 100644 index 00000000000..91186b433ae --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/lib/Bio/Character/Exportable/Class.hs @@ -0,0 +1,56 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Bio.Character.Exportable.Class +-- Copyright : (c) 2015-2015 Ward Wheeler +-- License : BSD-style +-- +-- Maintainer : wheeler@amnh.org +-- Stability : provisional +-- Portability : portable +-- +-- Class for needed operations of coded sequences and characters +-- +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses #-} + +module Bio.Character.Exportable.Class where + + +import Foreign.C.Types + + +-- | +-- Represents a sequence of fixed width characters packed into a bitwise form +-- consumable by lower level functions. +class Exportable c where + + toExportableBuffer :: c -> ExportableCharacterSequence + fromExportableBuffer :: ExportableCharacterSequence -> c + + toExportableElements :: c -> Maybe ExportableCharacterElements + fromExportableElements :: ExportableCharacterElements -> c + + +-- | +-- A structure used for FFI calls. +-- +-- 'bufferChunks' contains the bit-packed representation of the character sequence. +data ExportableCharacterSequence + = ExportableCharacterSequence + { exportedElementCountSequence :: Int + , exportedElementWidthSequence :: Int + , exportedBufferChunks :: [CULong] + } deriving (Eq, Show) + + +-- | +-- A structure used for FFI calls-- +-- 'characterElements' contains the integral value for each character element. +data ExportableCharacterElements + = ExportableCharacterElements + { exportedElementCountElements :: Int + , exportedElementWidthElements :: Int + , exportedCharacterElements :: [CUInt] + } deriving (Eq, Show) diff --git a/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized.hs b/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized.hs new file mode 100644 index 00000000000..fbe69a52dfe --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized.hs @@ -0,0 +1,45 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.TCM.Memoized +-- Copyright : (c) 2015-2015 Ward Wheeler +-- License : BSD-style +-- +-- Maintainer : wheeler@amnh.org +-- Stability : provisional +-- Portability : portable +-- +----------------------------------------------------------------------------- + +module Data.TCM.Memoized + ( FFI.MemoizedCostMatrix + , generateMemoizedTransitionCostMatrix + , FFI.getMedianAndCost + ) where + +import qualified Data.TCM.Memoized.FFI as FFI + + +-- | +-- /O(n^2)/ where @n@ is the alphabet size. +-- +-- Generate a memoized TCM by supplying the size of the symbol alphabet and the +-- generating function for unambiguous symbol change cost to produce a memoized +-- TCM. A memoized TCM computes all the costs and medians of unambiguous, +-- singleton symbol set transitions strictly when this function is invoked. A +-- memoized TCM calculates the cost and medians of ambiguous symbol sets in a +-- lazy, memoized manner. +-- +-- *Note:* The collection of ambiguous symbols set transitions is the powerset of +-- the collection of unambiguous, singleton symbol sets. The lazy, memoization is +-- a requisite for efficient computation on any non-trivial alphabet size. +generateMemoizedTransitionCostMatrix + :: Word -- ^ Alphabet size + -> (Word -> Word -> Word) -- ^ Generating function + -> FFI.MemoizedCostMatrix +generateMemoizedTransitionCostMatrix = FFI.getMemoizedCostMatrix + +{- +-- Causes ambiguity with Data.TCM.(!) +(!) :: Exportable s => FFI.MemoizedCostMatrix -> (s, s) -> (s, Word) +(!) memo (x,y) = FFI.getMedianAndCost memo x y +-} diff --git a/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized/FFI.hsc b/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized/FFI.hsc new file mode 100644 index 00000000000..2a96ba7851d --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/lib/Data/TCM/Memoized/FFI.hsc @@ -0,0 +1,280 @@ +----------------------------------------------------------------------------- +-- | +-- TODO: Document module. +-- +-- Exports C types for dynamic characters and their constructors allong with +-- an FFI binding for the memoizing TCM structure. +----------------------------------------------------------------------------- + +{-# LANGUAGE BangPatterns, DeriveGeneric, FlexibleInstances, ForeignFunctionInterface, TypeSynonymInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.TCM.Memoized.FFI + ( CBufferUnit + , CDynamicChar(..) + , DCElement(..) + , ForeignVoid() + , MemoizedCostMatrix(costMatrix) + , getMemoizedCostMatrix + , getMedianAndCost + -- * Utility functions + , calculateBufferLength + , coerceEnum + , constructCharacterFromExportable + , constructElementFromExportable + , constructEmptyElement + ) where + +import Bio.Character.Exportable.Class +import Data.Bits +import Foreign hiding (alignPtr) +import Foreign.C.Types +import GHC.Generics (Generic) +import System.IO.Unsafe + +-- import Debug.Trace + +#include "costMatrixWrapper.h" +#include "dynamicCharacterOperations.h" + + +-- | +-- A convient type alias for improved clairity of use. +type CBufferUnit = CULong -- This will be compatible with uint64_t + + +-- | +-- Type of a dynamic character to pass back and forth across the FFI interface. +data CDynamicChar + = CDynamicChar + { alphabetSizeChar :: CSize + , numElements :: CSize + , dynCharLen :: CSize + , dynChar :: Ptr CBufferUnit + } + + +-- | +-- Represents a single element in a dynamic character in an exportable form. +data DCElement = DCElement + { alphabetSizeElem :: CSize + , characterElement :: Ptr CBufferUnit + } deriving (Show) + + +-- | +-- A closed type wrapping a void pointer in C to the C++ memoized TCM. +data ForeignVoid deriving (Generic) + + +-- | +-- A type-safe wrapper for the mutable, memoized TCm. +newtype MemoizedCostMatrix + = MemoizedCostMatrix + { costMatrix :: StablePtr ForeignVoid + } deriving (Eq, Generic) + + +{- +-- | (✔) +instance Show CDynamicChar where + show (CDynamicChar alphSize dcLen numElems dChar) = + mconcat + ["alphabetSize: " + , show intAlphSize + , "\ndynCharLen: " + , show intLen + , "\nbuffer length: " + , show bufferLength + , "\ndynChar: " + , show $ unsafePerformIO printedArr + ] + where + bufferLength = fromEnum numElems + intAlphSize = fromEnum alphSize + intLen = fromEnum dcLen + printedArr = show <$> peekArray bufferLength dChar + +-} + + +instance Storable CDynamicChar where + + sizeOf _ = (#size struct dynChar_t) -- #size is a built-in that works with arrays, as are #peek and #poke, below + + alignment _ = alignment (undefined :: CBufferUnit) + + peek ptr = do -- to get values from the C app + alphLen <- (#peek struct dynChar_t, alphSize ) ptr + nElems <- (#peek struct dynChar_t, numElems ) ptr + seqLen <- (#peek struct dynChar_t, dynCharLen) ptr + seqVal <- (#peek struct dynChar_t, dynChar ) ptr + pure CDynamicChar + { alphabetSizeChar = alphLen + , numElements = nElems + , dynCharLen = seqLen + , dynChar = seqVal + } + + poke ptr (CDynamicChar alphLen nElems seqLen seqVal) = do -- to modify values in the C app + (#poke struct dynChar_t, alphSize ) ptr alphLen + (#poke struct dynChar_t, numElems ) ptr nElems + (#poke struct dynChar_t, dynCharLen) ptr seqLen + (#poke struct dynChar_t, dynChar ) ptr seqVal + + +-- | (✔) +instance Storable DCElement where + + sizeOf _ = (#size struct dcElement_t) + + alignment _ = alignment (undefined :: CBufferUnit) + + peek ptr = do + alphLen <- (#peek struct dcElement_t, alphSize) ptr + element <- (#peek struct dcElement_t, element ) ptr + pure DCElement + { alphabetSizeElem = alphLen + , characterElement = element + } + + poke ptr (DCElement alphLen element) = do + (#poke struct dcElement_t, alphSize) ptr alphLen + (#poke struct dcElement_t, element ) ptr element + + + +-- TODO: For now we only allocate 2d matrices. 3d will come later. +-- | +-- Create and allocate cost matrix. +-- The first argument, TCM, is only for non-ambiguous nucleotides, and it used to +-- generate the entire cost matrix, which includes ambiguous elements. TCM is +-- row-major, with each row being the left character element. It is therefore +-- indexed not by powers of two, but by cardinal integer. +foreign import ccall unsafe "costMatrixWrapper matrixInit" + initializeMemoizedCMfn_c :: CSize + -> Ptr CInt + -> IO (StablePtr ForeignVoid) + + +foreign import ccall unsafe "costMatrix getCostAndMedian" + getCostAndMedianFn_c :: Ptr DCElement + -> Ptr DCElement + -> Ptr DCElement +-- -> CSize + -> StablePtr ForeignVoid + -> IO CInt + + +-- | +-- Set up and return a cost matrix. +-- +-- The cost matrix is allocated strictly. +getMemoizedCostMatrix :: Word + -> (Word -> Word -> Word) + -> MemoizedCostMatrix +getMemoizedCostMatrix alphabetSize costFn = unsafePerformIO . withArray rowMajorList $ \allocedTCM -> do + !resultPtr <- initializeMemoizedCMfn_c (coerceEnum alphabetSize) allocedTCM + pure $ MemoizedCostMatrix resultPtr + where + rowMajorList = [ coerceEnum $ costFn i j | i <- range, j <- range ] + range = [0 .. alphabetSize - 1] + + +-- | +-- /O(1)/ amortized. +-- +-- Calculate the median symbol set and transition cost between the two input +-- symbol sets. +-- +-- *Note:* This operation is lazily evaluated and memoized for future calls. +getMedianAndCost :: Exportable s => MemoizedCostMatrix -> s -> s -> (s, Word) +getMedianAndCost memo lhs rhs = unsafePerformIO $ do + medianPtr <- constructEmptyElement alphabetSize + lhs' <- constructElementFromExportable lhs + rhs' <- constructElementFromExportable rhs + !cost <- getCostAndMedianFn_c lhs' rhs' medianPtr (costMatrix memo) + medianElement <- peek medianPtr + medianValue <- fmap buildExportable . peekArray bufferLength $ characterElement medianElement + pure (medianValue, coerceEnum cost) + where + alphabetSize = exportedElementWidthSequence $ toExportableBuffer lhs + buildExportable = fromExportableBuffer . ExportableCharacterSequence 1 alphabetSize + bufferLength = calculateBufferLength alphabetSize 1 + + +-- | +-- /O(1)/ +-- +-- Calculate the buffer length based on the element count and element bit width. +calculateBufferLength :: Enum b + => Int -- ^ Element count + -> Int -- ^ Element bit width + -> b +calculateBufferLength count width = coerceEnum $ q + if r == 0 then 0 else 1 + where + (q,r) = (count * width) `divMod` finiteBitSize (undefined :: CULong) + + +-- | +-- Coerce one 'Enum' value to another through the type's corresponding 'Int' +-- values. +coerceEnum :: (Enum a, Enum b) => a -> b +coerceEnum = toEnum . fromEnum + + +-- | +-- /O(n)/ where @n@ is the length of the dynamic character. +-- +-- Malloc and populate a pointer to an exportable representation of the +-- 'Exportable' value. The supplied value is assumed to be a dynamic character +-- and the result is a pointer to a C representation of a dynamic character. +constructCharacterFromExportable :: Exportable s => s -> IO (Ptr CDynamicChar) +constructCharacterFromExportable exChar = do + valueBuffer <- newArray $ exportedBufferChunks exportableBuffer + charPointer <- malloc :: IO (Ptr CDynamicChar) + let charValue = CDynamicChar (coerceEnum width) (coerceEnum count) bufLen valueBuffer + !_ <- poke charPointer charValue + pure charPointer + where + count = exportedElementCountSequence exportableBuffer + width = exportedElementWidthSequence exportableBuffer + bufLen = calculateBufferLength count width + exportableBuffer = toExportableBuffer exChar + + +-- | +-- /O(1)/ +-- +-- Malloc and populate a pointer to an exportable representation of the +-- 'Exportable' value. The supplied value is assumed to be a dynamic character +-- element and the result is a pointer to a C representation of a dynamic +-- character element. +constructElementFromExportable :: Exportable s => s -> IO (Ptr DCElement) +constructElementFromExportable exChar = do + valueBuffer <- newArray $ exportedBufferChunks exportableBuffer + elementPointer <- malloc :: IO (Ptr DCElement) + let elementValue = DCElement (coerceEnum width) valueBuffer + !_ <- poke elementPointer elementValue + pure elementPointer + where + width = exportedElementWidthSequence exportableBuffer + exportableBuffer = toExportableBuffer exChar + + +-- | +-- /O(1)/ +-- +-- Malloc and populate a pointer to a C representation of a dynamic character. +-- The buffer of the resulting value is intentially zeroed out. +constructEmptyElement :: Int -- ^ Bit width of a dynamic character element. + -> IO (Ptr DCElement) +constructEmptyElement alphabetSize = do + elementPointer <- malloc :: IO (Ptr DCElement) + valueBuffer <- mallocArray bufferLength + let elementValue = DCElement (coerceEnum alphabetSize) valueBuffer + !_ <- poke elementPointer elementValue + pure elementPointer + where + bufferLength = calculateBufferLength alphabetSize 1 diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.cpp b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.cpp new file mode 100644 index 00000000000..c85fa58c8b4 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.cpp @@ -0,0 +1,93 @@ +#include + +/* +#include +#include +#include +*/ + +#include "costMatrix.h" +#include "dynamicCharacterOperations.h" +#include //for memcpy; + +#define __STDC_FORMAT_MACROS + +// TODO: I'll need this for the Haskell side of things: https://hackage.haskell.org/package/base-4.9.0.0/docs/Foreign-StablePtr.html + +costMatrix_p construct_CostMatrix_C(size_t alphSize, int* tcm) { + return new CostMatrix(alphSize, tcm); +} + +void destruct_CostMatrix_C(costMatrix_p untyped_self) { + delete static_cast (untyped_self); +} + +int call_getSetCost_C(costMatrix_p untyped_self, dcElement_t* left, dcElement_t* right, dcElement_t* retMedian) { + + CostMatrix* thisMtx = static_cast (untyped_self); + return thisMtx->getSetCostMedian(left, right, retMedian); +} + + +void freeCostMedian_t (costMedian_t* toFree) { + free(toFree->second); +} + +CostMatrix::CostMatrix(size_t alphSize, int* inTcm) { + alphabetSize = alphSize; + size_t space = alphabetSize * alphabetSize * sizeof(int); + tcm = (int*) malloc(space); + memcpy(tcm, inTcm, space); + initializeMatrix(); +} + +CostMatrix::~CostMatrix() { + for ( auto& thing: myMatrix ) { + freeCostMedian_t(&thing.second); + } + myMatrix.clear(); + hasher.clear(); + +} + +int CostMatrix::getCostMedian(dcElement_t* left, dcElement_t* right, dcElement_t* retMedian) { + keys_t toLookup; + toLookup.first = *left; + toLookup.second = *right; + mapIterator found; + int foundCost; + + found = myMatrix.find(toLookup); + + if ( found == myMatrix.end() ) { + return -1; + } else { + foundCost = found->second.first; + retMedian->element = found->second.second; + } + + return foundCost; +} + +int CostMatrix::getSetCostMedian(dcElement_t* left, dcElement_t* right, dcElement_t* retMedian) { + keys_t* toLookup = (keys_t*) malloc( sizeof(keys_t) ); + toLookup->first = *left; + toLookup->second = *right; + mapIterator found; + int foundCost; + + found = myMatrix.find(*toLookup); + + if ( found == myMatrix.end() ) { + foundCost = 0; + } else { + foundCost = found->second.first; + } + return foundCost; +} + +void CostMatrix::initializeMatrix () { ; } + +void CostMatrix::setValue(keys_t* key, costMedian_t* median) { + myMatrix.insert(std::make_pair(*key, *median)); +} diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.h b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.h new file mode 100644 index 00000000000..a7f1bc25e82 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrix.h @@ -0,0 +1,201 @@ +/** costMatrix object to provide for a memoizable cost lookup table. Table is indexed by two + * dcElement values, and returns an int, for the cost. In addition, an additional dcElement + * is passed in by reference, and the median value of the two input elements is placed there. + * The getCost function is designed to interface directly with C. + * + * The key lookup is an ordered pair, so when looking up transition a -> b, a must go in as + * first in pair + * + * WARNING: In the interest of speed this code does no "type checking" to make sure that the + * two passed deElements are of the same type, i.e. that they have the same alphabet length. + * Any such checks should be done exterior to this library. + */ + +#ifndef _COSTMATRIX_H +#define _COSTMATRIX_H + +#define DEBUG 0 + +#include +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#include "dynamicCharacterOperations.h" + +/** Next three fns defined here to use on C side. */ +costMatrix_p construct_CostMatrix_C (size_t alphSize, int* tcm); + +void destruct_CostMatrix_C (costMatrix_p mytype); + +int call_getSetCost_C (costMatrix_p untyped_self, dcElement_t* left, dcElement_t* right, dcElement_t* retMedian); + +#ifdef __cplusplus +} +#endif + +typedef std::pair keys_t; +typedef std::pair costMedian_t; +typedef std::pair mapAccessPair_t; + +typedef void* costMatrix_p; + +/** Allocate room for a costMedian_t. Assumes alphabetSize is already initialized. */ +costMedian_t* allocCostMedian_t (size_t alphabetSize); + +/** dealloc costMedian_t. */ +void freeCostMedian_t (costMedian_t* toFree); + +/** Allocate room for a keys_t. */ +keys_t* allocKeys_t (size_t alphSize); + +/** dealloc keys_t. Calls various other free fns. */ +void freeKeys_t (const keys_t* toFree); + +/** Allocate space for Pair, calling allocators for both types. */ +mapAccessPair_t* allocateMapAccessPair (size_t alphSize); + +/** Hashes two `dcElement`s, and returns an order-dependent hash value. In this case + * "order dependent" means that the order of the arrays within the `dcElement`s matter, + * and the order that the `dcElement`s are sent in also matters, as is necessary for a + * non-symmetric tcm. + * + * First loops through each `dcElement` and combines all of the element values (recall that a + * `dcElement` has two fields, the second of which is the element, and is an array of `uint64_t`s) + * using two different seeds, then combines the two resulting values. + */ +struct KeyHash { + /** Following hash_combine code modified from here (seems to be based on Boost): + * http://stackoverflow.com/questions/2590677/how-do-i-combine-hash-values-in-c0x + */ + std::size_t hash_combine (const dcElement_t lhs, const dcElement_t rhs) const { + std::size_t left_seed = 3141592653; // PI used as arbitrarily random seed + std::size_t right_seed = 2718281828; // E used as arbitrarily random seed + + std::hash hasher; + size_t elemArrCount = dcElemSize(lhs.alphSize); + for (size_t i = 0; i < elemArrCount; i++) { + left_seed ^= hasher(lhs.element[i]) + 0x9e3779b9 + (left_seed << 6) + (left_seed >> 2); + right_seed ^= hasher(rhs.element[i]) + 0x9e3779b9 + (right_seed << 6) + (right_seed >> 2); + } + left_seed ^= hasher(right_seed) + 0x9e3779b9 + (left_seed << 6) + (left_seed >> 2); + return left_seed; + } + + std::size_t operator()(const keys_t& k) const + { + return hash_combine (k.first, k.second); + } +}; + +struct KeyEqual { + // Return true if every `uint64_t` in lhs->element and rhs->element is equal, else false. + bool operator()(const keys_t& lhs, const keys_t& rhs) const + { + // Assert that all key components share the same alphSize value + if ( lhs.first.alphSize != rhs.first.alphSize + || lhs.first.alphSize != lhs.second.alphSize + || lhs.second.alphSize != rhs.second.alphSize) { + return false; + } + + //Assert that the left key elements match the right key elements + size_t elemArrWidth = dcElemSize(lhs.first.alphSize); + for (size_t i = 0; i < elemArrWidth; i++) { + if (lhs.first.element[i] != rhs.first.element[i]) { + return false; + } + if (lhs.second.element[i] != rhs.second.element[i]) { + return false; + } + } + return true; + } +}; + +typedef std::unordered_map::const_iterator mapIterator; + + +class CostMatrix +{ + public: +// CostMatrix(); + + CostMatrix(size_t alphSize, int* tcm); + + ~CostMatrix(); + + /** Getter only for cost. Necessary for testing, to insure that particular + * key pair has, in fact, already been inserted into lookup table. + */ + int getCostMedian(dcElement_t* left, dcElement_t* right, dcElement_t* retMedian); + + /** Acts as both a setter and getter, mutating myMap. + * + * Receives two dcElements and computes the transformation cost as well as + * the median for the two. Puts the median and alphabet size into retMedian, + * which must therefore by necessity be allocated elsewhere. + * + * This functin allocates _if necessary_. So freeing inputs after a call will not + * cause invalid reads from the cost matrix. + */ + int getSetCostMedian(dcElement_t* left, dcElement_t* right, dcElement_t* retMedian); + + private: + std::unordered_map myMatrix; + + std::unordered_map hasher; + + size_t alphabetSize; + + /** Stored unambiguous tcm, necessary to do first calls to findDistance() without having to rewrite findDistance() + * and computeCostMedian() + */ + int *tcm; + + /** Takes in a `keys_t` and a `costMedian_t` and updates myMap to store the new values, + * with @key as a key, and @median as the value. + */ + void setValue(keys_t* key, costMedian_t* median); + + /** Takes in a pair of keys_t (each of which is a single `dcElement`) and computes their lowest-cost median. + * Uses a Sankoff-like algorithm, where all bases are considered, and the lowest cost bases are included in the + * cost and median calculations. That means a base might appear in the median that is not present in either of + * the two elements being compared. + */ + costMedian_t* computeCostMedian(keys_t key); + + /** Find distance between an ambiguous nucleotide and an unambiguous ambElem. Return that value and the median. + * @param ambElem is ambiguous input. + * @param nucleotide is unambiguous. + * @param median is used to return the calculated median value. + * + * This fn is necessary because there isn't yet a cost matrix set up, so it's not possible to + * look up ambElems, therefore we must loop over possible values of the ambElem + * and find the lowest cost median. + * + * Nota bene: Requires symmetric, if not metric, matrix. TODO: Is this true? If so fix it? + */ + int findDistance (keys_t* searchKey, dcElement_t* ambElem); + + /** Takes in an initial TCM, which is actually just a row-major array, creates hash table of costs + * where cost is least cost between two elements, and medians, where median is union of characters. + * + * Nota bene: + * Can only be called once this.alphabetSize has been set. + */ + void initializeMatrix (); + + // DEPRECATED!!! + /** Takes in a pair of keys_t (each of which is a single `dcElement`) and computes their lowest-cost median. + * Contrast with computeCostMedian(). In this algorithm only bases which are present in at least one of + * the two elements being compared are considered. + */ + /* costMedian_t* computeCostMedianFitchy(keys_t keys); */ + +}; + +#endif // COSTMATRIX_H diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.c b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.c new file mode 100644 index 00000000000..72fe9bd7391 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.c @@ -0,0 +1,28 @@ +#include +#include + +#include "costMatrixWrapper.h" +#include "dynamicCharacterOperations.h" + +costMatrix_p matrixInit(size_t alphSize, int *tcm) { + return (costMatrix_p) construct_CostMatrix_C(alphSize, tcm); +} + +void matrixDestroy(costMatrix_p untyped_ptr) { + destruct_CostMatrix_C(untyped_ptr); +} + +int getCostAndMedian(dcElement_t *elem1, dcElement_t *elem2, dcElement_t *retElem, costMatrix_p tcm) { + size_t alphSize = elem1->alphSize; + dcElement_t *elem1copy = (dcElement_t *) malloc(sizeof(dcElement_t)); + elem1copy->alphSize = alphSize; + dcElement_t *elem2copy = (dcElement_t *) malloc(sizeof(dcElement_t)); + elem2copy->alphSize = alphSize; + + elem1copy->element = makePackedCharCopy( elem1->element, alphSize, 1 ); + elem2copy->element = makePackedCharCopy( elem2->element, alphSize, 1 ); + + int cost = call_getSetCost_C(tcm, elem1copy, elem2copy, retElem); + + return cost; +} diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h new file mode 100644 index 00000000000..f592347dd6e --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/costMatrixWrapper.h @@ -0,0 +1,24 @@ +#ifndef _COST_MATRIX_WRAPPER_H +#define _COST_MATRIX_WRAPPER_H + +#include + +#include "dynamicCharacterOperations.h" + +/** Initialize a matrix (fill in all values for non-ambiguous chracter transition costs) using a TCM sent in from an outside source. */ +costMatrix_p matrixInit(size_t alphSize, int *tcm); + +/** C wrapper for cpp destructor */ +void matrixDestroy(costMatrix_p untyped_ptr); + +/** Like getCost, but also returns a pointer to a median value. */ +int getCostAndMedian(dcElement_t *elem1, dcElement_t *elem2, dcElement_t *retElem, costMatrix_p tcm); + +/** Following three fns are C references to cpp functions found in costMatrix.cpp */ +costMatrix_p construct_CostMatrix_C(size_t alphSize, int *tcm); + +void destruct_CostMatrix_C(costMatrix_p mytype); + +int call_getSetCost_C(costMatrix_p untyped_self, dcElement_t *left, dcElement_t *right, dcElement_t *retMedian); + +#endif // _COST_MATRIX_WRAPPER_H diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.c b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.c new file mode 100644 index 00000000000..26b1b418c59 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.c @@ -0,0 +1,35 @@ +#include +#include +#include +#include + +#include "dynamicCharacterOperations.h" + +#define __STDC_FORMAT_MACROS + +size_t dynCharSize(size_t alphSize, size_t numElems) { return 1; } + +size_t dcElemSize(size_t alphSize) { return 1; } + +packedChar *allocatePackedChar( size_t alphSize, size_t numElems ) { + packedChar *outChar = (packedChar*) calloc( dynCharSize(alphSize, numElems), sizeof(packedChar) ); + if (outChar == NULL) { + printf("Out of memory.\n"); + fflush(stdout); + exit(1); + } + return outChar; +} + +packedChar *makePackedCharCopy( packedChar *inChar, size_t alphSize, size_t numElems) { + packedChar *outChar = allocatePackedChar(alphSize, numElems); + size_t length = dynCharSize(alphSize, numElems); + for (size_t i = 0; i < length; i++) { + outChar[i] = inChar[i]; + } + return outChar; +} + +void freeDynChar( dynChar_t *p ) { free( p->dynChar ); } + +void freeDCElem( const dcElement_t *p ) { free( p->element ); } diff --git a/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.h b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.h new file mode 100644 index 00000000000..4648772c796 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/T5309/memoized-tcm/dynamicCharacterOperations.h @@ -0,0 +1,36 @@ +#ifndef DYNAMIC_CHARACTER_OPERATIONS +#define DYNAMIC_CHARACTER_OPERATIONS + +#include +#include +#include +#include + +typedef uint64_t packedChar; +typedef void *costMatrix_p; + +typedef struct dynChar_t { + size_t alphSize; + size_t numElems; // how many dc elements are stored + size_t dynCharLen; // how many uint64_ts are necessary to store the elements + packedChar *dynChar; +} dynChar_t; + +typedef struct dcElement_t { + size_t alphSize; + packedChar *element; +} dcElement_t; + +size_t dynCharSize(size_t alphSize, size_t numElems); + +size_t dcElemSize(size_t alphSize); + +void freeDynChar( dynChar_t *p ); + +void freeDCElem( const dcElement_t *p ); + +packedChar *allocatePackedChar( size_t alphSize, size_t numElems ); + +packedChar *makePackedCharCopy( packedChar *inChar, size_t alphSize, size_t numElems ); + +#endif /* DYNAMIC_CHARACTER_OPERATIONS */ From 082efbe234a0b9a23d894b6cab2b32bdbb2635d3 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Thu, 24 May 2018 08:51:57 -0400 Subject: [PATCH 7/9] Adding extra sources to .cabal file --- Cabal/Cabal.cabal | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 2154fa8b03c..930cc6f0933 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -75,12 +75,16 @@ extra-source-files: tests/ParserTests/regressions/Octree-0.5.format tests/ParserTests/regressions/bad-glob-syntax.cabal tests/ParserTests/regressions/bad-glob-syntax.check + tests/ParserTests/regressions/cc-options-with-optimization.cabal + tests/ParserTests/regressions/cc-options-with-optimization.check tests/ParserTests/regressions/common.cabal tests/ParserTests/regressions/common.expr tests/ParserTests/regressions/common.format tests/ParserTests/regressions/common2.cabal tests/ParserTests/regressions/common2.expr tests/ParserTests/regressions/common2.format + tests/ParserTests/regressions/cxx-options-with-optimization.cabal + tests/ParserTests/regressions/cxx-options-with-optimization.check tests/ParserTests/regressions/elif.cabal tests/ParserTests/regressions/elif.expr tests/ParserTests/regressions/elif.format From cd4e9a95c416a5c6ba21298b15d12f1ebe88c208 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Thu, 24 May 2018 10:24:19 -0400 Subject: [PATCH 8/9] Correcting whitespace/alignment issues. Adding main source in more principled manner. --- Cabal/Distribution/Simple/GHC.hs | 30 ++++++++++++++++--------- Cabal/Distribution/Simple/PreProcess.hs | 14 +++++++----- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 3a68595ad5c..030a48c9661 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -1138,29 +1138,36 @@ gbuildSources verbosity specVer tmpDir bm = return BuildSources { cSourcesFiles = cSources bnfo, - cxxSourceFiles = cxxSources bnfo, + cxxSourceFiles = cxxSources bnfo, inputSourceFiles = [main], inputSourceModules = filter (/= mainModName) $ exeModules exe } else return BuildSources { cSourcesFiles = cSources bnfo, - cxxSourceFiles = cxxSources bnfo, + cxxSourceFiles = cxxSources bnfo, inputSourceFiles = [main], inputSourceModules = exeModules exe } - else return BuildSources { - cSourcesFiles = main : cSources bnfo, - cxxSourceFiles = main : cxxSources bnfo, - inputSourceFiles = [], - inputSourceModules = exeModules exe - } + else let (csf, cxxsf) + | isCxx main = ( cSources bnfo, main : cxxSources bnfo) + -- if main is not a Haskell source + -- and main is not a C++ source + -- then we assume that it is a C source + | otherwise = (main : cSources bnfo, cxxSources bnfo) + + in return BuildSources { + cSourcesFiles = csf, + cxxSourceFiles = cxxsf, + inputSourceFiles = [], + inputSourceModules = exeModules exe + } flibSources :: ForeignLib -> BuildSources flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = BuildSources { - cSourcesFiles = cSources bnfo, - cxxSourceFiles = cxxSources bnfo, + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, inputSourceFiles = [], inputSourceModules = foreignLibModules flib } @@ -1168,6 +1175,9 @@ gbuildSources verbosity specVer tmpDir bm = isHaskell :: FilePath -> Bool isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] + isCxx :: FilePath -> Bool + isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"] + -- | Generic build function. See comment for 'GBuildMode'. gbuild :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index 78e77df8bf9..7fea770db21 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -429,8 +429,10 @@ ppHsc2hs bi lbi clbi = -- and C++ functions are exported via a C -- interface and wrapped in a C source file. -- Therefore we do not supply C++ flags - -- because there will not be C++ sources - {- ++ PD.cxxOptions bi -} ] + -- because there will not be C++ sources. + -- + -- DO NOT add PD.cxxOptions unless this changes! + ] ++ [ "--cflag=" ++ opt | opt <- [ "-I" ++ autogenComponentModulesDir lbi clbi, "-I" ++ autogenPackageModulesDir lbi, @@ -445,8 +447,7 @@ ppHsc2hs bi lbi clbi = ++ [ "--cflag=" ++ opt | pkg <- pkgs , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] - ++ [ opt | opt <- Installed.ccOptions pkg - {- ++ Installed.cxxOptions pkg -} ] ] + ++ [ opt | opt <- Installed.ccOptions pkg ] ] ++ [ "--lflag=" ++ opt | pkg <- pkgs , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ] @@ -515,9 +516,10 @@ ppC2hs bi lbi clbi = -- and C++ functions are exported via a C -- interface and wrapped in a C source file. -- Therefore we do not supply C++ flags - -- because there will not be C++ sources + -- because there will not be C++ sources. -- - -- ++ Installed.cxxOptions pkg + -- + -- DO NOT add Installed.cxxOptions unless this changes! , c `elem` "DIU" ] ] --TODO: install .chi files for packages, so we can --include -- those dirs here, for the dependencies From 3f8c55ce7457408f31dbc5dc6d6be6fd7a84c501 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Thu, 24 May 2018 10:49:23 -0400 Subject: [PATCH 9/9] Adding TODOs regarding more robust build proceedures [skip ci] --- Cabal/Distribution/Simple/GHC.hs | 4 ++++ Cabal/Distribution/Simple/PreProcess.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 030a48c9661..7b5bbfd94f2 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -1352,6 +1352,10 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do opts | needProfiling = profCxxOpts | needDynamic = sharedCxxOpts | otherwise = vanillaCxxOpts + -- TODO: Placing all Haskell, C, & C++ objects in a single directory + -- Has the potential for file collisions. In general we would + -- consider this a user error. However, we should strive to + -- add a warning if this occurs. odir = fromFlag (ghcOptObjDir opts) createDirectoryIfMissingVerbose verbosity True odir needsRecomp <- checkNeedsRecompilation filename opts diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index 7fea770db21..83920f0e0a8 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -538,6 +538,9 @@ ppC2hsExtras d = filter (\p -> takeExtensions p == ".chs.c") `fmap` --TODO: perhaps use this with hsc2hs too --TODO: remove cc-options from cpphs for cabal-version: >= 1.10 +--TODO: Refactor and add seperate getCppOptionsForHs, getCppOptionsForCxx, & getCppOptionsForC +-- instead of combining all these cases in a single function. This blind combination can +-- potentially lead to compilation inconsistencies. getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] getCppOptions bi lbi = platformDefines lbi