llvm-general 3.2.4.4 → 3.2.4.5
raw patch · 11 files changed
+557/−21 lines, 11 filesdep +pretty
Dependencies added: pretty
Files
- llvm-general.cabal +8/−4
- src/LLVM/General/Internal/PrettyPrint.hs +206/−0
- src/LLVM/General/PassManager.hs +1/−1
- src/LLVM/General/PrettyPrint.hs +158/−0
- src/LLVM/General/Target.hs +1/−1
- test/LLVM/General/Test/DataLayout.hs +42/−10
- test/LLVM/General/Test/Module.hs +30/−1
- test/LLVM/General/Test/Optimization.hs +5/−1
- test/LLVM/General/Test/PrettyPrint.hs +99/−0
- test/LLVM/General/Test/Support.hs +4/−2
- test/LLVM/General/Test/Tests.hs +3/−1
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.2.4.4+version: 3.2.4.5 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -16,7 +16,7 @@ handles almost all of the stateful complexities of using the LLVM API to build IR; and it supports moving IR not only from Haskell into LLVM C++ objects, but the other direction - from LLVM C++ into Haskell. .- For haddock, see <http://bscarlet.github.io/llvm-general/3.2.4.4/doc/html/llvm-general/index.html>.+ For haddock, see <http://bscarlet.github.io/llvm-general/3.2.4.5/doc/html/llvm-general/index.html>. extra-source-files: src/LLVM/General/Internal/FFI/Analysis.h src/LLVM/General/Internal/FFI/Function.h@@ -36,7 +36,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.2- tag: v3.2.4.4+ tag: v3.2.4.5 flag shared-llvm description: link against llvm shared rather than static library@@ -59,7 +59,8 @@ containers >= 0.4.2.1, parsec >= 3.1.3, array >= 0.4.0.0,- setenv >= 0.1.0+ setenv >= 0.1.0,+ pretty >= 1.1.1.0 extra-libraries: stdc++ hs-source-dirs: src extensions:@@ -98,6 +99,7 @@ LLVM.General.ExecutionEngine LLVM.General.Module LLVM.General.PassManager+ LLVM.General.PrettyPrint LLVM.General.Relocation LLVM.General.Target LLVM.General.Target.Options@@ -132,6 +134,7 @@ LLVM.General.Internal.Module LLVM.General.Internal.Operand LLVM.General.Internal.PassManager+ LLVM.General.Internal.PrettyPrint LLVM.General.Internal.RMWOperation LLVM.General.Internal.String LLVM.General.Internal.Target@@ -218,6 +221,7 @@ LLVM.General.Test.Metadata LLVM.General.Test.Module LLVM.General.Test.Optimization+ LLVM.General.Test.PrettyPrint LLVM.General.Test.Support LLVM.General.Test.Target LLVM.General.Test.Tests
+ src/LLVM/General/Internal/PrettyPrint.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE+ TemplateHaskell,+ QuasiQuotes,+ ViewPatterns,+ OverloadedStrings+ #-}+module LLVM.General.Internal.PrettyPrint where++import Language.Haskell.TH +import Language.Haskell.TH.Quote++import Data.Monoid+import Data.String+import Data.Data+import Data.Word+import Data.Maybe++import Data.List+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Control.Applicative ((<$>),(<*>))+import Control.Monad.Reader++data Branch+ = Fixed String+ | Variable String String+ | IndentGroup Tree+ deriving (Eq, Ord, Show)++type Tree = [Branch]++data PrettyShowEnv = PrettyShowEnv {+ prefixes :: Map String (Maybe String),+ precedence :: Int+ }+ deriving (Show)++defaultPrettyShowEnv :: PrettyShowEnv+defaultPrettyShowEnv = PrettyShowEnv {+ prefixes = Map.empty,+ precedence = 0+ }++type Qual a = Reader PrettyShowEnv a ++prec :: Int -> Qual a -> Qual a+prec p = local (\env -> env { precedence = p })++type QTree = Qual Tree++variable :: String -> String -> QTree+variable t f = return [Variable t f]++indentGroup :: QTree -> QTree+indentGroup = fmap (return . IndentGroup)++instance IsString QTree where+ fromString = return . return . Fixed++instance Monoid QTree where+ mempty = return mempty+ mappend a b = mappend <$> a <*> b++renderEx :: Int -> String -> PrettyShowEnv -> QTree -> String+renderEx threshold indent env ts =+ (\(l, t, f) -> if (l < threshold) then t else f) $ fit 0 (runReader ts env)+ where+ ind i = concat $ replicate i indent+ fit i branches = (sum ls, concat ts, concat fs)+ where+ bit (Fixed s) = (length s, s, s)+ bit (Variable t f) = (length f, f, concat [ s:(if s == '\n' then ind i else "") | s <- t ])+ bit (IndentGroup tree) = + let (l, t, f) = fit (i+1) tree+ in (l, t, if (l < threshold) then t else "\n" ++ ind (i+1) ++ f ++ "\n" ++ ind i)+ (ls, ts, fs) = unzip3 . map bit $ branches+ +render = renderEx 80 " " defaultPrettyShowEnv++comma = "," <> variable "\n" " "+a <+> b = a <> " " <> b++punctuate :: QTree -> [QTree] -> QTree+punctuate a as = intercalate <$> a <*> sequence as++gParens o c content = o <> prec 0 (indentGroup content) <> c+parens = gParens "(" ")"+brackets = gParens "[" "]"+braces = gParens ("{" <> variable "" " ") (variable "" " " <> "}")++record :: QTree -> [(QTree,QTree)] -> QTree+record name fields = do+ name <+> braces (punctuate comma [ n <+> "=" <+> v | (n,v) <- fields ])++ctor :: QTree -> [QTree] -> QTree+ctor name fields = do+ p <- asks precedence+ parensIfNeeded appPrec (foldl (<+>) name fields)++class Show a => PrettyShow a where+ prettyShow :: a -> QTree+ prettyShowList :: [a] -> QTree++ prettyShow = fromString . show+ prettyShowList = brackets . punctuate comma . map prettyShow++instance PrettyShow a => PrettyShow [a] where+ prettyShow = prettyShowList+++appPrec = 10+appPrec1 = 11++parensIfNeeded p' b = do+ p <- asks precedence+ let b' = prec (p'+1) b+ if (p > p') then parens b' else b'++instance PrettyShow Int+instance PrettyShow Bool+instance PrettyShow Integer+instance PrettyShow Double+instance PrettyShow Float+instance PrettyShow Word+instance PrettyShow Word16+instance PrettyShow Word32+instance PrettyShow Word64++instance PrettyShow Char where+ prettyShowList = fromString . show++instance PrettyShow a => PrettyShow (Set a) where+ prettyShow s = ctor "Set.fromList" [prettyShow (Set.toList s)]++instance (PrettyShow a, PrettyShow b) => PrettyShow (a, b) where+ prettyShow (a,b) = parens (prec appPrec1 (prettyShow a <> comma <> prettyShow b))++instance (PrettyShow k, PrettyShow a) => PrettyShow (Map k a) where+ prettyShow m = ctor "Map.fromList" [prettyShow (Map.toList m)]++data SimpleName = SimpleName (Maybe String) String+ deriving (Eq, Ord, Read, Show)++instance PrettyShow SimpleName where+ prettyShow (SimpleName mMod n) = do+ prs <- asks prefixes+ fromString $ fromMaybe n $ do+ mod <- mMod+ pr <- Map.findWithDefault (Just mod) mod prs+ return $ pr ++ "." ++ n++simpleName :: Name -> ExpQ+simpleName n = do+ let d :: Data d => d -> ExpQ+ d = dataToExpQ (const Nothing)+ [| prettyShow (SimpleName $(d (nameModule n)) $(d (nameBase n))) |]++makePrettyShowInstance :: Name -> DecsQ+makePrettyShowInstance n = do+ info <- reify n+ let (tvb, cons) = + case info of+ TyConI (DataD _ _ tvb cons _) -> (tvb, cons)+ TyConI (NewtypeD _ _ tvb con _) -> (tvb, [con])+ x -> error $ "unexpected info: " ++ show x+ cs <- mapM (const $ newName "a") tvb+ let cvs = map varT cs+ sequence . return $ instanceD (cxt [classP (mkName "PrettyShow") [cv] | cv <- cvs]) [t| PrettyShow $(foldl appT (conT n) cvs) |] [+ funD (mkName "prettyShow") [+ clause+ [varP (mkName "a")] (+ normalB $ caseE (dyn "a") $ flip map cons $ \con -> do+ case con of+ RecC conName (unzip3 -> (ns, _, _)) -> do+ pvs <- mapM (const $ newName "f") ns+ let ss = [| record $(simpleName conName) $(listE [[|($(simpleName n), prettyShow $(varE pv))|] | (n, pv) <- zip ns pvs]) |]+ match + (conP conName (map varP pvs))+ (normalB ss)+ []+ NormalC conName fs -> do+ pvs <- mapM (const $ newName "f") fs+ let ss = [| ctor $(simpleName conName) $(listE [[| prettyShow $(varE pv)|] | pv <- pvs]) |]+ match + (conP conName (map varP pvs))+ (normalB ss)+ []+ InfixC (_, n0) conName (_, n1) -> do+ DataConI _ _ _ (Fixity prec _) <- reify conName+ let ns = [n0, n1]+ [p0,p1] <- mapM (const $ newName "f") ns+ let ss = [| parensIfNeeded prec (prettyShow $(varE p0) <+> $(simpleName conName) <+> prettyShow $(varE p1)) |]+ match+ (uInfixP (varP p0) conName (varP p1))+ (normalB ss)+ []+ x -> error $ "unexpected constructor pattern: " ++ show x+ )+ []+ ]+ ]++ +
src/LLVM/General/PassManager.hs view
@@ -1,5 +1,5 @@ -- | A 'PassManager' holds collection of passes, to be run on 'Module's.--- Build one with 'createPassManager':+-- Build one with 'withPassManager': -- -- * from a 'CuratedPassSetSpec' if you want optimization but not to play with your compiler --
+ src/LLVM/General/PrettyPrint.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE+ TemplateHaskell,+ GeneralizedNewtypeDeriving+ #-}+-- | Tools for printing out AST.'LLVM.General.AST.Module' code so that it's actually useful.+module LLVM.General.PrettyPrint (+ showPretty,+ showPrettyEx,+ PrefixScheme(..),+ shortPrefixScheme,+ longPrefixScheme,+ defaultPrefixScheme,+ basePrefixScheme, + shortASTPrefixScheme,+ longASTPrefixScheme,+ imports+ ) where++import Control.Monad+import Data.Functor+import Data.Monoid+import Data.Map (Map)+import qualified Data.Map as Map+import LLVM.General.Internal.PrettyPrint++import qualified LLVM.General.AST as A+import qualified LLVM.General.AST.DataLayout as A+import qualified LLVM.General.AST.Constant as A.C+import qualified LLVM.General.AST.AddrSpace as A+import qualified LLVM.General.AST.Float as A+import qualified LLVM.General.AST.FloatingPointPredicate as A+import qualified LLVM.General.AST.IntegerPredicate as A+import qualified LLVM.General.AST.Attribute as A+import qualified LLVM.General.AST.CallingConvention as A+import qualified LLVM.General.AST.Visibility as A+import qualified LLVM.General.AST.Linkage as A+import qualified LLVM.General.AST.InlineAssembly as A+import qualified LLVM.General.AST.RMWOperation as A++liftM concat $ mapM makePrettyShowInstance [+ ''A.Module,+ ''A.Definition,+ ''A.DataLayout,+ ''A.Operand,+ ''A.MetadataNodeID,+ ''A.MetadataNode,+ ''A.Type,+ ''A.Name,+ ''A.Global,+ ''A.AlignmentInfo,+ ''A.AlignType,+ ''A.C.Constant,+ ''A.AddrSpace,+ ''A.Endianness,+ ''A.BasicBlock,+ ''A.FloatingPointPredicate,+ ''A.IntegerPredicate,+ ''A.FloatingPointFormat,+ ''A.FunctionAttribute,+ ''A.ParameterAttribute,+ ''A.Parameter,+ ''A.CallingConvention,+ ''A.Visibility,+ ''A.Linkage,+ ''A.SomeFloat,+ ''A.Named,+ ''A.Terminator,+ ''A.Instruction,+ ''A.LandingPadClause,+ ''A.InlineAssembly,+ ''A.RMWOperation,+ ''A.Atomicity,+ ''A.Dialect,+ ''A.MemoryOrdering,+ ''Either,+ ''Maybe+ ]++-- | Show an AST.'LLVM.General.AST.Module' or part thereof both with qualified+-- identifiers (resolving some ambiguity, making the output usable Haskell) and+-- with indentation (making the output readable).+showPretty :: PrettyShow a => a -> String+showPretty = showPrettyEx 80 " " defaultPrefixScheme++-- | Like 'showPretty' but allowing configuration of the format+showPrettyEx+ :: PrettyShow a+ => Int -- ^ line length before attempting breaking+ -> String -- ^ one unit of indentation+ -> PrefixScheme -- ^ prefixes to use for qualifying names+ -> a+ -> String+showPrettyEx width indent (PrefixScheme ps) = renderEx width indent (defaultPrettyShowEnv { prefixes = ps }) . prettyShow++-- | A 'PrefixScheme' is a mapping between haskell module names and+-- the prefixes with which they should be rendered when printing code.+newtype PrefixScheme = PrefixScheme (Map String (Maybe String))+ deriving (Eq, Ord, Read, Show, Monoid)++-- | a 'PrefixScheme' for types not of llvm-general, but nevertheless used+-- in the AST. Useful for building other 'PrefixScheme's.+basePrefixScheme :: PrefixScheme+basePrefixScheme = PrefixScheme $ Map.fromList [+ ("Data.Maybe", Nothing),+ ("Data.Map", Just "Map"),+ ("Data.Set", Just "Set")+ ]++-- | a terse 'PrefixScheme' for types in the AST, leaving most names unqualified.+-- Useful for building other 'PrefixScheme's. If you think you want to use this, you+-- probably want 'shortPrefixScheme' instead.+shortASTPrefixScheme :: PrefixScheme+shortASTPrefixScheme = PrefixScheme $ Map.fromList [+ ("LLVM.General.AST", Nothing),+ ("LLVM.General.AST.AddrSpace", Nothing),+ ("LLVM.General.AST.DataLayout", Nothing),+ ("LLVM.General.AST.Float", Nothing),+ ("LLVM.General.AST.InlineAssembly", Nothing),+ ("LLVM.General.AST.Instruction", Nothing),+ ("LLVM.General.AST.Name", Nothing),+ ("LLVM.General.AST.Operand", Nothing),+ ("LLVM.General.AST.Type", Nothing),+ ("LLVM.General.AST.FloatingPointPredicate", Just "FPred"),+ ("LLVM.General.AST.IntegerPredicate", Just "IPred"),+ ("LLVM.General.AST.Constant", Just "C"),+ ("LLVM.General.AST.Attribute", Just "A"),+ ("LLVM.General.AST.Global", Just "G"),+ ("LLVM.General.AST.CallingConvention", Just "CC"),+ ("LLVM.General.AST.Visibility", Just "V"),+ ("LLVM.General.AST.Linkage", Just "L")+ ]++-- | a conservative 'PrefixScheme' for types in the AST which qualifies everything.+-- Useful for building other 'PrefixScheme's. If you think you want to use this, you+-- probably want 'longPrefixScheme' instead.+longASTPrefixScheme :: PrefixScheme+longASTPrefixScheme = case shortASTPrefixScheme of+ PrefixScheme m -> PrefixScheme $ maybe (Just "A") (Just . ("A."++)) <$> m++-- | a terse 'PrefixScheme', leaving most names unqualified.+shortPrefixScheme :: PrefixScheme+shortPrefixScheme = shortASTPrefixScheme <> basePrefixScheme++-- | a conservative 'PrefixScheme' which qualifies everything.+longPrefixScheme :: PrefixScheme+longPrefixScheme = longASTPrefixScheme <> basePrefixScheme++-- | the default 'PrefixScheme' used by 'showPretty'+defaultPrefixScheme :: PrefixScheme+defaultPrefixScheme = longPrefixScheme++-- | print Haskell imports to define the correct prefixes for use with the output+-- of a given 'PrefixScheme'.+imports :: PrefixScheme -> String+imports (PrefixScheme p) = unlines . flip map (Map.toList p) $ \(mod, mAbbr) ->+ "import " ++ maybe mod (\abbr -> "qualified " ++ mod ++ " as " ++ abbr) mAbbr++
src/LLVM/General/Target.hs view
@@ -4,7 +4,7 @@ module LLVM.General.Target ( lookupTarget, TargetOptions,- TargetMachine,+ Target, TargetMachine, TargetLowering, CPUFeature(..), withTargetOptions, peekTargetOptions, pokeTargetOptions, withTargetMachine, withDefaultTargetMachine,
test/LLVM/General/Test/DataLayout.hs view
@@ -6,6 +6,7 @@ import LLVM.General.Test.Support +import Data.Maybe import qualified Data.Set as Set import qualified Data.Map as Map @@ -16,16 +17,19 @@ import LLVM.General.AST.AddrSpace import qualified LLVM.General.AST.Global as G +m s = "; ModuleID = '<string>'\n" ++ s+t s = "target datalayout = \"" ++ s ++ "\"\n"+ tests = testGroup "DataLayout" [- testCase name $ strCheck (Module "<string>" mdl Nothing []) ("; ModuleID = '<string>'\n" ++ sdl)- | (name, mdl, sdl) <- [- ("none",Nothing, "")+ testCase name $ strCheckC (Module "<string>" mdl Nothing []) (m sdl) (m sdlc)+ | (name, mdl, sdl, sdlc) <- [+ ("none", Nothing, "", "") ] ++ [- (name, Just mdl, "target datalayout = \"" ++ sdl ++ "\"\n")- | (name, mdl, sdl) <- [- ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e"),- ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E"),- ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32"),+ (name, Just mdl, t sdl, t (fromMaybe sdl msdlc))+ | (name, mdl, sdl, msdlc) <- [+ ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e", Nothing),+ ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E", Nothing),+ ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32", Nothing), ( "no pref", defaultDataLayout {@@ -40,7 +44,8 @@ } ) },- "p:8:64"+ "p:8:64",+ Nothing ), ( "no pref", defaultDataLayout {@@ -55,7 +60,34 @@ } ) },- "p1:8:32:64"+ "p1:8:32:64",+ Nothing+ ), (+ "big",+ DataLayout {+ endianness = Just LittleEndian,+ stackAlignment = Just 128,+ pointerLayouts = Map.fromList [+ (AddrSpace 0, (64, AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}))+ ],+ typeLayouts = Map.fromList [+ ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}),+ ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}),+ ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 16}),+ ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}),+ ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),+ ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),+ ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}),+ ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}),+ ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),+ ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}),+ ((AggregateAlign, 0), AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 64}),+ ((StackAlign, 0), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64})+ ],+ nativeSizes = Just (Set.fromList [8,16,32,64])+ },+ "e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64-S128",+ Just "e-S128-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-v64:64:64-v128:128:128-f32:32:32-f64:64:64-f80:128:128-a0:0:64-s0:64:64-n8:16:32:64" ) ] ]
test/LLVM/General/Test/Module.hs view
@@ -366,6 +366,35 @@ ] ] t <- runErrorT $ withModuleFromAST context badAST $ \_ -> return True- t @?= Left "reference to undefined block: Name \"not here\""+ t @?= Left "reference to undefined block: Name \"not here\"",++ testCase "multiple" $ withContext $ \context -> do+ let badAST = Module "<string>" Nothing Nothing [+ GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([+ ],False)+ [] Nothing 0 + [+ BasicBlock (UnName 0) [+ UnName 1 := Mul {+ nsw = False,+ nuw = False,+ operand0 = LocalReference (Name "unknown"),+ operand1 = ConstantOperand (C.Int 32 1),+ metadata = []+ },+ UnName 2 := Mul {+ nsw = False,+ nuw = False,+ operand0 = LocalReference (Name "unknown2"),+ operand1 = LocalReference (UnName 1),+ metadata = []+ }+ ] (+ Do $ Ret (Just (LocalReference (UnName 2))) []+ )+ ]+ ]+ t <- runErrorT $ withModuleFromAST context badAST $ \_ -> return True+ t @?= Left "reference to undefined local: Name \"unknown\"" ] ]
test/LLVM/General/Test/Optimization.hs view
@@ -148,7 +148,11 @@ Do $ Br (Name "done") [] ), BasicBlock (Name "done") [- Name "r" := Phi {type' = IntegerType 32, incomingValues = [(LocalReference (UnName 1),Name "take"),(ConstantOperand (C.Int 32 57), Name "here")], metadata = []}+ Name "r" := Phi {+ type' = IntegerType 32,+ incomingValues = [(LocalReference (UnName 1),Name "take"),(ConstantOperand (C.Int 32 57), Name "here")],+ metadata = []+ } ] ( Do $ Ret (Just (LocalReference (Name "r"))) [] )
+ test/LLVM/General/Test/PrettyPrint.hs view
@@ -0,0 +1,99 @@+module LLVM.General.Test.PrettyPrint where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import LLVM.General.Test.Support++import LLVM.General.PrettyPrint++import LLVM.General.AST+import qualified LLVM.General.AST.Linkage as L+import qualified LLVM.General.AST.Visibility as V+import qualified LLVM.General.AST.CallingConvention as CC+import qualified LLVM.General.AST.Constant as C++tests = testGroup "PrettyPrint" [+ testCase "basic" $ do+ let ast = Module "<string>" Nothing Nothing [+ GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([+ Parameter (IntegerType 32) (Name "x") []+ ],False)+ [] Nothing 0 + [+ BasicBlock (UnName 0) [+ UnName 1 := Mul {+ nsw = True,+ nuw = False,+ operand0 = ConstantOperand (C.Int 32 1),+ operand1 = ConstantOperand (C.Int 32 1),+ metadata = []+ }+ ] (+ Do $ Br (Name "here") []+ ),+ BasicBlock (Name "here") [+ ] (+ Do $ Ret (Just (LocalReference (UnName 1))) []+ )+ ]+ ]+ s = "A.Module {\n\+ \ A.moduleName = \"<string>\",\n\+ \ A.moduleDataLayout = Nothing,\n\+ \ A.moduleTargetTriple = Nothing,\n\+ \ A.moduleDefinitions = [\n\+ \ A.GlobalDefinition A.G.Function {\n\+ \ A.G.linkage = A.L.External,\n\+ \ A.G.visibility = A.V.Default,\n\+ \ A.G.callingConvention = A.CC.C,\n\+ \ A.G.returnAttributes = [],\n\+ \ A.G.returnType = A.IntegerType {A.typeBits = 32},\n\+ \ A.G.name = A.Name \"foo\",\n\+ \ A.G.parameters = ([A.G.Parameter A.IntegerType { A.typeBits = 32 } (A.Name \"x\") []], False),\n\+ \ A.G.functionAttributes = [],\n\+ \ A.G.section = Nothing,\n\+ \ A.G.alignment = 0,\n\+ \ A.G.basicBlocks = [\n\+ \ A.G.BasicBlock (A.UnName 0) [\n\+ \ A.UnName 1 A.:= A.Mul {\n\+ \ A.nsw = True,\n\+ \ A.nuw = False,\n\+ \ A.operand0 = A.ConstantOperand A.C.Int {A.C.integerBits = 32, A.C.integerValue = 1},\n\+ \ A.operand1 = A.ConstantOperand A.C.Int {A.C.integerBits = 32, A.C.integerValue = 1},\n\+ \ A.metadata = []\n\+ \ }\n\+ \ ] (A.Do A.Br { A.dest = A.Name \"here\", A.metadata' = [] }),\n\+ \ A.G.BasicBlock (A.Name \"here\") [] (\n\+ \ A.Do A.Ret {A.returnOperand = Just (A.LocalReference (A.UnName 1)), A.metadata' = []}\n\+ \ )\n\+ \ ]\n\+ \ }\n\+ \ ]\n\+ \}"+ showPretty ast @?= s,+ testCase "imports" $ do+ imports defaultPrefixScheme @?= + "import qualified Data.Map as Map\n\+ \import Data.Maybe\n\+ \import qualified Data.Set as Set\n\+ \import qualified LLVM.General.AST as A\n\+ \import qualified LLVM.General.AST.AddrSpace as A\n\+ \import qualified LLVM.General.AST.Attribute as A.A\n\+ \import qualified LLVM.General.AST.CallingConvention as A.CC\n\+ \import qualified LLVM.General.AST.Constant as A.C\n\+ \import qualified LLVM.General.AST.DataLayout as A\n\+ \import qualified LLVM.General.AST.Float as A\n\+ \import qualified LLVM.General.AST.FloatingPointPredicate as A.FPred\n\+ \import qualified LLVM.General.AST.Global as A.G\n\+ \import qualified LLVM.General.AST.InlineAssembly as A\n\+ \import qualified LLVM.General.AST.Instruction as A\n\+ \import qualified LLVM.General.AST.IntegerPredicate as A.IPred\n\+ \import qualified LLVM.General.AST.Linkage as A.L\n\+ \import qualified LLVM.General.AST.Name as A\n\+ \import qualified LLVM.General.AST.Operand as A\n\+ \import qualified LLVM.General.AST.Type as A\n\+ \import qualified LLVM.General.AST.Visibility as A.V\n"+ ]+
test/LLVM/General/Test/Support.hs view
@@ -27,8 +27,10 @@ withModuleFromString' c s f = failInIO $ withModuleFromString c s f withModuleFromAST' c a f = failInIO $ withModuleFromAST c a f -strCheck mAST mStr = withContext $ \context -> do+strCheckC mAST mStr mStrCanon = withContext $ \context -> do a <- withModuleFromString' context mStr moduleAST s <- withModuleFromAST' context mAST moduleString- (a,s) @?= (mAST, mStr)+ (a,s) @?= (mAST, mStrCanon)++strCheck mAST mStr = strCheckC mAST mStr mStr
test/LLVM/General/Test/Tests.hs view
@@ -13,6 +13,7 @@ import qualified LLVM.General.Test.Optimization as Optimization import qualified LLVM.General.Test.Target as Target import qualified LLVM.General.Test.Analysis as Analysis+import qualified LLVM.General.Test.PrettyPrint as PrettyPrint tests = testGroup "llvm-general" [ Constants.tests,@@ -25,5 +26,6 @@ Module.tests, Optimization.tests, Target.tests,- Analysis.tests+ Analysis.tests,+ PrettyPrint.tests ]