diff --git a/llvm-general.cabal b/llvm-general.cabal --- a/llvm-general.cabal +++ b/llvm-general.cabal @@ -1,5 +1,5 @@ name: llvm-general -version: 3.3.14.4 +version: 3.3.15.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -39,7 +39,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3 - tag: v3.3.14.4 + tag: v3.3.15.0 flag shared-llvm description: link against llvm shared rather than static library @@ -53,7 +53,7 @@ build-tools: llvm-config ghc-options: -fwarn-unused-imports build-depends: - base >= 4.5.0.0 && < 5, + base >= 4.6 && < 5, utf8-string >= 0.3.7, bytestring >= 0.9.1.10, transformers >= 0.3.0.0, @@ -199,13 +199,13 @@ test-suite test type: exitcode-stdio-1.0 build-depends: - base >= 3 && < 5, + base >= 4.6 && < 5, test-framework >= 0.5, test-framework-hunit >= 0.2.7, HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1, - llvm-general == 3.3.14.4, + llvm-general == 3.3.15.0, llvm-general-pure == 3.3.14.4, containers >= 0.4.2.1, mtl >= 2.1, diff --git a/src/LLVM/General/Internal/FFI/TargetC.cpp b/src/LLVM/General/Internal/FFI/TargetC.cpp --- a/src/LLVM/General/Internal/FFI/TargetC.cpp +++ b/src/LLVM/General/Internal/FFI/TargetC.cpp @@ -271,10 +271,11 @@ StringMap featureMap; std::string features; if (sys::getHostCPUFeatures(featureMap)) { + bool first = true; for(llvm::StringMap::const_iterator it = featureMap.begin(); it != featureMap.end(); ++it) { - if (it->second) { - features += it->first().str() + " "; - } + if (!first) { features += ","; } + first = false; + features += (it->second ? "+" : "-") + it->first().str(); } } return strdup(features.c_str()); diff --git a/src/LLVM/General/Internal/Target.hs b/src/LLVM/General/Internal/Target.hs --- a/src/LLVM/General/Internal/Target.hs +++ b/src/LLVM/General/Internal/Target.hs @@ -14,9 +14,11 @@ import Foreign.Ptr import Data.List (intercalate) -import Data.Set (Set) -import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Text.ParserCombinators.Parsec hiding (many) + import LLVM.General.Internal.Coding import LLVM.General.Internal.String () import LLVM.General.Internal.LibraryFunction @@ -74,12 +76,21 @@ newtype CPUFeature = CPUFeature String deriving (Eq, Ord, Read, Show) -instance EncodeM e String es => EncodeM e (Set CPUFeature) es where - encodeM = encodeM . intercalate " " . map (\(CPUFeature f) -> f) . Set.toList - -instance (Monad d, DecodeM d String es) => DecodeM d (Set CPUFeature) es where - decodeM = liftM (Set.fromList . map CPUFeature . words) . decodeM +instance EncodeM e String es => EncodeM e (Map CPUFeature Bool) es where + encodeM = encodeM . intercalate "," . map (\(CPUFeature f, enabled) -> (if enabled then "+" else "-") ++ f) . Map.toList +instance (Monad d, DecodeM d String es) => DecodeM d (Map CPUFeature Bool) es where + decodeM es = do + s <- decodeM es + let flag = do + en <- choice [char '-' >> return False, char '+' >> return True] + s <- many1 (noneOf ",") + return (CPUFeature s, en) + features = liftM Map.fromList (flag `sepBy` (char ',')) + case parse (do f <- features; eof; return f) "CPU Feature string" (s :: String) of + Right features -> return features + Left _ -> fail "failure to parse CPUFeature string" + -- | Find a 'Target' given an architecture and/or a \"triple\". -- | -- | Be sure to run either 'initializeAllTargets' or 'initializeNativeTarget' before expecting this to succeed, depending on what target(s) you want to use. @@ -195,7 +206,7 @@ Target -> String -- ^ triple -> String -- ^ cpu - -> Set CPUFeature -- ^ features + -> Map CPUFeature Bool -- ^ features -> TargetOptions -> Reloc.Model -> CodeModel.Model @@ -259,7 +270,7 @@ getHostCPUName = decodeM =<< FFI.getHostCPUName -- | a space-separated list of LLVM feature names supported by the host CPU -getHostCPUFeatures :: IO (Set CPUFeature) +getHostCPUFeatures :: IO (Map CPUFeature Bool) getHostCPUFeatures = decodeM =<< FFI.getHostCPUFeatures -- | 'DataLayout' to use for the given 'TargetMachine' diff --git a/test/LLVM/General/Test/Module.hs b/test/LLVM/General/Test/Module.hs --- a/test/LLVM/General/Test/Module.hs +++ b/test/LLVM/General/Test/Module.hs @@ -10,7 +10,7 @@ import Data.Bits import Data.Word -import qualified Data.Set as Set +import qualified Data.Map as Map import LLVM.General.Context import LLVM.General.Module @@ -233,7 +233,7 @@ a <- withModuleFromLLVMAssembly' context s $ \m -> do (t, _) <- failInIO $ lookupTarget Nothing "x86_64-unknown-linux" withTargetOptions $ \to -> do - withTargetMachine t "" "" Set.empty to R.Default CM.Default CGO.Default $ \tm -> do + withTargetMachine t "" "" Map.empty to R.Default CM.Default CGO.Default $ \tm -> do failInIO $ moduleTargetAssembly tm m a @?= "\t.file\t\"\"\n\ \\t.text\n\ diff --git a/test/LLVM/General/Test/Optimization.hs b/test/LLVM/General/Test/Optimization.hs --- a/test/LLVM/General/Test/Optimization.hs +++ b/test/LLVM/General/Test/Optimization.hs @@ -7,7 +7,6 @@ import LLVM.General.Test.Support import Data.Functor -import qualified Data.Set as Set import qualified Data.Map as Map import LLVM.General.Module @@ -210,7 +209,7 @@ let triple = "x86_64-apple-darwin" (target, _) <- failInIO $ lookupTarget Nothing triple withTargetOptions $ \targetOptions -> do - withTargetMachine target triple "" Set.empty targetOptions + withTargetMachine target triple "" Map.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do withPassManager (defaultPassSetSpec { transforms = [LowerInvoke False], targetMachine = Just tm}) $ \passManager -> do let astIn = diff --git a/test/LLVM/General/Test/Target.hs b/test/LLVM/General/Test/Target.hs --- a/test/LLVM/General/Test/Target.hs +++ b/test/LLVM/General/Test/Target.hs @@ -74,5 +74,8 @@ withTargetLibraryInfo triple $ \tli -> do lf <- getLibraryFunction tli "printf" lf @?= Just LF__printf - ] + ], + testCase "Host" $ do + features <- getHostCPUFeatures + return () ]