├── .gitignore ├── .travis.yml ├── Shake.hs ├── downloads └── .gitignore ├── llvm-general-pure ├── LICENSE ├── Setup.hs ├── llvm-general-pure.cabal ├── src │ └── LLVM │ │ └── General │ │ ├── AST.hs │ │ ├── AST │ │ ├── AddrSpace.hs │ │ ├── Attribute.hs │ │ ├── COMDAT.hs │ │ ├── CallingConvention.hs │ │ ├── Constant.hs │ │ ├── DLL.hs │ │ ├── DataLayout.hs │ │ ├── Float.hs │ │ ├── FloatingPointPredicate.hs │ │ ├── FunctionAttribute.hs │ │ ├── Global.hs │ │ ├── InlineAssembly.hs │ │ ├── Instruction.hs │ │ ├── IntegerPredicate.hs │ │ ├── Linkage.hs │ │ ├── Name.hs │ │ ├── Operand.hs │ │ ├── ParameterAttribute.hs │ │ ├── RMWOperation.hs │ │ ├── ThreadLocalStorage.hs │ │ ├── Type.hs │ │ └── Visibility.hs │ │ ├── DataLayout.hs │ │ ├── Internal │ │ └── PrettyPrint.hs │ │ ├── Prelude.hs │ │ ├── PrettyPrint.hs │ │ └── TH.hs └── test │ ├── LLVM │ └── General │ │ └── Test │ │ ├── DataLayout.hs │ │ ├── PrettyPrint.hs │ │ └── Tests.hs │ └── Test.hs └── llvm-general ├── LICENSE ├── Setup.hs ├── llvm-general.cabal ├── src ├── Control │ └── Monad │ │ ├── AnyCont.hs │ │ ├── AnyCont │ │ └── Class.hs │ │ ├── Exceptable.hs │ │ └── Trans │ │ └── AnyCont.hs └── LLVM │ ├── General.hs │ └── General │ ├── Analysis.hs │ ├── CodeGenOpt.hs │ ├── CodeModel.hs │ ├── CommandLine.hs │ ├── Context.hs │ ├── Diagnostic.hs │ ├── ExecutionEngine.hs │ ├── Internal │ ├── Analysis.hs │ ├── Atomicity.hs │ ├── Attribute.hs │ ├── BasicBlock.hs │ ├── CallingConvention.hs │ ├── Coding.hs │ ├── CommandLine.hs │ ├── Constant.hs │ ├── Context.hs │ ├── DataLayout.hs │ ├── DecodeAST.hs │ ├── Diagnostic.hs │ ├── EncodeAST.hs │ ├── ExecutionEngine.hs │ ├── FFI │ │ ├── Analysis.h │ │ ├── Analysis.hs │ │ ├── Assembly.hs │ │ ├── AssemblyC.cpp │ │ ├── Attribute.h │ │ ├── Attribute.hs │ │ ├── AttributeC.cpp │ │ ├── AttributeC.hpp │ │ ├── BasicBlock.hs │ │ ├── BinaryOperator.h │ │ ├── BinaryOperator.hs │ │ ├── Bitcode.hs │ │ ├── BitcodeC.cpp │ │ ├── Builder.hs │ │ ├── BuilderC.cpp │ │ ├── ByteRangeCallback.hs │ │ ├── CallingConvention.h │ │ ├── CallingConventionC.hpp │ │ ├── Cleanup.hs │ │ ├── CommandLine.hs │ │ ├── CommandLineC.cpp │ │ ├── Constant.h │ │ ├── Constant.hs │ │ ├── ConstantC.cpp │ │ ├── Context.hs │ │ ├── DataLayout.hs │ │ ├── ExecutionEngine.hs │ │ ├── ExecutionEngineC.cpp │ │ ├── Function.hs │ │ ├── FunctionC.cpp │ │ ├── GlobalAlias.hs │ │ ├── GlobalAliasC.cpp │ │ ├── GlobalValue.h │ │ ├── GlobalValue.hs │ │ ├── GlobalValueC.cpp │ │ ├── GlobalVariable.hs │ │ ├── InlineAssembly.h │ │ ├── InlineAssembly.hs │ │ ├── InlineAssemblyC.cpp │ │ ├── Instruction.h │ │ ├── Instruction.hs │ │ ├── InstructionC.cpp │ │ ├── InstructionDefs.hsc │ │ ├── Iterate.hs │ │ ├── LLVMCTypes.hsc │ │ ├── LibFunc.h │ │ ├── LibFunc.hs │ │ ├── MemoryBuffer.hs │ │ ├── Metadata.hs │ │ ├── MetadataC.cpp │ │ ├── Module.h │ │ ├── Module.hs │ │ ├── ModuleC.cpp │ │ ├── PassManager.hs │ │ ├── PassManagerC.cpp │ │ ├── PtrHierarchy.hs │ │ ├── RawOStream.hs │ │ ├── RawOStreamC.cpp │ │ ├── SMDiagnostic.h │ │ ├── SMDiagnostic.hs │ │ ├── SMDiagnosticC.cpp │ │ ├── Target.h │ │ ├── Target.hs │ │ ├── TargetC.cpp │ │ ├── Threading.hs │ │ ├── Transforms.hs │ │ ├── Type.h │ │ ├── Type.hs │ │ ├── TypeC.cpp │ │ ├── User.hs │ │ ├── Value.h │ │ ├── Value.hs │ │ └── ValueC.cpp │ ├── FastMathFlags.hs │ ├── FloatingPointPredicate.hs │ ├── Function.hs │ ├── Global.hs │ ├── Inject.hs │ ├── InlineAssembly.hs │ ├── Instruction.hs │ ├── InstructionDefs.hs │ ├── IntegerPredicate.hs │ ├── LibraryFunction.hsc │ ├── MemoryBuffer.hs │ ├── Metadata.hs │ ├── Module.hs │ ├── Operand.hs │ ├── PassManager.hs │ ├── RMWOperation.hs │ ├── RawOStream.hs │ ├── String.hs │ ├── TailCallKind.hs │ ├── Target.hs │ ├── Threading.hs │ ├── Type.hs │ └── Value.hs │ ├── Module.hs │ ├── PassManager.hs │ ├── Relocation.hs │ ├── Target.hs │ ├── Target │ ├── LibraryFunction.hs │ └── Options.hs │ ├── Threading.hs │ └── Transforms.hs └── test ├── LLVM └── General │ └── Test │ ├── Analysis.hs │ ├── CallingConvention.hs │ ├── Constants.hs │ ├── DataLayout.hs │ ├── ExecutionEngine.hs │ ├── Global.hs │ ├── InlineAssembly.hs │ ├── Instructions.hs │ ├── Instrumentation.hs │ ├── Linking.hs │ ├── Metadata.hs │ ├── Module.hs │ ├── Optimization.hs │ ├── Support.hs │ ├── Target.hs │ └── Tests.hs └── Test.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | .shake.database 4 | out 5 | .DS_Store 6 | .cabal-sandbox 7 | cabal.sandbox.config 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | env: 3 | - GHCVER=7.6.3 CABALVER=1.18 4 | - GHCVER=7.8.3 CABALVER=1.18 5 | - GHCVER=7.10.1 CABALVER=1.22 6 | before_install: 7 | - sudo sh -c "echo 'deb http://llvm.org/apt/precise/ llvm-toolchain-precise-3.5 main' >> /etc/apt/sources.list" 8 | - wget -O - http://llvm.org/apt/llvm-snapshot.gpg.key | sudo apt-key add - 9 | - sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test 10 | - sudo apt-get update 11 | - sudo apt-get install gcc-4.8 g++-4.8 12 | - sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-4.8 20 13 | - sudo update-alternatives --install /usr/bin/g++ g++ /usr/bin/g++-4.8 20 14 | - sudo apt-get install libedit-dev llvm-3.5-dev 15 | - travis_retry sudo add-apt-repository -y ppa:hvr/ghc 16 | - travis_retry sudo apt-get update 17 | - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER 18 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 19 | - cabal --version 20 | - sudo /opt/ghc/$GHCVER/bin/ghc-pkg recache 21 | - /opt/ghc/$GHCVER/bin/ghc-pkg recache --user 22 | - cabal update 23 | install: 24 | - cabal install --only-dependencies --enable-tests --force-reinstall llvm-general-pure/ llvm-general/ 25 | script: 26 | - cabal install --enable-tests llvm-general-pure/ llvm-general/ 27 | -------------------------------------------------------------------------------- /downloads/.gitignore: -------------------------------------------------------------------------------- 1 | llvm* 2 | -------------------------------------------------------------------------------- /llvm-general-pure/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Benjamin S. Scarlet and Google Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Benjamin S. Scarlet nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /llvm-general-pure/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /llvm-general-pure/llvm-general-pure.cabal: -------------------------------------------------------------------------------- 1 | name: llvm-general-pure 2 | version: 3.5.0.0 3 | license: BSD3 4 | license-file: LICENSE 5 | author: Benjamin S.Scarlet 6 | maintainer: Benjamin S. Scarlet 7 | copyright: (c) 2013 Benjamin S. Scarlet and Google Inc. 8 | homepage: http://github.com/bscarlet/llvm-general/ 9 | bug-reports: http://github.com/bscarlet/llvm-general/issues 10 | build-type: Simple 11 | stability: experimental 12 | cabal-version: >= 1.8 13 | category: Compilers/Interpreters, Code Generation 14 | synopsis: Pure Haskell LLVM functionality (no FFI). 15 | description: 16 | llvm-general-pure is a set of pure Haskell types and functions for interacting with LLVM . 17 | It includes an ADT to represent LLVM IR (). The llvm-general package 18 | builds on this one with FFI bindings to LLVM, but llvm-general-pure does not require LLVM to be available. 19 | 20 | source-repository head 21 | type: git 22 | location: git://github.com/bscarlet/llvm-general.git 23 | 24 | library 25 | ghc-options: -fwarn-unused-imports 26 | build-depends: 27 | base >= 4.6 && < 5, 28 | transformers >= 0.4.0.0, 29 | mtl >= 2.2.1, 30 | template-haskell >= 2.5.0.0, 31 | containers >= 0.4.2.1, 32 | setenv >= 0.1.0, 33 | parsec >= 3.1.3 34 | hs-source-dirs: src 35 | extensions: 36 | NoImplicitPrelude 37 | TupleSections 38 | DeriveDataTypeable 39 | EmptyDataDecls 40 | FlexibleContexts 41 | FlexibleInstances 42 | StandaloneDeriving 43 | ConstraintKinds 44 | exposed-modules: 45 | LLVM.General.AST 46 | LLVM.General.AST.AddrSpace 47 | LLVM.General.AST.InlineAssembly 48 | LLVM.General.AST.Attribute 49 | LLVM.General.AST.ParameterAttribute 50 | LLVM.General.AST.FunctionAttribute 51 | LLVM.General.AST.CallingConvention 52 | LLVM.General.AST.Constant 53 | LLVM.General.AST.DataLayout 54 | LLVM.General.AST.Float 55 | LLVM.General.AST.FloatingPointPredicate 56 | LLVM.General.AST.Global 57 | LLVM.General.AST.Instruction 58 | LLVM.General.AST.IntegerPredicate 59 | LLVM.General.AST.Linkage 60 | LLVM.General.AST.Name 61 | LLVM.General.AST.Operand 62 | LLVM.General.AST.RMWOperation 63 | LLVM.General.AST.ThreadLocalStorage 64 | LLVM.General.AST.Type 65 | LLVM.General.AST.Visibility 66 | LLVM.General.AST.DLL 67 | LLVM.General.AST.COMDAT 68 | LLVM.General.DataLayout 69 | LLVM.General.PrettyPrint 70 | LLVM.General.Prelude 71 | LLVM.General.TH 72 | 73 | other-modules: 74 | LLVM.General.Internal.PrettyPrint 75 | 76 | test-suite test 77 | type: exitcode-stdio-1.0 78 | build-depends: 79 | base >= 4.6 && < 5, 80 | test-framework >= 0.5, 81 | test-framework-hunit >= 0.2.7, 82 | HUnit >= 1.2.4.2, 83 | test-framework-quickcheck2 >= 0.3.0.1, 84 | QuickCheck >= 2.5.1.1, 85 | llvm-general-pure == 3.5.0.0, 86 | containers >= 0.4.2.1, 87 | mtl >= 2.2.1 88 | hs-source-dirs: test 89 | extensions: 90 | TupleSections 91 | FlexibleInstances 92 | FlexibleContexts 93 | main-is: Test.hs 94 | other-modules: 95 | LLVM.General.Test.DataLayout 96 | LLVM.General.Test.PrettyPrint 97 | LLVM.General.Test.Tests 98 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST.hs: -------------------------------------------------------------------------------- 1 | -- | This module and descendants define AST data types to represent LLVM code. 2 | -- Note that these types are designed for fidelity rather than convenience - if the truth 3 | -- of what LLVM supports is less than pretty, so be it. 4 | module LLVM.General.AST ( 5 | Module(..), defaultModule, 6 | Definition(..), 7 | Global(GlobalVariable, GlobalAlias, Function), 8 | globalVariableDefaults, 9 | globalAliasDefaults, 10 | functionDefaults, 11 | Parameter(..), 12 | BasicBlock(..), 13 | module LLVM.General.AST.Instruction, 14 | module LLVM.General.AST.Name, 15 | module LLVM.General.AST.Operand, 16 | module LLVM.General.AST.Type 17 | ) where 18 | 19 | import LLVM.General.Prelude 20 | 21 | import LLVM.General.AST.Name 22 | import LLVM.General.AST.Type (Type(..), FloatingPointFormat(..)) 23 | import LLVM.General.AST.Global 24 | import LLVM.General.AST.Operand 25 | import LLVM.General.AST.Instruction 26 | import LLVM.General.AST.DataLayout 27 | import qualified LLVM.General.AST.Attribute as A 28 | import qualified LLVM.General.AST.COMDAT as COMDAT 29 | 30 | -- | Any thing which can be at the top level of a 'Module' 31 | data Definition 32 | = GlobalDefinition Global 33 | | TypeDefinition Name (Maybe Type) 34 | | MetadataNodeDefinition MetadataNodeID [Maybe Operand] 35 | | NamedMetadataDefinition String [MetadataNodeID] 36 | | ModuleInlineAssembly String 37 | | FunctionAttributes A.GroupID [A.FunctionAttribute] 38 | | COMDAT String COMDAT.SelectionKind 39 | deriving (Eq, Read, Show, Typeable, Data) 40 | 41 | -- | 42 | data Module = 43 | Module { 44 | moduleName :: String, 45 | -- | a 'DataLayout', if specified, must match that of the eventual code generator 46 | moduleDataLayout :: Maybe DataLayout, 47 | moduleTargetTriple :: Maybe String, 48 | moduleDefinitions :: [Definition] 49 | } 50 | deriving (Eq, Read, Show, Typeable, Data) 51 | 52 | -- | helper for making 'Module's 53 | defaultModule = 54 | Module { 55 | moduleName = "", 56 | moduleDataLayout = Nothing, 57 | moduleTargetTriple = Nothing, 58 | moduleDefinitions = [] 59 | } 60 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/AddrSpace.hs: -------------------------------------------------------------------------------- 1 | -- | Pointers exist in Address Spaces 2 | module LLVM.General.AST.AddrSpace where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | See 7 | data AddrSpace = AddrSpace Word32 8 | deriving (Eq, Ord, Read, Show, Typeable, Data) 9 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Attribute.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'Attribute' distinctly qualified. 2 | -- Before LLVM 3.5, the attributes which could be used on functions 3 | -- and those which could be used on parameters were disjoint. In 4 | -- LLVM 3.5, two attributes (readonly and readnone) can be used 5 | -- in both contexts. Because their interpretation is different in 6 | -- the two contexts and only those two attributes can be used in 7 | -- both contexts, I've opted to keep the Haskell types for parameter 8 | -- and function attributes distinct, but move the two types into 9 | -- separate modules so they can have contructors with the same names. 10 | module LLVM.General.AST.Attribute ( 11 | ParameterAttribute(..), 12 | FunctionAttribute(..), 13 | GroupID(..) 14 | ) where 15 | 16 | import LLVM.General.AST.ParameterAttribute hiding (ReadNone, ReadOnly) 17 | import LLVM.General.AST.FunctionAttribute 18 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/COMDAT.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'COMDAT.SelectionKind' distinctly qualified. 2 | module LLVM.General.AST.COMDAT where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data SelectionKind 8 | = Any 9 | | ExactMatch 10 | | Largest 11 | | NoDuplicates 12 | | SameSize 13 | deriving (Eq, Read, Show, Typeable, Data) 14 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/CallingConvention.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'CallingConvention' distinctly qualified. 2 | module LLVM.General.AST.CallingConvention where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data CallingConvention 8 | = C 9 | | Fast 10 | | Cold 11 | | GHC 12 | | HiPE 13 | | WebKit_JS 14 | | AnyReg 15 | | PreserveMost 16 | | PreserveAll 17 | | X86_StdCall 18 | | X86_FastCall 19 | | ARM_APCS 20 | | ARM_AAPCS 21 | | ARM_AAPCS_VFP 22 | | MSP430_INTR 23 | | X86_ThisCall 24 | | PTX_Kernel 25 | | PTX_Device 26 | | SPIR_FUNC 27 | | SPIR_KERNEL 28 | | Intel_OCL_BI 29 | | X86_64_SysV 30 | | X86_64_Win64 31 | | Numbered Word32 32 | deriving (Eq, Read, Show, Typeable, Data) 33 | 34 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/DLL.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'DLL.StorageClass' distinctly qualified. 2 | module LLVM.General.AST.DLL where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data StorageClass 8 | = Import 9 | | Export 10 | deriving (Eq, Read, Show, Typeable, Data) 11 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/DataLayout.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | module LLVM.General.AST.DataLayout where 3 | 4 | import LLVM.General.Prelude 5 | 6 | import Data.Map (Map) 7 | import qualified Data.Map as Map 8 | import Data.Set (Set) 9 | 10 | import LLVM.General.AST.AddrSpace 11 | 12 | -- | Little Endian is the one true way :-). Sadly, we must support the infidels. 13 | data Endianness = LittleEndian | BigEndian 14 | deriving (Eq, Ord, Read, Show, Typeable, Data) 15 | 16 | -- | An AlignmentInfo describes how a given type must and would best be aligned 17 | data AlignmentInfo = AlignmentInfo { 18 | abiAlignment :: Word32, 19 | preferredAlignment :: Maybe Word32 20 | } 21 | deriving (Eq, Ord, Read, Show, Typeable, Data) 22 | 23 | -- | A type of type for which 'AlignmentInfo' may be specified 24 | data AlignType 25 | = IntegerAlign 26 | | VectorAlign 27 | | FloatAlign 28 | deriving (Eq, Ord, Read, Show, Typeable, Data) 29 | 30 | -- | A style of name mangling 31 | data Mangling 32 | = ELFMangling 33 | | MIPSMangling 34 | | MachOMangling 35 | | WindowsCOFFMangling 36 | deriving (Eq, Ord, Read, Show, Typeable, Data) 37 | 38 | -- | a description of the various data layout properties which may be used during 39 | -- optimization 40 | data DataLayout = DataLayout { 41 | endianness :: Endianness, 42 | mangling :: Maybe Mangling, 43 | stackAlignment :: Maybe Word32, 44 | pointerLayouts :: Map AddrSpace (Word32, AlignmentInfo), 45 | typeLayouts :: Map (AlignType, Word32) AlignmentInfo, 46 | aggregateLayout :: AlignmentInfo, 47 | nativeSizes :: Maybe (Set Word32) 48 | } 49 | deriving (Eq, Ord, Read, Show, Typeable, Data) 50 | 51 | -- | a default 'DataLayout' 52 | defaultDataLayout endianness = DataLayout { 53 | endianness = endianness, 54 | mangling = Nothing, 55 | stackAlignment = Nothing, 56 | pointerLayouts = Map.fromList [ 57 | (AddrSpace 0, (64, AlignmentInfo 64 (Just 64))) 58 | ], 59 | typeLayouts = Map.fromList [ 60 | ((IntegerAlign, 1), AlignmentInfo 8 (Just 8)), 61 | ((IntegerAlign, 8), AlignmentInfo 8 (Just 8)), 62 | ((IntegerAlign, 16), AlignmentInfo 16 (Just 16)), 63 | ((IntegerAlign, 32), AlignmentInfo 32 (Just 32)), 64 | ((IntegerAlign, 64), AlignmentInfo 32 (Just 64)), 65 | ((FloatAlign, 16), AlignmentInfo 16 (Just 16)), 66 | ((FloatAlign, 32), AlignmentInfo 32 (Just 32)), 67 | ((FloatAlign, 64), AlignmentInfo 64 (Just 64)), 68 | ((FloatAlign, 128), AlignmentInfo 128 (Just 128)), 69 | ((VectorAlign, 64), AlignmentInfo 64 (Just 64)), 70 | ((VectorAlign, 128), AlignmentInfo 128 (Just 128)) 71 | ], 72 | aggregateLayout = AlignmentInfo 0 (Just 64), 73 | nativeSizes = Nothing 74 | } 75 | 76 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Float.hs: -------------------------------------------------------------------------------- 1 | -- | This module provides a sub-namespace for a type to support the various sizes of floating point 2 | -- numbers LLVM supports. It is most definitely intended to be imported qualified. 3 | module LLVM.General.AST.Float where 4 | 5 | import Prelude as P 6 | import Data.Data 7 | import Data.Word (Word16, Word64) 8 | 9 | -- | A type summing up the various float types. 10 | -- N.B. Note that in the constructors with multiple fields, the lower significance bits are on the right 11 | -- - e.g. Quadruple highbits lowbits 12 | data SomeFloat 13 | = Half Word16 14 | | Single Float 15 | | Double P.Double 16 | | Quadruple Word64 Word64 17 | | X86_FP80 Word16 Word64 18 | | PPC_FP128 Word64 Word64 19 | deriving (Eq, Ord, Read, Show, Typeable, Data) 20 | 21 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/FloatingPointPredicate.hs: -------------------------------------------------------------------------------- 1 | -- | Predicates for the 'LLVM.General.AST.Instruction.FCmp' instruction 2 | module LLVM.General.AST.FloatingPointPredicate where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data FloatingPointPredicate 8 | = False 9 | | OEQ 10 | | OGT 11 | | OGE 12 | | OLT 13 | | OLE 14 | | ONE 15 | | ORD 16 | | UNO 17 | | UEQ 18 | | UGT 19 | | UGE 20 | | ULT 21 | | ULE 22 | | UNE 23 | | True 24 | deriving (Eq, Ord, Read, Show, Data, Typeable) 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/FunctionAttribute.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'FunctionAttribute' distinctly qualified. 2 | module LLVM.General.AST.FunctionAttribute where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data FunctionAttribute 8 | = NoReturn 9 | | NoUnwind 10 | | ReadNone 11 | | ReadOnly 12 | | NoInline 13 | | AlwaysInline 14 | | MinimizeSize 15 | | OptimizeForSize 16 | | OptimizeNone 17 | | StackProtect 18 | | StackProtectReq 19 | | StackProtectStrong 20 | | NoRedZone 21 | | NoImplicitFloat 22 | | Naked 23 | | InlineHint 24 | | StackAlignment Word64 25 | | ReturnsTwice 26 | | UWTable 27 | | NonLazyBind 28 | | Builtin 29 | | NoBuiltin 30 | | Cold 31 | | JumpTable 32 | | NoDuplicate 33 | | SanitizeAddress 34 | | SanitizeThread 35 | | SanitizeMemory 36 | | StringAttribute { 37 | stringAttributeKind :: String, 38 | stringAttributeValue :: String -- ^ Use "" for no value -- the two are conflated 39 | } 40 | deriving (Eq, Ord, Read, Show, Typeable, Data) 41 | 42 | -- | 43 | newtype GroupID = GroupID Word 44 | deriving (Eq, Ord, Read, Show, Typeable, Data) 45 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/InlineAssembly.hs: -------------------------------------------------------------------------------- 1 | -- | A representation of an LLVM inline assembly 2 | module LLVM.General.AST.InlineAssembly where 3 | 4 | import LLVM.General.Prelude 5 | 6 | import LLVM.General.AST.Type 7 | 8 | -- | the dialect of assembly used in an inline assembly string 9 | -- 10 | data Dialect 11 | = ATTDialect 12 | | IntelDialect 13 | deriving (Eq, Read, Show, Typeable, Data) 14 | 15 | -- | 16 | -- to be used through 'LLVM.General.AST.Operand.CallableOperand' with a 17 | -- 'LLVM.General.AST.Instruction.Call' instruction 18 | data InlineAssembly 19 | = InlineAssembly { 20 | type' :: Type, 21 | assembly :: String, 22 | constraints :: String, 23 | hasSideEffects :: Bool, 24 | alignStack :: Bool, 25 | dialect :: Dialect 26 | } 27 | deriving (Eq, Read, Show, Typeable, Data) 28 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/IntegerPredicate.hs: -------------------------------------------------------------------------------- 1 | -- | Predicates for the 'LLVM.General.AST.Instruction.ICmp' instruction 2 | module LLVM.General.AST.IntegerPredicate where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data IntegerPredicate 8 | = EQ 9 | | NE 10 | | UGT 11 | | UGE 12 | | ULT 13 | | ULE 14 | | SGT 15 | | SGE 16 | | SLT 17 | | SLE 18 | deriving (Eq, Ord, Read, Show, Data, Typeable) 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Linkage.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'Linkage' distinctly qualified. 2 | module LLVM.General.AST.Linkage where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Linkage 8 | = Private 9 | | Internal 10 | | AvailableExternally 11 | | LinkOnce 12 | | Weak 13 | | Common 14 | | Appending 15 | | ExternWeak 16 | | LinkOnceODR 17 | | WeakODR 18 | | External 19 | deriving (Eq, Read, Show, Typeable, Data) 20 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Name.hs: -------------------------------------------------------------------------------- 1 | -- | Names as used in LLVM IR 2 | module LLVM.General.AST.Name where 3 | 4 | import LLVM.General.Prelude 5 | 6 | {- | 7 | Objects of various sorts in LLVM IR are identified by address in the LLVM C++ API, and 8 | may be given a string name. When printed to (resp. read from) human-readable LLVM assembly, objects without 9 | string names are numbered sequentially (resp. must be numbered sequentially). String names may be quoted, and 10 | are quoted when printed if they would otherwise be misread - e.g. when containing special characters. 11 | 12 | > 7 13 | 14 | means the seventh unnamed object, while 15 | 16 | > "7" 17 | 18 | means the object named with the string "7". 19 | 20 | This libraries handling of 'UnName's during translation of the AST down into C++ IR is somewhat more 21 | forgiving than the LLVM assembly parser: it does not require that unnamed values be numbered sequentially; 22 | however, the numbers of 'UnName's passed into C++ cannot be preserved in the C++ objects. If the C++ IR is 23 | printed as assembly or translated into a Haskell AST, unnamed nodes will be renumbered sequentially. Thus 24 | unnamed node numbers should be thought of as having any scope limited to the 'LLVM.General.AST.Module' in 25 | which they are used. 26 | -} 27 | data Name 28 | = Name String -- ^ a string name 29 | | UnName Word -- ^ a number for a nameless thing 30 | deriving (Eq, Ord, Read, Show, Typeable, Data) 31 | 32 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Operand.hs: -------------------------------------------------------------------------------- 1 | -- | A type to represent operands to LLVM 'LLVM.General.AST.Instruction.Instruction's 2 | module LLVM.General.AST.Operand where 3 | 4 | import LLVM.General.Prelude 5 | 6 | import LLVM.General.AST.Name 7 | import LLVM.General.AST.Constant 8 | import LLVM.General.AST.InlineAssembly 9 | import LLVM.General.AST.Type 10 | 11 | -- | A 'MetadataNodeID' is a number for identifying a metadata node. 12 | -- Note this is different from "named metadata", which are represented with 13 | -- 'LLVM.General.AST.NamedMetadataDefinition'. 14 | newtype MetadataNodeID = MetadataNodeID Word 15 | deriving (Eq, Ord, Read, Show, Typeable, Data) 16 | 17 | -- | 18 | data MetadataNode 19 | = MetadataNode [Maybe Operand] 20 | | MetadataNodeReference MetadataNodeID 21 | deriving (Eq, Ord, Read, Show, Typeable, Data) 22 | 23 | -- | An 'Operand' is roughly that which is an argument to an 'LLVM.General.AST.Instruction.Instruction' 24 | data Operand 25 | -- | %foo 26 | = LocalReference Type Name 27 | -- | 'Constant's include 'LLVM.General.AST.Constant.GlobalReference', for \@foo 28 | | ConstantOperand Constant 29 | | MetadataStringOperand String 30 | | MetadataNodeOperand MetadataNode 31 | deriving (Eq, Ord, Read, Show, Typeable, Data) 32 | 33 | -- | The 'LLVM.General.AST.Instruction.Call' instruction is special: the callee can be inline assembly 34 | type CallableOperand = Either InlineAssembly Operand 35 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/ParameterAttribute.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'ParameterAttribute' distinctly qualified. 2 | module LLVM.General.AST.ParameterAttribute where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data ParameterAttribute 8 | = ZeroExt 9 | | SignExt 10 | | InReg 11 | | SRet 12 | | Alignment Word64 13 | | NoAlias 14 | | ByVal 15 | | NoCapture 16 | | Nest 17 | | ReadNone 18 | | ReadOnly 19 | | InAlloca 20 | | NonNull 21 | | Dereferenceable Word64 22 | | Returned 23 | deriving (Eq, Ord, Read, Show, Typeable, Data) 24 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/RMWOperation.hs: -------------------------------------------------------------------------------- 1 | -- | Operations for the 'LLVM.General.AST.Instruction.AtomicRMW' instruction 2 | module LLVM.General.AST.RMWOperation where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data RMWOperation 8 | = Xchg 9 | | Add 10 | | Sub 11 | | And 12 | | Nand 13 | | Or 14 | | Xor 15 | | Max 16 | | Min 17 | | UMax 18 | | UMin 19 | deriving (Eq, Ord, Read, Show, Data, Typeable) 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/ThreadLocalStorage.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'ThreadLocalStorage.Model' distinctly qualified. 2 | module LLVM.General.AST.ThreadLocalStorage where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Model 8 | = GeneralDynamic 9 | | LocalDynamic 10 | | InitialExec 11 | | LocalExec 12 | deriving (Eq, Ord, Read, Show, Typeable, Data) 13 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Type.hs: -------------------------------------------------------------------------------- 1 | -- | A representation of an LLVM type 2 | module LLVM.General.AST.Type where 3 | 4 | import LLVM.General.Prelude 5 | 6 | import LLVM.General.AST.AddrSpace 7 | import LLVM.General.AST.Name 8 | 9 | -- | LLVM supports some special formats floating point format. This type is to distinguish those format. 10 | -- I believe it's treated as a format for "a" float, as opposed to a vector of two floats, because 11 | -- its intended usage is to represent a single number with a combined significand. 12 | data FloatingPointFormat 13 | = IEEE 14 | | DoubleExtended 15 | | PairOfFloats 16 | deriving (Eq, Ord, Read, Show, Typeable, Data) 17 | 18 | -- | 19 | data Type 20 | -- | 21 | = VoidType 22 | -- | 23 | | IntegerType { typeBits :: Word32 } 24 | -- | 25 | | PointerType { pointerReferent :: Type, pointerAddrSpace :: AddrSpace } 26 | -- | 27 | | FloatingPointType { typeBits :: Word32, floatingPointFormat :: FloatingPointFormat } 28 | -- | 29 | | FunctionType { resultType :: Type, argumentTypes :: [Type], isVarArg :: Bool } 30 | -- | 31 | | VectorType { nVectorElements :: Word32, elementType :: Type } 32 | -- | 33 | | StructureType { isPacked :: Bool, elementTypes :: [Type] } 34 | -- | 35 | | ArrayType { nArrayElements :: Word64, elementType :: Type } 36 | -- | 37 | | NamedTypeReference Name 38 | -- | 39 | | MetadataType -- only to be used as a parameter type for a few intrinsics 40 | deriving (Eq, Ord, Read, Show, Typeable, Data) 41 | 42 | -- | An abbreviation for 'VoidType' 43 | void :: Type 44 | void = VoidType 45 | 46 | -- | An abbreviation for 'IntegerType' 1 47 | i1 :: Type 48 | i1 = IntegerType 1 49 | 50 | -- | An abbreviation for 'IntegerType' 8 51 | i8 :: Type 52 | i8 = IntegerType 8 53 | 54 | -- | An abbreviation for 'IntegerType' 16 55 | i16 :: Type 56 | i16 = IntegerType 16 57 | 58 | -- | An abbreviation for 'IntegerType' 32 59 | i32 :: Type 60 | i32 = IntegerType 32 61 | 62 | -- | An abbreviation for 'IntegerType' 64 63 | i64 :: Type 64 | i64 = IntegerType 64 65 | 66 | -- | An abbreviation for 'IntegerType' 128 67 | i128 :: Type 68 | i128 = IntegerType 128 69 | 70 | -- | An abbreviation for 'PointerType' t ('AddrSpace' 0) 71 | ptr :: Type -> Type 72 | ptr t = PointerType t (AddrSpace 0) 73 | 74 | -- | An abbreviation for 'FloatingPointType' 16 'IEEE' 75 | half :: Type 76 | half = FloatingPointType 16 IEEE 77 | 78 | -- | An abbreviation for 'FloatingPointType' 32 'IEEE' 79 | float :: Type 80 | float = FloatingPointType 32 IEEE 81 | 82 | -- | An abbreviation for 'FloatingPointType' 64 'IEEE' 83 | double :: Type 84 | double = FloatingPointType 64 IEEE 85 | 86 | -- | An abbreviation for 'FloatingPointType' 128 'IEEE' 87 | fp128 :: Type 88 | fp128 = FloatingPointType 128 IEEE 89 | 90 | -- | An abbreviation for 'FloatingPointType' 80 'DoubleExtended' 91 | x86_fp80 :: Type 92 | x86_fp80 = FloatingPointType 80 DoubleExtended 93 | 94 | -- | An abbreviation for 'FloatingPointType' 128 'PairOfFloats' 95 | ppc_fp128 :: Type 96 | ppc_fp128 = FloatingPointType 128 PairOfFloats 97 | 98 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/AST/Visibility.hs: -------------------------------------------------------------------------------- 1 | -- | Module to allow importing 'Visibility' distinctly qualified. 2 | module LLVM.General.AST.Visibility where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Visibility = Default | Hidden | Protected 8 | deriving (Eq, Read, Show, Typeable, Data) 9 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- | This module is presents a prelude mostly like the post-Applicative-Monad world of 2 | -- base >= 4.8 / ghc >= 7.10, even on earlier versions. It's intended as an internal library 3 | -- for llvm-general-pure and llvm-general; it's exposed only to be shared between the two. 4 | module LLVM.General.Prelude ( 5 | module Prelude, 6 | module Data.Data, 7 | module Data.Int, 8 | module Data.Word, 9 | module Data.Functor, 10 | module Data.Foldable, 11 | module Data.Traversable, 12 | module Control.Applicative, 13 | module Control.Monad 14 | ) where 15 | 16 | import Prelude hiding ( 17 | mapM, mapM_, 18 | sequence, sequence_, 19 | concat, 20 | foldr, foldr1, foldl, foldl1, 21 | minimum, maximum, sum, product, all, any, and, or, 22 | concatMap, 23 | elem, notElem, 24 | msum, 25 | ) 26 | import Data.Data hiding (typeOf) 27 | import Data.Int 28 | import Data.Word 29 | import Data.Functor 30 | import Data.Foldable 31 | import Data.Traversable 32 | import Control.Applicative 33 | import Control.Monad hiding ( 34 | forM, forM_, 35 | mapM, mapM_, 36 | sequence, sequence_, 37 | msum 38 | ) 39 | -------------------------------------------------------------------------------- /llvm-general-pure/src/LLVM/General/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- | This module is presents template haskell mostly like the template-haskell >= 2.10 / ghc >= 7.10, 3 | -- even on earlier versions. It's intended as an internal library for llvm-general-pure and llvm-general; 4 | -- it's exposed only to be shared between the two. 5 | module LLVM.General.TH ( 6 | module Language.Haskell.TH, 7 | conT, appT 8 | ) where 9 | 10 | #if __GLASGOW_HASKELL__ < 710 11 | import LLVM.General.Prelude 12 | #endif 13 | 14 | import qualified Language.Haskell.TH as TH (conT, appT) 15 | import Language.Haskell.TH hiding (conT, appT) 16 | 17 | class Typish qt where 18 | appT :: qt -> Q Type -> qt 19 | conT :: Name -> qt 20 | 21 | instance Typish (Q Type) where 22 | appT = TH.appT 23 | conT = TH.conT 24 | 25 | #if __GLASGOW_HASKELL__ < 710 26 | instance Typish (Q Pred) where 27 | appT qp qt = do 28 | ClassP n ts <- qp 29 | t <- qt 30 | return $ ClassP n (ts ++ [t]) 31 | conT n = classP n [] 32 | #endif 33 | -------------------------------------------------------------------------------- /llvm-general-pure/test/LLVM/General/Test/DataLayout.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.DataLayout where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import Control.Monad.Except 8 | 9 | import Data.Maybe 10 | import qualified Data.Set as Set 11 | import qualified Data.Map as Map 12 | 13 | import LLVM.General.AST 14 | import LLVM.General.AST.DataLayout 15 | import LLVM.General.AST.AddrSpace 16 | import LLVM.General.DataLayout 17 | 18 | ddl = defaultDataLayout LittleEndian 19 | 20 | tests = testGroup "DataLayout" [ 21 | testCase name $ do 22 | let Right parsed = runExcept $ parseDataLayout LittleEndian strDl 23 | (dataLayoutToString astDl, parsed) @?= (strDl, Just astDl) 24 | | (name, astDl, strDl) <- [ 25 | ("little-endian", ddl, "e"), 26 | ("big-endian", defaultDataLayout BigEndian, "E"), 27 | ("native", ddl { nativeSizes = Just (Set.fromList [8,32]) }, "e-n8:32"), 28 | ( 29 | "no pref", 30 | ddl { 31 | pointerLayouts = 32 | Map.singleton 33 | (AddrSpace 0) 34 | ( 35 | 8, 36 | AlignmentInfo { 37 | abiAlignment = 64, 38 | preferredAlignment = Nothing 39 | } 40 | ) 41 | }, 42 | "e-p:8:64" 43 | ), ( 44 | "pref", 45 | ddl { 46 | pointerLayouts = 47 | Map.insert (AddrSpace 1) (8, AlignmentInfo 32 (Just 64)) (pointerLayouts ddl) 48 | }, 49 | "e-p1:8:32:64" 50 | ), ( 51 | "def", 52 | ddl { pointerLayouts = Map.singleton (AddrSpace 0) (64, AlignmentInfo 64 (Just 64)) }, 53 | "e" 54 | ), ( 55 | "big", 56 | ddl { 57 | endianness = LittleEndian, 58 | mangling = Just ELFMangling, 59 | stackAlignment = Just 128, 60 | pointerLayouts = Map.fromList [ 61 | (AddrSpace 0, (8, AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 16})) 62 | ], 63 | typeLayouts = Map.fromList [ 64 | ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}), 65 | ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}), 66 | ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 256}), 67 | ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}), 68 | ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 69 | ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 70 | ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256}), 71 | ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}), 72 | ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 73 | ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256}) 74 | ] `Map.union` typeLayouts ddl, 75 | aggregateLayout = AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 256}, 76 | nativeSizes = Just (Set.fromList [8,16,32,64]) 77 | }, 78 | "e-m:e-p:8:8:16-i1:8:256-i8:8:256-i16:16:256-i32:32:256-i64:64:256-v64:64:256-v128:128:256-f32:32:256-f64:64:256-f80:128:256-a:0:256-n8:16:32:64-S128" 79 | ) 80 | ] 81 | ] 82 | -------------------------------------------------------------------------------- /llvm-general-pure/test/LLVM/General/Test/Tests.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Tests where 2 | 3 | import Test.Framework 4 | 5 | import qualified LLVM.General.Test.DataLayout as DataLayout 6 | import qualified LLVM.General.Test.PrettyPrint as PrettyPrint 7 | 8 | tests = testGroup "llvm-general" [ 9 | DataLayout.tests, 10 | PrettyPrint.tests 11 | ] 12 | -------------------------------------------------------------------------------- /llvm-general-pure/test/Test.hs: -------------------------------------------------------------------------------- 1 | import Test.Framework 2 | import qualified LLVM.General.Test.Tests as LLVM.General 3 | 4 | main = defaultMain [ 5 | LLVM.General.tests 6 | ] 7 | -------------------------------------------------------------------------------- /llvm-general/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Benjamin S. Scarlet and Google Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Benjamin S. Scarlet nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /llvm-general/src/Control/Monad/AnyCont.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses, 3 | UndecidableInstances 4 | #-} 5 | module Control.Monad.AnyCont ( 6 | MonadAnyCont(..), 7 | ScopeAnyCont(..), 8 | AnyContT(..), 9 | MonadTransAnyCont(..), 10 | runAnyContT, 11 | withAnyContT, 12 | mapAnyContT 13 | ) where 14 | 15 | import Prelude 16 | 17 | import Control.Monad.Trans.AnyCont 18 | import Control.Monad.AnyCont.Class 19 | import Control.Monad.Trans.Class 20 | import Control.Monad.State.Class 21 | import Control.Monad.Error.Class 22 | 23 | instance MonadState s m => MonadState s (AnyContT m) where 24 | get = lift get 25 | put = lift . put 26 | state = lift . state 27 | 28 | instance MonadError e m => MonadError e (AnyContT m) where 29 | throwError = lift . throwError 30 | x `catchError` h = anyContT $ \f -> (runAnyContT x f) `catchError` (\e -> runAnyContT (h e) f) 31 | -------------------------------------------------------------------------------- /llvm-general/src/Control/Monad/AnyCont/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | RankNTypes, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | module Control.Monad.AnyCont.Class where 7 | 8 | import Prelude 9 | 10 | import Control.Monad.Trans.Class 11 | import Control.Monad.Trans.AnyCont (AnyContT) 12 | import qualified Control.Monad.Trans.AnyCont as AnyCont 13 | import Control.Monad.Trans.Except as Except 14 | import Control.Monad.Trans.State as State 15 | import Control.Monad.Exceptable as Exceptable 16 | 17 | class ScopeAnyCont m where 18 | scopeAnyCont :: m a -> m a 19 | 20 | class MonadAnyCont b m where 21 | anyContToM :: (forall r . (a -> b r) -> b r) -> m a 22 | 23 | 24 | instance MonadTransAnyCont b m => MonadAnyCont b (AnyContT m) where 25 | anyContToM c = AnyCont.anyContT (liftAnyCont c) 26 | 27 | instance Monad m => ScopeAnyCont (AnyContT m) where 28 | scopeAnyCont = lift . flip AnyCont.runAnyContT return 29 | 30 | 31 | instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (StateT s m) where 32 | anyContToM x = lift $ anyContToM x 33 | 34 | instance ScopeAnyCont m => ScopeAnyCont (StateT s m) where 35 | scopeAnyCont = StateT . (scopeAnyCont .) . runStateT 36 | 37 | 38 | instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (ExceptT e m) where 39 | anyContToM x = lift $ anyContToM x 40 | 41 | instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (Exceptable.ExceptableT e m) where 42 | anyContToM x = lift $ anyContToM x 43 | 44 | 45 | instance ScopeAnyCont m => ScopeAnyCont (ExceptT e m) where 46 | scopeAnyCont = mapExceptT scopeAnyCont 47 | 48 | instance ScopeAnyCont m => ScopeAnyCont (Exceptable.ExceptableT e m) where 49 | scopeAnyCont = Exceptable.mapExceptableT scopeAnyCont 50 | 51 | class MonadTransAnyCont b m where 52 | liftAnyCont :: (forall r . (a -> b r) -> b r) -> (forall r . (a -> m r) -> m r) 53 | 54 | instance MonadTransAnyCont b b where 55 | liftAnyCont c = c 56 | 57 | instance MonadTransAnyCont b m => MonadTransAnyCont b (StateT s m) where 58 | liftAnyCont c = (\c q -> StateT $ \s -> c $ ($ s) . runStateT . q) (liftAnyCont c) 59 | 60 | instance MonadTransAnyCont b m => MonadTransAnyCont b (ExceptT e m) where 61 | liftAnyCont c = (\c q -> ExceptT . c $ runExceptT . q) (liftAnyCont c) 62 | 63 | instance MonadTransAnyCont b m => MonadTransAnyCont b (Exceptable.ExceptableT e m) where 64 | liftAnyCont c = (\c q -> makeExceptableT . c $ Exceptable.runExceptableT . q) (liftAnyCont c) 65 | -------------------------------------------------------------------------------- /llvm-general/src/Control/Monad/Trans/AnyCont.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | RankNTypes 3 | #-} 4 | module Control.Monad.Trans.AnyCont where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Control.Monad.Cont 9 | 10 | newtype AnyContT m a = AnyContT { unAnyContT :: forall r . ContT r m a } 11 | 12 | instance Functor (AnyContT m) where 13 | fmap f p = AnyContT $ fmap f . unAnyContT $ p 14 | 15 | instance Applicative (AnyContT m) where 16 | pure a = AnyContT $ pure a 17 | f <*> v = AnyContT $ unAnyContT f <*> unAnyContT v 18 | 19 | instance Monad m => Monad (AnyContT m) where 20 | AnyContT f >>= k = AnyContT $ f >>= unAnyContT . k 21 | return a = AnyContT $ return a 22 | fail s = AnyContT (ContT (\_ -> fail s)) 23 | 24 | instance MonadIO m => MonadIO (AnyContT m) where 25 | liftIO = lift . liftIO 26 | 27 | instance MonadTrans AnyContT where 28 | lift ma = AnyContT (lift ma) 29 | 30 | runAnyContT :: AnyContT m a -> (forall r . (a -> m r) -> m r) 31 | runAnyContT = runContT . unAnyContT 32 | anyContT :: (forall r . (a -> m r) -> m r) -> AnyContT m a 33 | anyContT f = AnyContT (ContT f) 34 | 35 | withAnyContT :: (forall r . (b -> m r) -> (a -> m r)) -> AnyContT m a -> AnyContT m b 36 | withAnyContT f m = anyContT $ runAnyContT m . f 37 | 38 | mapAnyContT :: (forall r . m r -> m r) -> AnyContT m a -> AnyContT m a 39 | mapAnyContT f m = anyContT $ f . runAnyContT m 40 | 41 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General.hs: -------------------------------------------------------------------------------- 1 | -- | An interface to use LLVM in all capacities 2 | module LLVM.General ( 3 | module LLVM.General.Module 4 | ) where 5 | 6 | import LLVM.General.Module 7 | 8 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Analysis.hs: -------------------------------------------------------------------------------- 1 | -- | functionality for analyzing 'LLVM.General.Module.Module's. Much of the analysis 2 | -- possible with LLVM is managed internally, as needed by 'Transforms', and so is not 3 | -- yet exposed here. 4 | module LLVM.General.Analysis ( 5 | verify 6 | ) where 7 | 8 | import LLVM.General.Internal.Analysis 9 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/CodeGenOpt.hs: -------------------------------------------------------------------------------- 1 | -- | Code generation options, used in specifying TargetMachine 2 | module LLVM.General.CodeGenOpt where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Level 8 | = None 9 | | Less 10 | | Default 11 | | Aggressive 12 | deriving (Eq, Ord, Read, Show, Typeable, Data) 13 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/CodeModel.hs: -------------------------------------------------------------------------------- 1 | -- | Relocations, used in specifying TargetMachine 2 | module LLVM.General.CodeModel where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Model 8 | = Default 9 | | JITDefault 10 | | Small 11 | | Kernel 12 | | Medium 13 | | Large 14 | deriving (Eq, Read, Show, Typeable, Data) 15 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/CommandLine.hs: -------------------------------------------------------------------------------- 1 | -- | Tools for processing command line arguments, for command line tools build 2 | -- with llvm (or for other uses forced into pretending to be such to get at (ack) 3 | -- global state). 4 | module LLVM.General.CommandLine ( 5 | parseCommandLineOptions 6 | ) where 7 | 8 | import LLVM.General.Internal.CommandLine -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Context.hs: -------------------------------------------------------------------------------- 1 | -- | functions for the LLVM Context object which holds thread-scope state 2 | module LLVM.General.Context ( 3 | Context, 4 | withContext 5 | ) where 6 | 7 | import LLVM.General.Internal.Context -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Diagnostic.hs: -------------------------------------------------------------------------------- 1 | -- | Diagnostics describe parse errors 2 | module LLVM.General.Diagnostic ( 3 | DiagnosticKind(..), 4 | Diagnostic(..), 5 | diagnosticDisplay 6 | ) where 7 | 8 | import LLVM.General.Prelude 9 | 10 | -- | What kind of problem does a diagnostic describe? 11 | data DiagnosticKind 12 | = ErrorKind 13 | | WarningKind 14 | | NoteKind 15 | deriving (Eq, Ord, Read, Show, Typeable, Data) 16 | 17 | -- | A 'Diagnostic' described a problem during parsing of LLVM IR 18 | data Diagnostic = Diagnostic { 19 | lineNumber :: Int, 20 | columnNumber :: Int, 21 | diagnosticKind :: DiagnosticKind, 22 | filename :: String, 23 | message :: String, 24 | lineContents :: String 25 | } 26 | deriving (Eq, Ord, Read, Show) 27 | 28 | -- | Convert a 'Diagnostic' to a printable form. 29 | diagnosticDisplay :: Diagnostic -> String 30 | diagnosticDisplay d = 31 | (filename d) ++ ":" ++ show (lineNumber d) ++ ":" ++ show (columnNumber d) 32 | ++ ":\n" ++ show (diagnosticKind d) ++ ": " ++ (message d) ++ "\n" 33 | ++ (lineContents d) ++ "\n" 34 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/ExecutionEngine.hs: -------------------------------------------------------------------------------- 1 | -- | Tools for JIT execution 2 | module LLVM.General.ExecutionEngine ( 3 | ExecutionEngine(..), 4 | ExecutableModule, 5 | JIT, withJIT, 6 | MCJIT, withMCJIT 7 | ) where 8 | 9 | import LLVM.General.Internal.ExecutionEngine 10 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Analysis.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.Analysis where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.Exceptable 6 | import Control.Monad.AnyCont 7 | 8 | import qualified LLVM.General.Internal.FFI.Analysis as FFI 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | 11 | import LLVM.General.Internal.Module 12 | import LLVM.General.Internal.Coding 13 | 14 | -- | Run basic sanity checks on a 'Module'. Note that the same checks will trigger assertions 15 | -- within LLVM if LLVM was built with them turned on, before this function can be is called. 16 | verify :: Module -> ExceptT String IO () 17 | verify (Module m) = unExceptableT $ flip runAnyContT return $ do 18 | errorPtr <- alloca 19 | result <- decodeM =<< (liftIO $ FFI.verifyModule m FFI.verifierFailureActionReturnStatus errorPtr) 20 | when result $ throwError =<< decodeM errorPtr 21 | 22 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Atomicity.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.Atomicity where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Data.Maybe 10 | 11 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 12 | 13 | import LLVM.General.Internal.Coding 14 | import qualified LLVM.General.AST as A 15 | 16 | genCodingInstance [t| Maybe A.MemoryOrdering |] ''FFI.MemoryOrdering [ 17 | (FFI.memoryOrderingNotAtomic, Nothing), 18 | (FFI.memoryOrderingUnordered, Just A.Unordered), 19 | (FFI.memoryOrderingMonotonic, Just A.Monotonic), 20 | (FFI.memoryOrderingAcquire, Just A.Acquire), 21 | (FFI.memoryOrderingRelease, Just A.Release), 22 | (FFI.memoryOrderingAcquireRelease, Just A.AcquireRelease), 23 | (FFI.memoryOrderingSequentiallyConsistent, Just A.SequentiallyConsistent) 24 | ] 25 | 26 | genCodingInstance [t| A.SynchronizationScope |] ''FFI.SynchronizationScope [ 27 | (FFI.synchronizationScopeSingleThread, A.SingleThread), 28 | (FFI.synchronizationScopeCrossThread, A.CrossThread) 29 | ] 30 | 31 | instance Monad m => EncodeM m (Maybe A.Atomicity) (FFI.SynchronizationScope, FFI.MemoryOrdering) where 32 | encodeM a = 33 | return (,) `ap` encodeM (maybe A.SingleThread fst a) `ap` encodeM (liftM snd a) 34 | 35 | instance Monad m => DecodeM m (Maybe A.Atomicity) (FFI.SynchronizationScope, FFI.MemoryOrdering) where 36 | decodeM (ss, ao) = return (liftM . (,)) `ap` decodeM ss `ap` decodeM ao 37 | 38 | instance Monad m => EncodeM m A.Atomicity (FFI.SynchronizationScope, FFI.MemoryOrdering) where 39 | encodeM = encodeM . Just 40 | 41 | instance Monad m => DecodeM m A.Atomicity (FFI.SynchronizationScope, FFI.MemoryOrdering) where 42 | decodeM = liftM fromJust . decodeM 43 | 44 | instance Monad m => EncodeM m A.MemoryOrdering FFI.MemoryOrdering where 45 | encodeM = encodeM . Just 46 | 47 | instance Monad m => DecodeM m A.MemoryOrdering FFI.MemoryOrdering where 48 | decodeM = liftM fromJust . decodeM 49 | 50 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/BasicBlock.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.BasicBlock where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.Trans 6 | import Foreign.Ptr 7 | 8 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 9 | import qualified LLVM.General.Internal.FFI.BasicBlock as FFI 10 | import qualified LLVM.General.Internal.FFI.Iterate as FFI 11 | 12 | import LLVM.General.Internal.DecodeAST 13 | import LLVM.General.Internal.Coding 14 | import LLVM.General.Internal.Instruction () 15 | 16 | import qualified LLVM.General.AST.Instruction as A 17 | 18 | getBasicBlockTerminator :: Ptr FFI.BasicBlock -> DecodeAST (DecodeAST (A.Named A.Terminator)) 19 | getBasicBlockTerminator = decodeM <=< (liftIO . FFI.getBasicBlockTerminator) 20 | 21 | getNamedInstructions :: Ptr FFI.BasicBlock -> DecodeAST (DecodeAST [A.Named A.Instruction]) 22 | getNamedInstructions b = do 23 | ffiInstructions <- liftIO $ FFI.getXs (FFI.getFirstInstruction b) FFI.getNextInstruction 24 | let n = length ffiInstructions 25 | liftM sequence . forM (take (n-1) ffiInstructions) $ decodeM 26 | 27 | 28 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/CallingConvention.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses, 3 | TemplateHaskell, 4 | QuasiQuotes 5 | #-} 6 | module LLVM.General.Internal.CallingConvention where 7 | 8 | import LLVM.General.Prelude 9 | 10 | import LLVM.General.Internal.Coding 11 | import Foreign.C.Types (CUInt(..)) 12 | 13 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 14 | import LLVM.General.Internal.FFI.LLVMCTypes (callingConventionP) 15 | 16 | import qualified LLVM.General.AST.CallingConvention as A.CC 17 | 18 | instance Monad m => EncodeM m A.CC.CallingConvention FFI.CallingConvention where 19 | encodeM cc = return $ 20 | case cc of 21 | A.CC.C -> FFI.callingConventionC 22 | A.CC.Fast -> FFI.callingConventionFast 23 | A.CC.Cold -> FFI.callingConventionCold 24 | A.CC.GHC -> FFI.callingConventionGHC 25 | A.CC.HiPE -> FFI.callingConventionHiPE 26 | A.CC.WebKit_JS -> FFI.callingConventionWebKit_JS 27 | A.CC.AnyReg -> FFI.callingConventionAnyReg 28 | A.CC.PreserveMost -> FFI.callingConventionPreserveMost 29 | A.CC.PreserveAll -> FFI.callingConventionPreserveAll 30 | A.CC.X86_StdCall -> FFI.callingConventionX86_StdCall 31 | A.CC.X86_FastCall -> FFI.callingConventionX86_FastCall 32 | A.CC.ARM_APCS -> FFI.callingConventionARM_APCS 33 | A.CC.ARM_AAPCS -> FFI.callingConventionARM_AAPCS 34 | A.CC.ARM_AAPCS_VFP -> FFI.callingConventionARM_AAPCS_VFP 35 | A.CC.MSP430_INTR -> FFI.callingConventionMSP430_INTR 36 | A.CC.X86_ThisCall -> FFI.callingConventionX86_ThisCall 37 | A.CC.PTX_Kernel -> FFI.callingConventionPTX_Kernel 38 | A.CC.PTX_Device -> FFI.callingConventionPTX_Device 39 | A.CC.SPIR_FUNC -> FFI.callingConventionSPIR_FUNC 40 | A.CC.SPIR_KERNEL -> FFI.callingConventionSPIR_KERNEL 41 | A.CC.Intel_OCL_BI -> FFI.callingConventionIntel_OCL_BI 42 | A.CC.X86_64_SysV -> FFI.callingConventionX86_64_SysV 43 | A.CC.X86_64_Win64 -> FFI.callingConventionX86_64_Win64 44 | A.CC.Numbered cc' -> FFI.CallingConvention (fromIntegral cc') 45 | 46 | instance Monad m => DecodeM m A.CC.CallingConvention FFI.CallingConvention where 47 | decodeM cc = return $ case cc of 48 | [callingConventionP|C|] -> A.CC.C 49 | [callingConventionP|Fast|] -> A.CC.Fast 50 | [callingConventionP|Cold|] -> A.CC.Cold 51 | [callingConventionP|GHC|] -> A.CC.GHC 52 | [callingConventionP|HiPE|] -> A.CC.HiPE 53 | [callingConventionP|WebKit_JS|] -> A.CC.WebKit_JS 54 | [callingConventionP|AnyReg|] -> A.CC.AnyReg 55 | [callingConventionP|PreserveMost|] -> A.CC.PreserveMost 56 | [callingConventionP|PreserveAll|] -> A.CC.PreserveAll 57 | [callingConventionP|X86_StdCall|] -> A.CC.X86_StdCall 58 | [callingConventionP|X86_FastCall|] -> A.CC.X86_FastCall 59 | [callingConventionP|ARM_APCS|] -> A.CC.ARM_APCS 60 | [callingConventionP|ARM_AAPCS|] -> A.CC.ARM_AAPCS 61 | [callingConventionP|ARM_AAPCS_VFP|] -> A.CC.ARM_AAPCS_VFP 62 | [callingConventionP|MSP430_INTR|] -> A.CC.MSP430_INTR 63 | [callingConventionP|X86_ThisCall|] -> A.CC.X86_ThisCall 64 | [callingConventionP|PTX_Kernel|] -> A.CC.PTX_Kernel 65 | [callingConventionP|PTX_Device|] -> A.CC.PTX_Device 66 | [callingConventionP|SPIR_FUNC|] -> A.CC.SPIR_FUNC 67 | [callingConventionP|SPIR_KERNEL|] -> A.CC.SPIR_KERNEL 68 | [callingConventionP|Intel_OCL_BI|] -> A.CC.Intel_OCL_BI 69 | [callingConventionP|X86_64_SysV|] -> A.CC.X86_64_SysV 70 | [callingConventionP|X86_64_Win64|] -> A.CC.X86_64_Win64 71 | FFI.CallingConvention (CUInt ci) | ci >= 64 -> A.CC.Numbered (fromIntegral ci) 72 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Coding.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses, 4 | FunctionalDependencies, 5 | UndecidableInstances 6 | #-} 7 | module LLVM.General.Internal.Coding where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Language.Haskell.TH 12 | import Language.Haskell.TH.Quote 13 | 14 | import Control.Monad.AnyCont 15 | import Control.Monad.IO.Class 16 | 17 | import Foreign.C 18 | import Foreign.Ptr 19 | import Foreign.Storable 20 | import Foreign.Marshal.Alloc 21 | import Foreign.Marshal.Array 22 | 23 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 24 | 25 | class EncodeM e h c where 26 | encodeM :: h -> e c 27 | 28 | class DecodeM d h c where 29 | decodeM :: c -> d h 30 | 31 | genCodingInstance :: (Data c, Data h) => TypeQ -> Name -> [(c, h)] -> Q [Dec] 32 | genCodingInstance ht ctn chs = do 33 | let n = const Nothing 34 | [d| 35 | instance Monad m => EncodeM m $(ht) $(conT ctn) where 36 | encodeM h = return $ $( 37 | caseE [| h |] [ match (dataToPatQ n h) (normalB (dataToExpQ n c)) [] | (c,h) <- chs ] 38 | ) 39 | 40 | instance Monad m => DecodeM m $(ht) $(conT ctn) where 41 | decodeM c = return $ $( 42 | caseE [| c |] [ match (dataToPatQ n c) (normalB (dataToExpQ n h)) [] | (c,h) <- chs ] 43 | ) 44 | |] 45 | 46 | allocaArray :: (Integral i, Storable a, MonadAnyCont IO m) => i -> m (Ptr a) 47 | allocaArray p = anyContToM $ Foreign.Marshal.Array.allocaArray (fromIntegral p) 48 | 49 | alloca :: (Storable a, MonadAnyCont IO m) => m (Ptr a) 50 | alloca = anyContToM Foreign.Marshal.Alloc.alloca 51 | 52 | peek :: (Storable a, MonadIO m) => Ptr a -> m a 53 | peek p = liftIO $ Foreign.Storable.peek p 54 | 55 | peekByteOff :: (Storable a, MonadIO m) => Ptr a -> Int -> m a 56 | peekByteOff p i = liftIO $ Foreign.Storable.peekByteOff p i 57 | 58 | poke :: (Storable a, MonadIO m) => Ptr a -> a -> m () 59 | poke p a = liftIO $ Foreign.Storable.poke p a 60 | 61 | pokeByteOff :: (Storable a, MonadIO m) => Ptr a -> Int -> a -> m () 62 | pokeByteOff p i a = liftIO $ Foreign.Storable.pokeByteOff p i a 63 | 64 | peekArray :: (Integral i, Storable a, MonadIO m) => i -> Ptr a -> m [a] 65 | peekArray n p = liftIO $ Foreign.Marshal.Array.peekArray (fromIntegral n) p 66 | 67 | instance (Monad m, EncodeM m h c, Storable c, MonadAnyCont IO m) => EncodeM m [h] (CUInt, Ptr c) where 68 | encodeM hs = do 69 | hs <- mapM encodeM hs 70 | (anyContToM $ \x -> Foreign.Marshal.Array.withArrayLen hs $ \n hs -> x (fromIntegral n, hs)) 71 | 72 | instance (Monad m, DecodeM m h c, Storable c, MonadIO m) => DecodeM m [h] (CUInt, Ptr c) where 73 | decodeM (n, ca) = do 74 | cs <- liftIO $ Foreign.Marshal.Array.peekArray (fromIntegral n) ca 75 | mapM decodeM cs 76 | 77 | instance Monad m => EncodeM m Bool FFI.LLVMBool where 78 | encodeM False = return $ FFI.LLVMBool 0 79 | encodeM True = return $ FFI.LLVMBool 1 80 | 81 | instance Monad m => DecodeM m Bool FFI.LLVMBool where 82 | decodeM (FFI.LLVMBool 0) = return $ False 83 | decodeM (FFI.LLVMBool _) = return $ True 84 | 85 | instance (Monad m, EncodeM m h (Ptr c)) => EncodeM m (Maybe h) (Ptr c) where 86 | encodeM = maybe (return nullPtr) encodeM 87 | 88 | instance (Monad m, DecodeM m h (Ptr c)) => DecodeM m (Maybe h) (Ptr c) where 89 | decodeM p | p == nullPtr = return Nothing 90 | | otherwise = liftM Just $ decodeM p 91 | 92 | instance Monad m => EncodeM m (Maybe Bool) (FFI.NothingAsMinusOne Bool) where 93 | encodeM = return . FFI.NothingAsMinusOne . maybe (-1) (fromIntegral . fromEnum) 94 | 95 | instance Monad m => EncodeM m (Maybe Word) (FFI.NothingAsMinusOne Word) where 96 | encodeM = return . FFI.NothingAsMinusOne . maybe (-1) fromIntegral 97 | 98 | instance Monad m => EncodeM m Word CUInt where 99 | encodeM = return . fromIntegral 100 | 101 | instance Monad m => EncodeM m Word32 CUInt where 102 | encodeM = return . fromIntegral 103 | 104 | instance Monad m => EncodeM m Word64 CULong where 105 | encodeM = return . fromIntegral 106 | 107 | instance Monad m => DecodeM m Word32 CUInt where 108 | decodeM = return . fromIntegral 109 | 110 | instance Monad m => DecodeM m Word64 CULong where 111 | decodeM = return . fromIntegral 112 | 113 | instance Monad m => EncodeM m Int32 CInt where 114 | encodeM = return . fromIntegral 115 | 116 | instance Monad m => DecodeM m Int32 CInt where 117 | decodeM = return . fromIntegral 118 | 119 | instance Monad m => DecodeM m Int CInt where 120 | decodeM = return . fromIntegral 121 | 122 | instance Monad m => EncodeM m Word64 Word64 where 123 | encodeM = return 124 | 125 | instance Monad m => DecodeM m Word64 Word64 where 126 | decodeM = return 127 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/CommandLine.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.CommandLine where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.AnyCont 6 | import Control.Monad.IO.Class 7 | 8 | import Foreign.Ptr 9 | 10 | import qualified LLVM.General.Internal.FFI.CommandLine as FFI 11 | 12 | import LLVM.General.Internal.Coding 13 | import LLVM.General.Internal.String () 14 | 15 | -- | 16 | -- Sadly, there is occasionally some configuration one would like to control 17 | -- in LLVM which are accessible only as command line flags setting global state, 18 | -- as if the command line tools were the only use of LLVM. Very sad. 19 | parseCommandLineOptions :: [String] -> Maybe String -> IO () 20 | parseCommandLineOptions args overview = flip runAnyContT return $ do 21 | args <- encodeM args 22 | overview <- maybe (return nullPtr) encodeM overview 23 | liftIO $ FFI.parseCommandLineOptions args overview 24 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Context.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.Context where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Exception 6 | import Control.Concurrent 7 | 8 | import Foreign.Ptr 9 | 10 | import qualified LLVM.General.Internal.FFI.Context as FFI 11 | 12 | -- | a Context object holds the state the of LLVM system needs for one thread of 13 | -- | LLVM compilation. Once upon a time, in early versions of LLVM, this state was global. 14 | -- | Then it got packed up in this object to allow multiple threads to compile at once. 15 | data Context = Context (Ptr FFI.Context) 16 | 17 | -- | Create a Context, run an action (to which it is provided), then destroy the Context. 18 | withContext :: (Context -> IO a) -> IO a 19 | withContext = runBound . bracket FFI.contextCreate FFI.contextDispose . (. Context) 20 | where runBound = if rtsSupportsBoundThreads then runInBoundThread else id 21 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/DataLayout.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.DataLayout where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.Exceptable 6 | import Control.Monad.AnyCont 7 | import Control.Exception 8 | 9 | import Foreign.Ptr 10 | 11 | import qualified LLVM.General.Internal.FFI.DataLayout as FFI 12 | 13 | import LLVM.General.AST.DataLayout 14 | import LLVM.General.DataLayout 15 | 16 | import LLVM.General.Internal.Coding 17 | import LLVM.General.Internal.String () 18 | 19 | withFFIDataLayout :: DataLayout -> (Ptr FFI.DataLayout -> IO a) -> IO a 20 | withFFIDataLayout dl f = flip runAnyContT return $ do 21 | dls <- encodeM (dataLayoutToString dl) 22 | liftIO $ bracket (FFI.createDataLayout dls) FFI.disposeDataLayout f 23 | 24 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Diagnostic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.Diagnostic where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | import qualified LLVM.General.Internal.FFI.SMDiagnostic as FFI 11 | 12 | import Control.Exception 13 | 14 | import Foreign.Ptr 15 | 16 | import LLVM.General.Diagnostic 17 | import LLVM.General.Internal.Coding 18 | import LLVM.General.Internal.String () 19 | 20 | genCodingInstance [t| DiagnosticKind |] ''FFI.DiagnosticKind [ 21 | (FFI.diagnosticKindError, ErrorKind), 22 | (FFI.diagnosticKindWarning, WarningKind), 23 | (FFI.diagnosticKindNote, NoteKind) 24 | ] 25 | 26 | withSMDiagnostic :: (Ptr FFI.SMDiagnostic -> IO a) -> IO a 27 | withSMDiagnostic = bracket FFI.createSMDiagnostic FFI.disposeSMDiagnostic 28 | 29 | getDiagnostic :: Ptr FFI.SMDiagnostic -> IO Diagnostic 30 | getDiagnostic p = do 31 | l <- decodeM =<< FFI.getSMDiagnosticLineNo p 32 | c <- decodeM =<< FFI.getSMDiagnosticColumnNo p 33 | k <- decodeM =<< FFI.getSMDiagnosticKind p 34 | f <- decodeM $ FFI.getSMDiagnosticFilename p 35 | m <- decodeM $ FFI.getSMDiagnosticMessage p 36 | lc <- decodeM $ FFI.getSMDiagnosticLineContents p 37 | return $ Diagnostic { 38 | lineNumber = l, columnNumber = c, diagnosticKind = k, filename = f, message = m, lineContents = lc 39 | } 40 | 41 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Analysis.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__ANALYSIS__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__ANALYSIS__H__ 3 | 4 | #include "llvm-c/Analysis.h" 5 | 6 | #define LLVM_GENERAL_FOR_EACH_VERIFIER_FAILURE_ACTION(macro) \ 7 | macro(AbortProcess) \ 8 | macro(PrintMessage) \ 9 | macro(ReturnStatus) 10 | 11 | #endif 12 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Analysis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.Analysis where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.Ptr 9 | import Foreign.C 10 | 11 | import LLVM.General.Internal.FFI.LLVMCTypes 12 | import LLVM.General.Internal.FFI.Module 13 | 14 | foreign import ccall unsafe "LLVMVerifyModule" verifyModule :: 15 | Ptr Module -> VerifierFailureAction -> Ptr (OwnerTransfered CString) -> IO LLVMBool 16 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Assembly.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | -- | Functions to read and write textual LLVM assembly 6 | module LLVM.General.Internal.FFI.Assembly where 7 | 8 | import LLVM.General.Prelude 9 | 10 | import LLVM.General.Internal.FFI.Context 11 | import LLVM.General.Internal.FFI.MemoryBuffer 12 | import LLVM.General.Internal.FFI.Module 13 | import LLVM.General.Internal.FFI.RawOStream 14 | import LLVM.General.Internal.FFI.SMDiagnostic 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | 17 | import Foreign.Ptr 18 | 19 | -- | Use LLVM's parser to parse a string of llvm assembly in a memory buffer to get a module 20 | foreign import ccall unsafe "LLVM_General_ParseLLVMAssembly" parseLLVMAssembly :: 21 | Ptr Context -> OwnerTransfered (Ptr MemoryBuffer) -> Ptr SMDiagnostic -> IO (Ptr Module) 22 | 23 | -- | LLVM's serializer to generate a string of llvm assembly from a module 24 | foreign import ccall unsafe "LLVM_General_WriteLLVMAssembly" writeLLVMAssembly :: 25 | Ptr Module -> Ptr RawOStream -> IO () 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/AssemblyC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm/IR/Module.h" 4 | #include "llvm/AsmParser/Parser.h" 5 | #include "llvm/Pass.h" 6 | #include "llvm/Support/SourceMgr.h" 7 | #include "llvm/Support/raw_ostream.h" 8 | #include "llvm/Support/MemoryBuffer.h" 9 | 10 | #include "llvm-c/Core.h" 11 | 12 | using namespace llvm; 13 | 14 | extern "C" { 15 | 16 | LLVMModuleRef LLVM_General_ParseLLVMAssembly( 17 | LLVMContextRef context, 18 | LLVMMemoryBufferRef memoryBuffer, 19 | SMDiagnostic *error 20 | ) { 21 | return wrap(ParseAssembly(unwrap(memoryBuffer), NULL, *error, *unwrap(context))); 22 | } 23 | 24 | void LLVM_General_WriteLLVMAssembly(LLVMModuleRef module, raw_ostream &os) { 25 | os << *unwrap(module); 26 | } 27 | 28 | } 29 | 30 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Attribute.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__ATTRIBUTES__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__ATTRIBUTES__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(macro) \ 5 | macro(None,F,F,F) \ 6 | macro(Alignment,T,F,F) \ 7 | macro(AlwaysInline,F,F,T) \ 8 | macro(Builtin,F,F,T) \ 9 | macro(ByVal,T,F,F) \ 10 | macro(InAlloca,T,F,F) \ 11 | macro(Cold,F,F,T) \ 12 | macro(InlineHint,F,F,T) \ 13 | macro(InReg,T,T,F) \ 14 | macro(JumpTable,F,F,T) \ 15 | macro(MinSize,F,F,T) \ 16 | macro(Naked,F,F,T) \ 17 | macro(Nest,T,F,F) \ 18 | macro(NoAlias,T,T,F) \ 19 | macro(NoBuiltin,F,F,T) \ 20 | macro(NoCapture,T,F,F) \ 21 | macro(NoDuplicate,F,F,T) \ 22 | macro(NoImplicitFloat,F,F,T) \ 23 | macro(NoInline,F,F,T) \ 24 | macro(NonLazyBind,F,F,T) \ 25 | macro(NonNull,T,T,F) \ 26 | macro(Dereferenceable,T,T,F) \ 27 | macro(NoRedZone,F,F,T) \ 28 | macro(NoReturn,F,F,T) \ 29 | macro(NoUnwind,F,F,T) \ 30 | macro(OptimizeForSize,F,F,T) \ 31 | macro(OptimizeNone,F,F,T) \ 32 | macro(ReadNone,T,F,T) \ 33 | macro(ReadOnly,T,F,T) \ 34 | macro(Returned,T,F,F) \ 35 | macro(ReturnsTwice,F,F,T) \ 36 | macro(SExt,T,T,F) \ 37 | macro(StackAlignment,F,F,T) \ 38 | macro(StackProtect,F,F,T) \ 39 | macro(StackProtectReq,F,F,T) \ 40 | macro(StackProtectStrong,F,F,T) \ 41 | macro(StructRet,T,F,F) \ 42 | macro(SanitizeAddress,F,F,T) \ 43 | macro(SanitizeThread,F,F,T) \ 44 | macro(SanitizeMemory,F,F,T) \ 45 | macro(UWTable,F,F,T) \ 46 | macro(ZExt,T,T,F) \ 47 | macro(EndAttrKinds,F,F,F) 48 | 49 | typedef enum { 50 | #define ENUM_CASE(x,p,r,f) LLVM_General_AttributeKind_ ## x, 51 | LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(ENUM_CASE) 52 | #undef ENUM_CASE 53 | } LLVM_General_AttributeKind; 54 | 55 | #endif 56 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/AttributeC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "LLVM/General/Internal/FFI/AttributeC.hpp" 4 | 5 | extern "C" { 6 | 7 | unsigned LLVM_General_AttributeSetNumSlots(const AttributeSetImpl *a) { 8 | return unwrap(a).getNumSlots(); 9 | } 10 | 11 | int LLVM_General_AttributeSetSlotIndex(const AttributeSetImpl *a, unsigned slot) { 12 | return unwrap(a).getSlotIndex(slot); 13 | } 14 | 15 | const AttributeSetImpl *LLVM_General_AttributeSetSlotAttributes(const AttributeSetImpl *a, unsigned slot) { 16 | return wrap(unwrap(a).getSlotAttributes(slot)); 17 | } 18 | 19 | const AttributeSetImpl *LLVM_General_GetSlotAttributeSet( 20 | LLVMContextRef context, 21 | unsigned index, 22 | const AttributeImpl **attributes, 23 | unsigned length 24 | ) { 25 | AttrBuilder builder; 26 | for (unsigned i = 0; i < length; i++) builder.addAttribute(unwrap(attributes[i])); 27 | return wrap(AttributeSet::get(*unwrap(context), index, builder)); 28 | } 29 | 30 | const AttributeImpl *const *LLVM_General_AttributeSetGetAttributes(AttributeSetImpl *asi, unsigned slot, unsigned *length) { 31 | AttributeSet as = unwrap(asi); 32 | ArrayRef::iterator b = as.begin(slot), e = as.end(slot); 33 | *length = e - b; 34 | return reinterpret_cast(b); 35 | } 36 | 37 | inline void LLVM_General_AttributeEnumMatches() { 38 | #define CHECK(name,p,r,f) \ 39 | static_assert( \ 40 | unsigned(llvm::Attribute::name) == unsigned(LLVM_General_AttributeKind_ ## name), \ 41 | "LLVM_General_AttributeKind enum out of sync w/ llvm::Attribute::AttrKind for " #name \ 42 | ); 43 | LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(CHECK) 44 | #undef CHECK 45 | } 46 | 47 | unsigned LLVM_General_AttributeKindAsEnum(const AttributeImpl *a) { 48 | LLVM_General_AttributeEnumMatches(); 49 | return unwrap(a).getKindAsEnum(); 50 | } 51 | 52 | uint64_t LLVM_General_AttributeValueAsInt(const AttributeImpl *a) { 53 | return unwrap(a).getValueAsInt(); 54 | } 55 | 56 | LLVMBool LLVM_General_IsStringAttribute(const AttributeImpl *a) { 57 | return unwrap(a).isStringAttribute(); 58 | } 59 | 60 | const char *LLVM_General_AttributeKindAsString(const AttributeImpl *a, size_t &l) { 61 | const StringRef s = unwrap(a).getKindAsString(); 62 | l = s.size(); 63 | return s.data(); 64 | } 65 | 66 | const char *LLVM_General_AttributeValueAsString(const AttributeImpl *a, size_t &l) { 67 | const StringRef s = unwrap(a).getValueAsString(); 68 | l = s.size(); 69 | return s.data(); 70 | } 71 | 72 | const AttributeSetImpl *LLVM_General_GetAttributeSet(LLVMContextRef context, unsigned index, const AttrBuilder &ab) { 73 | return wrap(AttributeSet::get(*unwrap(context), index, ab)); 74 | } 75 | 76 | const AttributeSetImpl *LLVM_General_MixAttributeSets( 77 | LLVMContextRef context, const AttributeSetImpl **as, unsigned n 78 | ) { 79 | return wrap( 80 | AttributeSet::get( 81 | *unwrap(context), 82 | ArrayRef(reinterpret_cast(as), n) 83 | ) 84 | ); 85 | } 86 | 87 | size_t LLVM_General_GetAttrBuilderSize() { return sizeof(AttrBuilder); } 88 | 89 | AttrBuilder *LLVM_General_ConstructAttrBuilder(char *p) { 90 | return new(p) AttrBuilder(); 91 | } 92 | 93 | void LLVM_General_DestroyAttrBuilder(AttrBuilder *a) { 94 | a->~AttrBuilder(); 95 | } 96 | 97 | void LLVM_General_AttrBuilderAddAttributeKind(AttrBuilder &ab, unsigned kind) { 98 | LLVM_General_AttributeEnumMatches(); 99 | ab.addAttribute(Attribute::AttrKind(kind)); 100 | } 101 | 102 | void LLVM_General_AttrBuilderAddStringAttribute( 103 | AttrBuilder &ab, const char *kind, size_t kind_len, const char *value, size_t value_len 104 | ) { 105 | ab.addAttribute(StringRef(kind, kind_len), StringRef(value, value_len)); 106 | } 107 | 108 | void LLVM_General_AttrBuilderAddAlignment(AttrBuilder &ab, uint64_t v) { 109 | ab.addAlignmentAttr(v); 110 | } 111 | 112 | void LLVM_General_AttrBuilderAddStackAlignment(AttrBuilder &ab, uint64_t v) { 113 | ab.addStackAlignmentAttr(v); 114 | } 115 | 116 | void LLVM_General_AttrBuilderAddDereferenceableAttr(AttrBuilder &ab, uint64_t v) { 117 | ab.addDereferenceableAttr(v); 118 | } 119 | 120 | } 121 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/AttributeC.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_ATTRIBUTE_C_HPP__ 2 | #define __LLVM_GENERAL_ATTRIBUTE_C_HPP__ 3 | #define __STDC_LIMIT_MACROS 4 | #include "llvm/IR/Attributes.h" 5 | #include "LLVM/General/Internal/FFI/Attribute.h" 6 | using namespace llvm; 7 | 8 | inline void LLVM_General_AttributeSetMatches() { 9 | static_assert( 10 | sizeof(AttributeSet) == sizeof(AttributeSetImpl *), 11 | "AttributeSet implementation has changed" 12 | ); 13 | } 14 | 15 | inline AttributeSet unwrap(const AttributeSetImpl *asi) { 16 | LLVM_General_AttributeSetMatches(); 17 | return *reinterpret_cast(&asi); 18 | } 19 | 20 | inline const AttributeSetImpl *wrap(AttributeSet as) { 21 | LLVM_General_AttributeSetMatches(); 22 | return *reinterpret_cast(&as); 23 | } 24 | 25 | inline void LLVM_General_AttributeMatches() { 26 | static_assert( 27 | sizeof(Attribute) == sizeof(AttributeImpl *), 28 | "Attribute implementation has changed" 29 | ); 30 | } 31 | 32 | inline Attribute unwrap(const AttributeImpl *ai) { 33 | LLVM_General_AttributeMatches(); 34 | return *reinterpret_cast(&ai); 35 | } 36 | 37 | inline const AttributeImpl *wrap(Attribute a) { 38 | LLVM_General_AttributeMatches(); 39 | return *reinterpret_cast(&a); 40 | } 41 | 42 | #endif 43 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/BasicBlock.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses 4 | #-} 5 | 6 | -- | 7 | module LLVM.General.Internal.FFI.BasicBlock where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | 13 | import LLVM.General.Internal.FFI.PtrHierarchy 14 | 15 | -- | 16 | foreign import ccall unsafe "LLVMIsABasicBlock" isABasicBlock :: 17 | Ptr Value -> IO (Ptr BasicBlock) 18 | 19 | -- | 20 | foreign import ccall unsafe "LLVMGetBasicBlockTerminator" getBasicBlockTerminator :: 21 | Ptr BasicBlock -> IO (Ptr Instruction) 22 | 23 | -- | 24 | foreign import ccall unsafe "LLVMGetFirstInstruction" getFirstInstruction :: 25 | Ptr BasicBlock -> IO (Ptr Instruction) 26 | 27 | -- | 28 | foreign import ccall unsafe "LLVMGetLastInstruction" getLastInstruction :: 29 | Ptr BasicBlock -> IO (Ptr Instruction) 30 | 31 | -- | 32 | foreign import ccall unsafe "LLVMGetNextInstruction" getNextInstruction :: 33 | Ptr Instruction -> IO (Ptr Instruction) 34 | 35 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/BinaryOperator.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__BINARY_OPERATOR__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__BINARY_OPERATOR__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(macro) \ 5 | macro(UDiv) \ 6 | macro(SDiv) \ 7 | macro(LShr) \ 8 | macro(AShr) 9 | 10 | #define LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(macro) \ 11 | macro(Add) \ 12 | macro(Mul) \ 13 | macro(Shl) \ 14 | macro(Sub) \ 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/BinaryOperator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM BinaryOperator class 7 | module LLVM.General.Internal.FFI.BinaryOperator where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | import Foreign.C 13 | 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | 17 | foreign import ccall unsafe "LLVMIsABinaryOperator" isABinaryOperator :: 18 | Ptr Value -> IO (Ptr BinaryOperator) 19 | 20 | foreign import ccall unsafe "LLVM_General_HasNoSignedWrap" hasNoSignedWrap :: 21 | Ptr Value -> IO LLVMBool 22 | 23 | foreign import ccall unsafe "LLVM_General_HasNoUnsignedWrap" hasNoUnsignedWrap :: 24 | Ptr Value -> IO LLVMBool 25 | 26 | foreign import ccall unsafe "LLVM_General_IsExact" isExact :: 27 | Ptr Value -> IO LLVMBool 28 | 29 | foreign import ccall unsafe "LLVM_General_GetFastMathFlags" getFastMathFlags :: 30 | Ptr Value -> IO FastMathFlags 31 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Bitcode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | -- | Functions to read and write LLVM bitcode 6 | module LLVM.General.Internal.FFI.Bitcode where 7 | 8 | import LLVM.General.Prelude 9 | 10 | import LLVM.General.Internal.FFI.RawOStream 11 | import LLVM.General.Internal.FFI.Context 12 | import LLVM.General.Internal.FFI.MemoryBuffer 13 | import LLVM.General.Internal.FFI.Module 14 | import LLVM.General.Internal.FFI.LLVMCTypes 15 | 16 | import Foreign.C 17 | import Foreign.Ptr 18 | 19 | foreign import ccall unsafe "LLVM_General_ParseBitcode" parseBitcode :: 20 | Ptr Context -> Ptr MemoryBuffer -> Ptr (OwnerTransfered CString) -> IO (Ptr Module) 21 | 22 | foreign import ccall unsafe "LLVM_General_WriteBitcode" writeBitcode :: 23 | Ptr Module -> Ptr RawOStream -> IO () 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/BitcodeC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm/IR/Module.h" 4 | #include "llvm-c/Core.h" 5 | #include "llvm/Support/raw_ostream.h" 6 | #include "llvm/Support/MemoryBuffer.h" 7 | #include "llvm/Bitcode/ReaderWriter.h" 8 | 9 | using namespace llvm; 10 | 11 | extern "C" { 12 | 13 | LLVMModuleRef LLVM_General_ParseBitcode( 14 | LLVMContextRef c, 15 | LLVMMemoryBufferRef mb, 16 | char **error 17 | ) { 18 | std::string msg; 19 | ErrorOr m = parseBitcodeFile(unwrap(mb), *unwrap(c)); 20 | if (std::error_code ec = m.getError()) { 21 | *error = strdup(ec.message().c_str()); 22 | return 0; 23 | } 24 | return wrap(m.get()); 25 | } 26 | 27 | void LLVM_General_WriteBitcode(LLVMModuleRef m, raw_ostream &os) { 28 | WriteBitcodeToFile(unwrap(m), os); 29 | } 30 | 31 | } 32 | 33 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ByteRangeCallback.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.ByteRangeCallback where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.C 9 | import Foreign.Ptr 10 | 11 | type ByteRangeCallback = Ptr CChar -> CSize -> IO () 12 | foreign import ccall "wrapper" wrapByteRangeCallback :: 13 | ByteRangeCallback -> IO (FunPtr ByteRangeCallback) 14 | 15 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/CallingConvention.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(macro) \ 5 | macro(C, 0) \ 6 | macro(Fast, 8) \ 7 | macro(Cold, 9) \ 8 | macro(GHC, 10) \ 9 | macro(HiPE, 11) \ 10 | macro(WebKit_JS, 12) \ 11 | macro(AnyReg, 13) \ 12 | macro(PreserveMost, 14) \ 13 | macro(PreserveAll, 15) \ 14 | macro(X86_StdCall, 64) \ 15 | macro(X86_FastCall, 65) \ 16 | macro(ARM_APCS, 66) \ 17 | macro(ARM_AAPCS, 67) \ 18 | macro(ARM_AAPCS_VFP, 68) \ 19 | macro(MSP430_INTR, 69) \ 20 | macro(X86_ThisCall, 70) \ 21 | macro(PTX_Kernel, 71) \ 22 | macro(PTX_Device, 72) \ 23 | macro(SPIR_FUNC, 75) \ 24 | macro(SPIR_KERNEL, 76) \ 25 | macro(Intel_OCL_BI, 77) \ 26 | macro(X86_64_SysV, 78) \ 27 | macro(X86_64_Win64, 79) 28 | 29 | typedef enum { 30 | #define ENUM_CASE(l,n) LLVM_General_CallingConvention_ ## l = n, 31 | LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(ENUM_CASE) 32 | #undef ENUM_CASE 33 | } LLVM_General_CallingConvention; 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/CallingConventionC.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION_C_HPP__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION_C_HPP__ 3 | 4 | #include "LLVM/General/Internal/FFI/CallingConvention.h" 5 | 6 | inline void LLVM_General_CallingConventionEnumMatches() { 7 | #define CHECK(l,n) \ 8 | static_assert( \ 9 | unsigned(llvm::CallingConv::l) == unsigned(LLVM_General_CallingConvention_ ## l), \ 10 | "LLVM_General_CallingConvention enum out of sync w/ llvm::CallingConv::ID for " #l \ 11 | ); 12 | LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(CHECK) 13 | #undef CHECK 14 | } 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Cleanup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell 3 | #-} 4 | module LLVM.General.Internal.FFI.Cleanup where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Language.Haskell.TH 9 | import Data.Sequence as Seq 10 | 11 | import Foreign.C 12 | import Foreign.Ptr 13 | 14 | import LLVM.General.Internal.FFI.LLVMCTypes 15 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 16 | 17 | import qualified LLVM.General.AST.IntegerPredicate as A (IntegerPredicate) 18 | import qualified LLVM.General.AST.FloatingPointPredicate as A (FloatingPointPredicate) 19 | import qualified LLVM.General.AST.Constant as A.C (Constant) 20 | import qualified LLVM.General.AST.Operand as A (Operand) 21 | import qualified LLVM.General.AST.Type as A (Type) 22 | import qualified LLVM.General.AST.Instruction as A (FastMathFlags) 23 | 24 | foreignDecl :: String -> String -> [TypeQ] -> TypeQ -> DecsQ 25 | foreignDecl cName hName argTypeQs returnTypeQ = do 26 | let foreignDecl' hName argTypeQs = 27 | forImpD cCall unsafe cName (mkName hName) 28 | (foldr (\a b -> appT (appT arrowT a) b) (appT (conT ''IO) returnTypeQ) argTypeQs) 29 | splitTuples :: [Type] -> Q ([Type], [Pat], [Exp]) 30 | splitTuples ts = do 31 | let f :: Type -> Q (Seq Type, Pat, Seq Exp) 32 | f x@(AppT _ _) = maybe (d x) (\q -> q >>= \(ts, ps, es) -> return (ts, TupP (toList ps), es)) (g 0 x) 33 | f x = d x 34 | g :: Int -> Type -> Maybe (Q (Seq Type, Seq Pat, Seq Exp)) 35 | g n (TupleT m) | m == n = return (return (Seq.empty, Seq.empty, Seq.empty)) 36 | g n (AppT a b) = do 37 | k <- g (n+1) a 38 | return $ do 39 | (ts, ps, es) <- k 40 | (ts', p', es') <- f b 41 | return (ts >< ts', ps |> p', es >< es') 42 | g _ _ = Nothing 43 | d :: Type -> Q (Seq Type, Pat, Seq Exp) 44 | d x = do 45 | n <- newName "v" 46 | return (Seq.singleton x, VarP n, Seq.singleton (VarE n)) 47 | seqsToList :: [Seq a] -> [a] 48 | seqsToList = toList . foldr (><) Seq.empty 49 | 50 | (tss, ps, ess) <- liftM unzip3 . mapM f $ ts 51 | return (seqsToList tss, ps, seqsToList ess) 52 | 53 | 54 | argTypes <- sequence argTypeQs 55 | (ts, ps, es) <- splitTuples argTypes 56 | let phName = hName ++ "'" 57 | sequence [ 58 | foreignDecl' phName (map return ts), 59 | funD (mkName hName) [ 60 | clause (map return ps) (normalB (foldl appE (varE (mkName phName)) (map return es))) [] 61 | ] 62 | ] 63 | 64 | -- | The LLVM C-API for instructions with boolean flags (e.g. nsw) and is weak, so they get 65 | -- separated out for different handling. This check is an accurate but crude test for whether 66 | -- an instruction needs such handling. 67 | hasFlags :: [Type] -> Bool 68 | hasFlags = any (== ConT ''Bool) 69 | 70 | typeMapping :: Type -> TypeQ 71 | typeMapping t = case t of 72 | ConT h | h == ''Bool -> [t| LLVMBool |] 73 | | h == ''Int32 -> [t| CInt |] 74 | | h == ''Word32 -> [t| CUInt |] 75 | | h == ''String -> [t| CString |] 76 | | h == ''A.Operand -> [t| Ptr FFI.Value |] 77 | | h == ''A.Type -> [t| Ptr FFI.Type |] 78 | | h == ''A.C.Constant -> [t| Ptr FFI.Constant |] 79 | | h == ''A.FloatingPointPredicate -> [t| FCmpPredicate |] 80 | | h == ''A.IntegerPredicate -> [t| ICmpPredicate |] 81 | | h == ''A.FastMathFlags -> [t| FastMathFlags |] 82 | AppT ListT x -> foldl1 appT [tupleT 2, [t| CUInt |], appT [t| Ptr |] (typeMapping x)] 83 | x -> error $ "type not handled in Cleanup typeMapping: " ++ show x 84 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/CommandLine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.CommandLine where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.Ptr 9 | import Foreign.C 10 | 11 | foreign import ccall unsafe "LLVM_General_ParseCommandLineOptions" parseCommandLineOptions' :: 12 | CUInt -> Ptr (Ptr CChar) -> Ptr CChar -> IO () 13 | 14 | parseCommandLineOptions = uncurry parseCommandLineOptions' 15 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/CommandLineC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/Support/CommandLine.h" 3 | 4 | using namespace llvm; 5 | 6 | extern "C" { 7 | 8 | void LLVM_General_ParseCommandLineOptions(unsigned argc, const char * const *argv, const char *overview) { 9 | cl::ParseCommandLineOptions(argc, argv, overview); 10 | } 11 | 12 | } 13 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Constant.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__CONSTANT__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__CONSTANT__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_FLOAT_SEMANTICS(macro) \ 5 | macro(IEEEhalf) \ 6 | macro(IEEEsingle) \ 7 | macro(IEEEdouble) \ 8 | macro(IEEEquad) \ 9 | macro(PPCDoubleDouble) \ 10 | macro(x87DoubleExtended) \ 11 | macro(Bogus) 12 | 13 | typedef enum { 14 | #define ENUM_CASE(x) LLVMFloatSemantics ## x, 15 | LLVM_GENERAL_FOR_EACH_FLOAT_SEMANTICS(ENUM_CASE) 16 | #undef ENUM_CASE 17 | } LLVMFloatSemantics; 18 | 19 | 20 | #endif 21 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ConstantC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm/IR/Constants.h" 4 | #include "llvm/IR/Function.h" 5 | 6 | #include "llvm-c/Core.h" 7 | #include "LLVM/General/Internal/FFI/Value.h" 8 | #include "LLVM/General/Internal/FFI/Constant.h" 9 | #include "LLVM/General/Internal/FFI/BinaryOperator.h" 10 | 11 | using namespace llvm; 12 | 13 | namespace llvm { 14 | 15 | static const struct fltSemantics &unwrap(LLVMFloatSemantics s) { 16 | switch(s) { 17 | #define ENUM_CASE(x) case LLVMFloatSemantics ## x: return APFloat::x; 18 | LLVM_GENERAL_FOR_EACH_FLOAT_SEMANTICS(ENUM_CASE) 19 | #undef ENUM_CASE 20 | default: return APFloat::Bogus; 21 | } 22 | } 23 | 24 | } 25 | 26 | extern "C" { 27 | 28 | LLVMValueRef LLVM_General_GetConstantDataSequentialElementAsConstant(LLVMValueRef v, unsigned i) { 29 | return wrap(unwrap(v)->getElementAsConstant(i)); 30 | } 31 | 32 | LLVMValueRef LLVM_General_GetBlockAddressFunction(LLVMValueRef v) { 33 | return wrap(unwrap(v)->getFunction()); 34 | } 35 | 36 | LLVMBasicBlockRef LLVM_General_GetBlockAddressBlock(LLVMValueRef v) { 37 | return wrap(unwrap(v)->getBasicBlock()); 38 | } 39 | 40 | double LLVM_General_ConstFloatDoubleValue(LLVMValueRef v) { 41 | return unwrap(v)->getValueAPF().convertToDouble(); 42 | } 43 | 44 | float LLVM_General_ConstFloatFloatValue(LLVMValueRef v) { 45 | return unwrap(v)->getValueAPF().convertToFloat(); 46 | } 47 | 48 | LLVMValueRef LLVM_General_ConstCast(unsigned opcode, LLVMValueRef v, LLVMTypeRef t) { 49 | return wrap(ConstantExpr::getCast(opcode, unwrap(v), unwrap(t))); 50 | } 51 | 52 | LLVMValueRef LLVM_General_ConstBinaryOperator(unsigned opcode, LLVMValueRef o0, LLVMValueRef o1) { 53 | return wrap(ConstantExpr::get(opcode, unwrap(o0), unwrap(o1))); 54 | } 55 | 56 | #define CASE_CODE(op) \ 57 | LLVMValueRef LLVM_General_Const ## op(unsigned nsw, unsigned nuw, LLVMValueRef o0, LLVMValueRef o1) { \ 58 | return wrap(ConstantExpr::get ## op(unwrap(o0), unwrap(o1), nuw != 0, nsw != 0)); \ 59 | } 60 | LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(CASE_CODE) 61 | #undef CASE_CODE 62 | 63 | #define CASE_CODE(op) \ 64 | LLVMValueRef LLVM_General_Const ## op(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { \ 65 | return wrap(ConstantExpr::get ## op(unwrap(o0), unwrap(o1), isExact != 0)); \ 66 | } 67 | LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(CASE_CODE) 68 | #undef CASE_CODE 69 | 70 | unsigned LLVM_General_GetConstCPPOpcode(LLVMValueRef v) { 71 | return unwrap(v)->getOpcode(); 72 | } 73 | 74 | unsigned LLVM_General_GetConstPredicate(LLVMValueRef v) { 75 | return unwrap(v)->getPredicate(); 76 | } 77 | 78 | const unsigned *LLVM_General_GetConstIndices(LLVMValueRef v, unsigned *n) { 79 | ArrayRef r = unwrap(v)->getIndices(); 80 | *n = r.size(); 81 | return r.data(); 82 | } 83 | 84 | const uint64_t *LLVM_General_GetConstantIntWords(LLVMValueRef v, unsigned *n) { 85 | const APInt &i = unwrap(v)->getValue(); 86 | *n = i.getNumWords(); 87 | return i.getRawData(); 88 | } 89 | 90 | LLVMValueRef LLVM_General_ConstFloatOfArbitraryPrecision( 91 | LLVMContextRef c, 92 | unsigned bits, 93 | const uint64_t *words, 94 | LLVMFloatSemantics semantics 95 | ) { 96 | return wrap( 97 | ConstantFP::get( 98 | *unwrap(c), 99 | APFloat(unwrap(semantics), APInt(bits, ArrayRef(words, (bits-1)/64 + 1))) 100 | ) 101 | ); 102 | } 103 | 104 | void LLVM_General_GetConstantFloatWords(LLVMValueRef v, uint64_t *bits) { 105 | APInt a = unwrap(v)->getValueAPF().bitcastToAPInt(); 106 | for(unsigned i=0; i != a.getNumWords(); ++i) bits[i] = a.getRawData()[i]; 107 | } 108 | 109 | } 110 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Context.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | -- | Functions for handling the LLVMContext class. In all other LLVM interfaces, 6 | -- | prefer the newer explicitly thread-aware variants which use contexts 7 | -- | over corresponding older variants which implicitly reference a global context. 8 | -- | This choice allows multiple threads to do independent work with LLVM safely. 9 | module LLVM.General.Internal.FFI.Context where 10 | 11 | import LLVM.General.Prelude 12 | 13 | import Foreign.Ptr 14 | 15 | -- | a blind type to correspond to LLVMContext 16 | data Context 17 | 18 | -- | 19 | foreign import ccall unsafe "LLVMContextCreate" contextCreate :: 20 | IO (Ptr Context) 21 | 22 | -- | 23 | foreign import ccall unsafe "LLVMGetGlobalContext" getGlobalContext :: 24 | IO (Ptr Context) 25 | 26 | -- | 27 | foreign import ccall unsafe "LLVMContextDispose" contextDispose :: 28 | Ptr Context -> IO () 29 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/DataLayout.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | module LLVM.General.Internal.FFI.DataLayout where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Foreign.C.String 10 | import Foreign.Ptr 11 | 12 | import LLVM.General.Internal.FFI.LLVMCTypes 13 | 14 | data DataLayout 15 | 16 | -- Oooh those wacky LLVM C-API coders: C API called DataLayout TargetData. 17 | -- Great. Just great. 18 | 19 | foreign import ccall unsafe "LLVMCreateTargetData" createDataLayout :: 20 | CString -> IO (Ptr DataLayout) 21 | 22 | foreign import ccall unsafe "LLVMDisposeTargetData" disposeDataLayout :: 23 | Ptr DataLayout -> IO () 24 | 25 | foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" dataLayoutToString :: 26 | Ptr DataLayout -> IO (OwnerTransfered CString) 27 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ExecutionEngine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | module LLVM.General.Internal.FFI.ExecutionEngine where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Foreign.Ptr 10 | import Foreign.C 11 | 12 | import LLVM.General.Internal.FFI.PtrHierarchy 13 | import LLVM.General.Internal.FFI.Module 14 | import LLVM.General.Internal.FFI.LLVMCTypes 15 | 16 | data ExecutionEngine 17 | 18 | foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule :: 19 | Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr (OwnerTransfered CString) -> IO CUInt 20 | 21 | foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule :: 22 | Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr (OwnerTransfered CString) -> IO CUInt 23 | 24 | foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule :: 25 | Ptr (Ptr ExecutionEngine) -> Ptr Module -> CUInt -> Ptr (OwnerTransfered CString) -> IO CUInt 26 | 27 | foreign import ccall unsafe "LLVMCreateMCJITCompilerForModule" createMCJITCompilerForModule :: 28 | Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MCJITCompilerOptions -> CSize -> Ptr (OwnerTransfered CString) -> IO CUInt 29 | 30 | foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine :: 31 | Ptr ExecutionEngine -> IO () 32 | 33 | foreign import ccall unsafe "LLVMAddModule" addModule :: 34 | Ptr ExecutionEngine -> Ptr Module -> IO () 35 | 36 | foreign import ccall unsafe "LLVMRemoveModule" removeModule :: 37 | Ptr ExecutionEngine -> Ptr Module -> Ptr (Ptr Module) -> Ptr CString -> IO CUInt 38 | 39 | foreign import ccall unsafe "LLVMFindFunction" findFunction :: 40 | Ptr ExecutionEngine -> CString -> Ptr (Ptr Function) -> IO CUInt 41 | 42 | foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal :: 43 | Ptr ExecutionEngine -> Ptr GlobalValue -> IO (Ptr ()) 44 | 45 | foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter :: 46 | IO () 47 | 48 | foreign import ccall unsafe "LLVMLinkInJIT" linkInJIT :: 49 | IO () 50 | 51 | foreign import ccall unsafe "LLVMLinkInMCJIT" linkInMCJIT :: 52 | IO () 53 | 54 | data MCJITCompilerOptions 55 | 56 | foreign import ccall unsafe "LLVM_General_GetMCJITCompilerOptionsSize" getMCJITCompilerOptionsSize :: 57 | IO CSize 58 | 59 | foreign import ccall unsafe "LLVMInitializeMCJITCompilerOptions" initializeMCJITCompilerOptions :: 60 | Ptr MCJITCompilerOptions -> CSize -> IO () 61 | 62 | foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsOptLevel" setMCJITCompilerOptionsOptLevel :: 63 | Ptr MCJITCompilerOptions -> CUInt -> IO () 64 | 65 | foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsCodeModel" setMCJITCompilerOptionsCodeModel :: 66 | Ptr MCJITCompilerOptions -> CodeModel -> IO () 67 | 68 | foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsNoFramePointerElim" setMCJITCompilerOptionsNoFramePointerElim :: 69 | Ptr MCJITCompilerOptions -> LLVMBool -> IO () 70 | 71 | foreign import ccall unsafe "LLVM_General_SetMCJITCompilerOptionsEnableFastISel" setMCJITCompilerOptionsEnableFastISel :: 72 | Ptr MCJITCompilerOptions -> LLVMBool -> IO () 73 | 74 | 75 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ExecutionEngineC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm-c/ExecutionEngine.h" 4 | 5 | using namespace llvm; 6 | 7 | extern "C" { 8 | 9 | size_t LLVM_General_GetMCJITCompilerOptionsSize() { 10 | return sizeof(struct LLVMMCJITCompilerOptions); 11 | } 12 | 13 | void LLVM_General_SetMCJITCompilerOptionsOptLevel(struct LLVMMCJITCompilerOptions *o, unsigned x) { 14 | o->OptLevel = x; 15 | } 16 | 17 | void LLVM_General_SetMCJITCompilerOptionsCodeModel(struct LLVMMCJITCompilerOptions *o, LLVMCodeModel x) { 18 | o->CodeModel = x; 19 | } 20 | 21 | void LLVM_General_SetMCJITCompilerOptionsNoFramePointerElim(struct LLVMMCJITCompilerOptions *o, LLVMBool x) { 22 | o->NoFramePointerElim = x; 23 | } 24 | 25 | void LLVM_General_SetMCJITCompilerOptionsEnableFastISel(struct LLVMMCJITCompilerOptions *o, LLVMBool x) { 26 | o->EnableFastISel = x; 27 | } 28 | 29 | } 30 | 31 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Function.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses 4 | #-} 5 | 6 | module LLVM.General.Internal.FFI.Function where 7 | 8 | import LLVM.General.Prelude 9 | 10 | import Foreign.Ptr 11 | import Foreign.C 12 | 13 | import LLVM.General.Internal.FFI.Attribute 14 | import LLVM.General.Internal.FFI.Context 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | import LLVM.General.Internal.FFI.PtrHierarchy 17 | 18 | foreign import ccall unsafe "LLVM_General_GetFunctionCallingConvention" getFunctionCallingConvention :: 19 | Ptr Function -> IO CallingConvention 20 | 21 | foreign import ccall unsafe "LLVM_General_SetFunctionCallingConvention" setFunctionCallingConvention :: 22 | Ptr Function -> CallingConvention -> IO () 23 | 24 | foreign import ccall unsafe "LLVM_General_GetFunctionMixedAttributeSet" getMixedAttributeSet :: 25 | Ptr Function -> IO MixedAttributeSet 26 | 27 | foreign import ccall unsafe "LLVM_General_SetFunctionMixedAttributeSet" setMixedAttributeSet :: 28 | Ptr Function -> MixedAttributeSet -> IO () 29 | 30 | foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock :: 31 | Ptr Function -> IO (Ptr BasicBlock) 32 | 33 | foreign import ccall unsafe "LLVMGetLastBasicBlock" getLastBasicBlock :: 34 | Ptr Function -> IO (Ptr BasicBlock) 35 | 36 | foreign import ccall unsafe "LLVMGetNextBasicBlock" getNextBasicBlock :: 37 | Ptr BasicBlock -> IO (Ptr BasicBlock) 38 | 39 | foreign import ccall unsafe "LLVMAppendBasicBlockInContext" appendBasicBlockInContext :: 40 | Ptr Context -> Ptr Function -> CString -> IO (Ptr BasicBlock) 41 | 42 | 43 | foreign import ccall unsafe "LLVMCountParams" countParams :: 44 | Ptr Function -> IO CUInt 45 | 46 | foreign import ccall unsafe "LLVMGetParams" getParams :: 47 | Ptr Function -> Ptr (Ptr Parameter) -> IO () 48 | 49 | foreign import ccall unsafe "LLVMGetGC" getGC :: 50 | Ptr Function -> IO CString 51 | 52 | foreign import ccall unsafe "LLVMSetGC" setGC :: 53 | Ptr Function -> CString -> IO () 54 | 55 | 56 | foreign import ccall unsafe "LLVM_General_HasFunctionPrefixData" hasPrefixData :: 57 | Ptr Function -> IO LLVMBool 58 | 59 | foreign import ccall unsafe "LLVM_General_GetFunctionPrefixData" getPrefixData :: 60 | Ptr Function -> IO (Ptr Constant) 61 | 62 | foreign import ccall unsafe "LLVM_General_SetFunctionPrefixData" setPrefixData :: 63 | Ptr Function -> Ptr Constant -> IO () 64 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/FunctionC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm/IR/Attributes.h" 4 | #include "llvm/IR/Function.h" 5 | #include "llvm/IR/Value.h" 6 | 7 | #include "llvm-c/Core.h" 8 | #include "LLVM/General/Internal/FFI/AttributeC.hpp" 9 | #include "LLVM/General/Internal/FFI/CallingConventionC.hpp" 10 | 11 | using namespace llvm; 12 | 13 | extern "C" { 14 | 15 | LLVMAttribute LLVM_General_GetFunctionRetAttr(LLVMValueRef f) { 16 | return (LLVMAttribute)unwrap(f)->getAttributes().Raw(AttributeSet::ReturnIndex); 17 | } 18 | 19 | void LLVM_General_AddFunctionRetAttr(LLVMValueRef v, LLVMAttribute attr) { 20 | Function &f = *unwrap(v); 21 | LLVMContext &context = f.getContext(); 22 | AttrBuilder attrBuilder(attr); 23 | f.setAttributes( 24 | f.getAttributes().addAttributes(context, AttributeSet::ReturnIndex, AttributeSet::get(context, AttributeSet::ReturnIndex, attrBuilder)) 25 | ); 26 | } 27 | 28 | const AttributeSetImpl *LLVM_General_GetFunctionMixedAttributeSet(LLVMValueRef f) { 29 | return wrap(unwrap(f)->getAttributes()); 30 | } 31 | 32 | void LLVM_General_SetFunctionMixedAttributeSet(LLVMValueRef f, AttributeSetImpl *asi) { 33 | unwrap(f)->setAttributes(unwrap(asi)); 34 | } 35 | 36 | LLVMBool LLVM_General_HasFunctionPrefixData(LLVMValueRef f) { 37 | return unwrap(f)->hasPrefixData(); 38 | } 39 | 40 | LLVMValueRef LLVM_General_GetFunctionPrefixData(LLVMValueRef f) { 41 | return wrap(unwrap(f)->getPrefixData()); 42 | } 43 | 44 | void LLVM_General_SetFunctionPrefixData(LLVMValueRef f, LLVMValueRef p) { 45 | unwrap(f)->setPrefixData(unwrap(p)); 46 | } 47 | 48 | unsigned LLVM_General_GetFunctionCallingConvention(LLVMValueRef f) { 49 | LLVM_General_CallingConventionEnumMatches(); 50 | return unsigned(unwrap(f)->getCallingConv()); 51 | } 52 | 53 | void LLVM_General_SetFunctionCallingConvention(LLVMValueRef f, unsigned cc) { 54 | LLVM_General_CallingConventionEnumMatches(); 55 | unwrap(f)->setCallingConv(llvm::CallingConv::ID(cc)); 56 | } 57 | 58 | } 59 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalAlias.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM GlobalAlias class 7 | module LLVM.General.Internal.FFI.GlobalAlias where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | 13 | import LLVM.General.Internal.FFI.PtrHierarchy 14 | 15 | -- | test if a 'Value' is a 'GlobalAlias' 16 | foreign import ccall unsafe "LLVMIsAGlobalAlias" isAGlobalAlias :: 17 | Ptr Value -> IO (Ptr GlobalAlias) 18 | 19 | -- | get the constant aliased by this alias 20 | foreign import ccall unsafe "LLVM_General_GetAliasee" getAliasee :: 21 | Ptr GlobalAlias -> IO (Ptr Constant) 22 | 23 | -- | set the constant aliased by this alias 24 | foreign import ccall unsafe "LLVM_General_SetAliasee" setAliasee :: 25 | Ptr GlobalAlias -> Ptr Constant -> IO () 26 | 27 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalAliasC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/LLVMContext.h" 3 | #include "llvm/IR/GlobalAlias.h" 4 | #include "llvm/IR/GlobalObject.h" 5 | 6 | #include "llvm-c/Core.h" 7 | 8 | #include 9 | 10 | using namespace llvm; 11 | 12 | extern "C" { 13 | 14 | LLVMValueRef LLVM_General_GetAliasee(LLVMValueRef g) { 15 | return wrap(unwrap(g)->getAliasee()); 16 | } 17 | 18 | void LLVM_General_SetAliasee(LLVMValueRef g, LLVMValueRef c) { 19 | unwrap(g)->setAliasee(unwrap(c)); 20 | } 21 | 22 | } 23 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalValue.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__GLOBAL_VALUE__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__GLOBAL_VALUE__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_LINKAGE(macro) \ 5 | macro(External) \ 6 | macro(AvailableExternally) \ 7 | macro(LinkOnceAny) \ 8 | macro(LinkOnceODR) \ 9 | macro(WeakAny) \ 10 | macro(WeakODR) \ 11 | macro(Appending) \ 12 | macro(Internal) \ 13 | macro(Private) \ 14 | macro(ExternalWeak) \ 15 | macro(Common) 16 | 17 | #define LLVM_GENERAL_FOR_EACH_VISIBILITY(macro) \ 18 | macro(Default) \ 19 | macro(Hidden) \ 20 | macro(Protected) \ 21 | 22 | #define LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(macro) \ 23 | macro(Any) \ 24 | macro(ExactMatch) \ 25 | macro(Largest) \ 26 | macro(NoDuplicates) \ 27 | macro(SameSize) 28 | 29 | typedef enum { 30 | #define ENUM_CASE(n) LLVM_General_COMDAT_Selection_Kind_ ## n, 31 | LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(ENUM_CASE) 32 | #undef ENUM_CASE 33 | } LLVM_General_COMDAT_Selection_Kind; 34 | 35 | #define LLVM_GENERAL_FOR_EACH_DLL_STORAGE_CLASS(macro) \ 36 | macro(Default) \ 37 | macro(DLLImport) \ 38 | macro(DLLExport) 39 | 40 | #define LLVM_GENERAL_FOR_EACH_THREAD_LOCAL_MODE(macro) \ 41 | macro(NotThreadLocal) \ 42 | macro(GeneralDynamicTLSModel) \ 43 | macro(LocalDynamicTLSModel) \ 44 | macro(InitialExecTLSModel) \ 45 | macro(LocalExecTLSModel) 46 | 47 | #endif 48 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalValue.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM GlobalValue class 7 | module LLVM.General.Internal.FFI.GlobalValue where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | import Foreign.C 13 | 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | 17 | data COMDAT 18 | 19 | foreign import ccall unsafe "LLVMIsAGlobalValue" isAGlobalValue :: 20 | Ptr Value -> IO (Ptr GlobalValue) 21 | 22 | foreign import ccall unsafe "LLVMGetLinkage" getLinkage :: 23 | Ptr GlobalValue -> IO Linkage 24 | 25 | foreign import ccall unsafe "LLVMSetLinkage" setLinkage :: 26 | Ptr GlobalValue -> Linkage -> IO () 27 | 28 | foreign import ccall unsafe "LLVMGetSection" getSection :: 29 | Ptr GlobalValue -> IO CString 30 | 31 | foreign import ccall unsafe "LLVMSetSection" setSection :: 32 | Ptr GlobalValue -> CString -> IO () 33 | 34 | foreign import ccall unsafe "LLVM_General_GetCOMDAT" getCOMDAT :: 35 | Ptr GlobalValue -> IO (Ptr COMDAT) 36 | 37 | foreign import ccall unsafe "LLVM_General_SetCOMDAT" setCOMDAT :: 38 | Ptr GlobalObject -> Ptr COMDAT -> IO () 39 | 40 | foreign import ccall unsafe "LLVM_General_GetCOMDATName" getCOMDATName :: 41 | Ptr COMDAT -> Ptr CSize -> IO (Ptr CChar) 42 | 43 | foreign import ccall unsafe "LLVM_General_GetCOMDATSelectionKind" getCOMDATSelectionKind :: 44 | Ptr COMDAT -> IO COMDATSelectionKind 45 | 46 | foreign import ccall unsafe "LLVM_General_SetCOMDATSelectionKind" setCOMDATSelectionKind :: 47 | Ptr COMDAT -> COMDATSelectionKind -> IO () 48 | 49 | foreign import ccall unsafe "LLVMGetVisibility" getVisibility :: 50 | Ptr GlobalValue -> IO Visibility 51 | 52 | foreign import ccall unsafe "LLVMSetVisibility" setVisibility :: 53 | Ptr GlobalValue -> Visibility -> IO () 54 | 55 | foreign import ccall unsafe "LLVMGetDLLStorageClass" getDLLStorageClass :: 56 | Ptr GlobalValue -> IO DLLStorageClass 57 | 58 | foreign import ccall unsafe "LLVMSetDLLStorageClass" setDLLStorageClass :: 59 | Ptr GlobalValue -> DLLStorageClass -> IO () 60 | 61 | foreign import ccall unsafe "LLVMGetAlignment" getAlignment :: 62 | Ptr GlobalValue -> IO CUInt 63 | 64 | foreign import ccall unsafe "LLVMSetAlignment" setAlignment :: 65 | Ptr GlobalValue -> CUInt -> IO () 66 | 67 | foreign import ccall unsafe "LLVM_General_HasUnnamedAddr" hasUnnamedAddr :: 68 | Ptr GlobalValue -> IO LLVMBool 69 | 70 | foreign import ccall unsafe "LLVM_General_SetUnnamedAddr" setUnnamedAddr :: 71 | Ptr GlobalValue -> LLVMBool -> IO () 72 | 73 | foreign import ccall unsafe "LLVM_General_GetThreadLocalMode" getThreadLocalMode :: 74 | Ptr GlobalValue -> IO ThreadLocalMode 75 | 76 | foreign import ccall unsafe "LLVM_General_SetThreadLocalMode" setThreadLocalMode :: 77 | Ptr GlobalValue -> ThreadLocalMode -> IO () 78 | 79 | 80 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalValueC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/Comdat.h" 3 | #include "llvm/IR/GlobalValue.h" 4 | #include "llvm/IR/GlobalObject.h" 5 | #include "llvm-c/Core.h" 6 | #include "LLVM/General/Internal/FFI/GlobalValue.h" 7 | 8 | using namespace llvm; 9 | 10 | extern "C" { 11 | 12 | const Comdat *LLVM_General_GetCOMDAT(LLVMValueRef globalVal) { 13 | return unwrap(globalVal)->getComdat(); 14 | } 15 | 16 | void LLVM_General_SetCOMDAT(LLVMValueRef globalObj, Comdat *comdat) { 17 | return unwrap(globalObj)->setComdat(comdat); 18 | } 19 | 20 | const char *LLVM_General_GetCOMDATName(const Comdat &comdat, size_t &size) { 21 | StringRef ref = comdat.getName(); 22 | size = ref.size(); 23 | return ref.data(); 24 | } 25 | 26 | inline void LLVM_General_COMDAT_Selection_Kind_Enum_Matches() { 27 | #define ENUM_CASE(n) static_assert(unsigned(Comdat::n) == unsigned(LLVM_General_COMDAT_Selection_Kind_ ## n), \ 28 | "COMDAT SelectionKind Enum mismatch"); 29 | LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(ENUM_CASE) 30 | #undef ENUM_CASE 31 | } 32 | 33 | unsigned LLVM_General_GetCOMDATSelectionKind(const Comdat &comdat) { 34 | LLVM_General_COMDAT_Selection_Kind_Enum_Matches(); 35 | return unsigned(comdat.getSelectionKind()); 36 | } 37 | 38 | void LLVM_General_SetCOMDATSelectionKind(Comdat &comdat, unsigned csk) { 39 | LLVM_General_COMDAT_Selection_Kind_Enum_Matches(); 40 | comdat.setSelectionKind(Comdat::SelectionKind(csk)); 41 | } 42 | 43 | LLVMBool LLVM_General_HasUnnamedAddr(LLVMValueRef globalVal) { 44 | return unwrap(globalVal)->hasUnnamedAddr(); 45 | } 46 | 47 | void LLVM_General_SetUnnamedAddr(LLVMValueRef globalVal, LLVMBool isUnnamedAddr) { 48 | unwrap(globalVal)->setUnnamedAddr(isUnnamedAddr); 49 | } 50 | 51 | inline void LLVM_General_TLS_Model_Enum_Matches() { 52 | #define ENUM_CASE(n) static_assert(unsigned(GlobalValue::n) == unsigned(LLVM ## n), "TLS Model Enum mismatch"); 53 | LLVM_GENERAL_FOR_EACH_THREAD_LOCAL_MODE(ENUM_CASE) 54 | #undef ENUM_CASE 55 | } 56 | 57 | LLVMThreadLocalMode LLVM_General_GetThreadLocalMode(LLVMValueRef globalVal) { 58 | LLVM_General_TLS_Model_Enum_Matches(); 59 | return LLVMThreadLocalMode(unwrap(globalVal)->getThreadLocalMode()); 60 | } 61 | 62 | void LLVM_General_SetThreadLocalMode(LLVMValueRef globalVal, LLVMThreadLocalMode mode) { 63 | LLVM_General_TLS_Model_Enum_Matches(); 64 | unwrap(globalVal)->setThreadLocalMode(GlobalValue::ThreadLocalMode(mode)); 65 | } 66 | 67 | } 68 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/GlobalVariable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM GlobalVariable class 7 | module LLVM.General.Internal.FFI.GlobalVariable where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | import Foreign.C 13 | 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | 17 | foreign import ccall unsafe "LLVMIsAGlobalVariable" isAGlobalVariable :: 18 | Ptr Value -> IO (Ptr GlobalVariable) 19 | 20 | foreign import ccall unsafe "LLVMIsGlobalConstant" isGlobalConstant :: 21 | Ptr GlobalVariable -> IO LLVMBool 22 | 23 | foreign import ccall unsafe "LLVMSetGlobalConstant" setGlobalConstant :: 24 | Ptr GlobalVariable -> LLVMBool -> IO () 25 | 26 | foreign import ccall unsafe "LLVMGetInitializer" getInitializer :: 27 | Ptr GlobalVariable -> IO (Ptr Constant) 28 | 29 | foreign import ccall unsafe "LLVMSetInitializer" setInitializer :: 30 | Ptr GlobalVariable -> Ptr Constant -> IO () 31 | 32 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/InlineAssembly.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__INLINE_ASSEMBLY__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__INLINE_ASSEMBLY__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_ASM_DIALECT(macro) \ 5 | macro(ATT) \ 6 | macro(Intel) \ 7 | 8 | typedef enum { 9 | #define ENUM_CASE(d) LLVMAsmDialect_ ## d, 10 | LLVM_GENERAL_FOR_EACH_ASM_DIALECT(ENUM_CASE) 11 | #undef ENUM_CASE 12 | } LLVMAsmDialect; 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/InlineAssembly.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | 5 | module LLVM.General.Internal.FFI.InlineAssembly where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Foreign.C 10 | import Foreign.Ptr 11 | 12 | import LLVM.General.Internal.FFI.LLVMCTypes 13 | import LLVM.General.Internal.FFI.PtrHierarchy 14 | 15 | foreign import ccall unsafe "LLVMIsAInlineAsm" isAInlineAsm :: 16 | Ptr Value -> IO (Ptr InlineAsm) 17 | 18 | foreign import ccall unsafe "LLVM_General_CreateInlineAsm" createInlineAsm :: 19 | Ptr Type -> CString -> CString -> LLVMBool -> LLVMBool -> AsmDialect -> IO (Ptr InlineAsm) 20 | 21 | foreign import ccall unsafe "LLVM_General_GetInlineAsmAsmString" getInlineAsmAssemblyString :: 22 | Ptr InlineAsm -> IO CString 23 | 24 | foreign import ccall unsafe "LLVM_General_GetInlineAsmConstraintString" getInlineAsmConstraintString :: 25 | Ptr InlineAsm -> IO CString 26 | 27 | foreign import ccall unsafe "LLVM_General_InlineAsmHasSideEffects" inlineAsmHasSideEffects :: 28 | Ptr InlineAsm -> IO LLVMBool 29 | 30 | foreign import ccall unsafe "LLVM_General_InlineAsmIsAlignStack" inlineAsmIsAlignStack :: 31 | Ptr InlineAsm -> IO LLVMBool 32 | 33 | foreign import ccall unsafe "LLVM_General_GetInlineAsmDialect" getInlineAsmDialect :: 34 | Ptr InlineAsm -> IO AsmDialect 35 | 36 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/InlineAssemblyC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/InlineAsm.h" 3 | #include "llvm/IR/Function.h" 4 | #include "llvm-c/Core.h" 5 | 6 | #include "LLVM/General/Internal/FFI/InlineAssembly.h" 7 | 8 | using namespace llvm; 9 | 10 | namespace llvm { 11 | static LLVMAsmDialect wrap(InlineAsm::AsmDialect d) { 12 | switch(d) { 13 | #define ENUM_CASE(x) case InlineAsm::AD_ ## x: return LLVMAsmDialect_ ## x; 14 | LLVM_GENERAL_FOR_EACH_ASM_DIALECT(ENUM_CASE) 15 | #undef ENUM_CASE 16 | default: return LLVMAsmDialect(0); 17 | } 18 | } 19 | 20 | static InlineAsm::AsmDialect unwrap(LLVMAsmDialect d) { 21 | switch(d) { 22 | #define ENUM_CASE(x) case LLVMAsmDialect_ ## x: return InlineAsm::AD_ ## x; 23 | LLVM_GENERAL_FOR_EACH_ASM_DIALECT(ENUM_CASE) 24 | #undef ENUM_CASE 25 | default: return InlineAsm::AsmDialect(0); 26 | } 27 | } 28 | } 29 | 30 | extern "C" { 31 | 32 | LLVMValueRef LLVM_General_CreateInlineAsm( 33 | LLVMTypeRef t, 34 | const char *asmStr, 35 | const char *constraintsStr, 36 | LLVMBool hasSideEffects, 37 | LLVMBool isAlignStack, 38 | LLVMAsmDialect dialect 39 | ) { 40 | return wrap( 41 | InlineAsm::get( 42 | unwrap(t), 43 | asmStr, 44 | constraintsStr, 45 | hasSideEffects, 46 | isAlignStack, 47 | unwrap(dialect) 48 | ) 49 | ); 50 | } 51 | 52 | const char *LLVM_General_GetInlineAsmAsmString(LLVMValueRef v) { 53 | return unwrap(v)->getAsmString().c_str(); 54 | } 55 | 56 | const char *LLVM_General_GetInlineAsmConstraintString(LLVMValueRef v) { 57 | return unwrap(v)->getConstraintString().c_str(); 58 | } 59 | 60 | LLVMBool LLVM_General_InlineAsmHasSideEffects(LLVMValueRef v) { 61 | return unwrap(v)->hasSideEffects(); 62 | } 63 | 64 | LLVMBool LLVM_General_InlineAsmIsAlignStack(LLVMValueRef v) { 65 | return unwrap(v)->isAlignStack(); 66 | } 67 | 68 | LLVMAsmDialect LLVM_General_GetInlineAsmDialect(LLVMValueRef v) { 69 | return wrap(unwrap(v)->getDialect()); 70 | } 71 | 72 | } 73 | 74 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Instruction.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__INSTRUCTION__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__INSTRUCTION__H__ 3 | 4 | #include "llvm/Config/llvm-config.h" 5 | 6 | #define LLVM_GENERAL_FOR_EACH_ATOMIC_ORDERING(macro) \ 7 | macro(NotAtomic) \ 8 | macro(Unordered) \ 9 | macro(Monotonic) \ 10 | macro(Acquire) \ 11 | macro(Release) \ 12 | macro(AcquireRelease) \ 13 | macro(SequentiallyConsistent) 14 | 15 | #define LLVM_GENERAL_FOR_EACH_RMW_OPERATION(macro) \ 16 | macro(Xchg) \ 17 | macro(Add) \ 18 | macro(Sub) \ 19 | macro(And) \ 20 | macro(Nand) \ 21 | macro(Or) \ 22 | macro(Xor) \ 23 | macro(Max) \ 24 | macro(Min) \ 25 | macro(UMax) \ 26 | macro(UMin) 27 | 28 | #define LLVM_GENERAL_FOR_EACH_SYNCRONIZATION_SCOPE(macro) \ 29 | macro(SingleThread) \ 30 | macro(CrossThread) 31 | 32 | typedef enum { 33 | #define ENUM_CASE(x) LLVM ## x ## SynchronizationScope, 34 | LLVM_GENERAL_FOR_EACH_SYNCRONIZATION_SCOPE(ENUM_CASE) 35 | #undef ENUM_CASE 36 | } LLVMSynchronizationScope; 37 | 38 | #define LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(macro) \ 39 | macro(UnsafeAlgebra, unsafeAlgebra) \ 40 | macro(NoNaNs, noNaNs) \ 41 | macro(NoInfs, noInfs) \ 42 | macro(NoSignedZeros, noSignedZeros) \ 43 | macro(AllowReciprocal, allowReciprocal) 44 | 45 | typedef enum { 46 | #define ENUM_CASE(x,l) LLVM ## x ## Bit, 47 | LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) 48 | #undef ENUM_CASE 49 | } LLVMFastMathFlagBit; 50 | 51 | typedef enum { 52 | #define ENUM_CASE(x,l) LLVM ## x = (1 << LLVM ## x ## Bit), 53 | LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) 54 | #undef ENUM_CASE 55 | } LLVMFastMathFlags; 56 | 57 | #define LLVM_GENERAL_FOR_EACH_TAIL_CALL_KIND(macro) \ 58 | macro(None) \ 59 | macro(Tail) \ 60 | macro(MustTail) 61 | 62 | typedef enum { 63 | #define ENUM_CASE(x) LLVM_General_TailCallKind_ ## x, 64 | LLVM_GENERAL_FOR_EACH_TAIL_CALL_KIND(ENUM_CASE) 65 | #undef ENUM_CASE 66 | } LLVM_General_TailCallKind; 67 | #endif 68 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/InstructionDefs.hsc: -------------------------------------------------------------------------------- 1 | -- This module translates the instruction data in "llvm/Instruction.def" into a Haskell data structure, 2 | -- so it may be accessed conveniently with Template Haskell code 3 | module LLVM.General.Internal.FFI.InstructionDefs where 4 | 5 | import LLVM.General.Prelude 6 | 7 | import LLVM.General.Internal.FFI.LLVMCTypes 8 | 9 | #define FIRST_TERM_INST(num) struct inst { const char *kind; int opcode; const char *name; const char *clas; } insts[] = { { "Terminator", }, 10 | 11 | #define FIRST_BINARY_INST(num) { "Binary" }, 12 | #define FIRST_MEMORY_INST(num) { "Memory" }, 13 | #define FIRST_CAST_INST(num) { "Cast" }, 14 | #define FIRST_OTHER_INST(num) { "Other" }, 15 | 16 | #define HANDLE_INST(num,opcode,class) { 0, num, #opcode, #class, }, 17 | 18 | #define LAST_OTHER_INST(num) { 0, 0, 0, 0, } }; 19 | 20 | #include "llvm/Config/llvm-config.h" 21 | 22 | #include "llvm/IR/Instruction.def" 23 | 24 | #{ 25 | define hsc_inject() { \ 26 | hsc_printf(" [ "); \ 27 | struct inst *i; \ 28 | const char *kind; \ 29 | int first = 1; \ 30 | for(i = insts; i->kind || i->opcode; ++i) { \ 31 | if (i->kind) { kind = i->kind; continue; } \ 32 | if (!first) { hsc_printf(", "); } else { first = 0; } \ 33 | hsc_printf( \ 34 | " (CPPOpcode %d,\"%s\",\"%s\", %s)", \ 35 | i->opcode, i->name, i->clas, kind \ 36 | ); \ 37 | } \ 38 | hsc_printf(" ] "); \ 39 | } 40 | } 41 | 42 | data InstructionKind = Terminator | Binary | Memory | Cast | Other 43 | deriving (Eq, Ord, Show) 44 | 45 | data InstructionDef = InstructionDef { 46 | cppOpcode :: CPPOpcode, 47 | cAPIName :: String, 48 | cAPIClassName :: String, 49 | instructionKind :: InstructionKind 50 | } 51 | deriving (Eq, Ord, Show) 52 | 53 | instructionDefs :: [InstructionDef] 54 | instructionDefs = [ 55 | InstructionDef o an acn k 56 | | (o, an, acn, k) <- #{inject}, 57 | an /= "UserOp1" && an /= "UserOp2" 58 | ] 59 | 60 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Iterate.hs: -------------------------------------------------------------------------------- 1 | -- | Functions to help handle LLVM iteration patterns 2 | module LLVM.General.Internal.FFI.Iterate where 3 | 4 | import LLVM.General.Prelude 5 | 6 | import Foreign.Ptr 7 | 8 | -- | retrieve a sequence of objects which form a linked list, given an action to 9 | -- | retrieve the first member and an action to proceed through the list 10 | getXs :: IO (Ptr a) -> (Ptr a -> IO (Ptr a)) -> IO [Ptr a] 11 | getXs firstX nextX = walk =<< firstX 12 | where walk x | x == nullPtr = return [] 13 | walk x = (x:) <$> (walk <=< nextX) x 14 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/LibFunc.hs: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bscarlet/llvm-general/61fd03639063283e7dc617698265cc883baf0eec/llvm-general/src/LLVM/General/Internal/FFI/LibFunc.hs -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/MemoryBuffer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.MemoryBuffer where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.Ptr 9 | import Foreign.C 10 | 11 | import LLVM.General.Internal.FFI.LLVMCTypes 12 | 13 | data MemoryBuffer 14 | 15 | foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile :: 16 | Ptr CChar -> Ptr (Ptr MemoryBuffer) -> Ptr (OwnerTransfered CString) -> IO LLVMBool 17 | 18 | foreign import ccall unsafe "LLVMCreateMemoryBufferWithMemoryRange" createMemoryBufferWithMemoryRange :: 19 | Ptr CChar -> CSize -> CString -> LLVMBool -> IO (Ptr MemoryBuffer) 20 | 21 | foreign import ccall unsafe "LLVMGetBufferStart" getBufferStart :: 22 | Ptr MemoryBuffer -> IO (Ptr CChar) 23 | 24 | foreign import ccall unsafe "LLVMGetBufferSize" getBufferSize :: 25 | Ptr MemoryBuffer -> IO CSize 26 | 27 | foreign import ccall unsafe "LLVMDisposeMemoryBuffer" disposeMemoryBuffer :: 28 | Ptr MemoryBuffer -> IO () 29 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Metadata.hs: -------------------------------------------------------------------------------- 1 | {-# 2 | LANGUAGE 3 | ForeignFunctionInterface 4 | #-} 5 | 6 | module LLVM.General.Internal.FFI.Metadata where 7 | 8 | import LLVM.General.Prelude 9 | 10 | import Foreign.Ptr 11 | import Foreign.C 12 | 13 | import LLVM.General.Internal.FFI.Context 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | import LLVM.General.Internal.FFI.LLVMCTypes 16 | 17 | foreign import ccall unsafe "LLVMIsAMDString" isAMDString :: 18 | Ptr Value -> IO (Ptr MDString) 19 | 20 | foreign import ccall unsafe "LLVMIsAMDNode" isAMDNode :: 21 | Ptr Value -> IO (Ptr MDNode) 22 | 23 | foreign import ccall unsafe "LLVMGetMDKindIDInContext" getMDKindIDInContext' :: 24 | Ptr Context -> Ptr CChar -> CUInt -> IO MDKindID 25 | 26 | getMDKindIDInContext ctx (c, n) = getMDKindIDInContext' ctx c n 27 | 28 | foreign import ccall unsafe "LLVM_General_GetMDKindNames" getMDKindNames :: 29 | Ptr Context -> Ptr (Ptr CChar) -> Ptr CUInt -> CUInt -> IO CUInt 30 | 31 | foreign import ccall unsafe "LLVMMDStringInContext" mdStringInContext' :: 32 | Ptr Context -> CString -> CUInt -> IO (Ptr MDString) 33 | 34 | mdStringInContext ctx (p, n) = mdStringInContext' ctx p n 35 | 36 | foreign import ccall unsafe "LLVMGetMDString" getMDString :: 37 | Ptr MDString -> Ptr CUInt -> IO CString 38 | 39 | foreign import ccall unsafe "LLVMMDNodeInContext" createMDNodeInContext' :: 40 | Ptr Context -> Ptr (Ptr Value) -> CUInt -> IO (Ptr MDNode) 41 | 42 | createMDNodeInContext ctx (n, vs) = createMDNodeInContext' ctx vs n 43 | 44 | foreign import ccall unsafe "LLVM_General_CreateTemporaryMDNodeInContext" createTemporaryMDNodeInContext :: 45 | Ptr Context -> IO (Ptr MDNode) 46 | 47 | foreign import ccall unsafe "LLVM_General_DestroyTemporaryMDNode" destroyTemporaryMDNode :: 48 | Ptr MDNode -> IO () 49 | 50 | foreign import ccall unsafe "LLVM_General_GetMDNodeNumOperands" getMDNodeNumOperands :: 51 | Ptr MDNode -> IO CUInt 52 | 53 | foreign import ccall unsafe "LLVMGetMDNodeOperands" getMDNodeOperands :: 54 | Ptr MDNode -> Ptr (Ptr Value) -> IO () 55 | 56 | foreign import ccall unsafe "LLVM_General_MDNodeIsFunctionLocal" mdNodeIsFunctionLocal :: 57 | Ptr MDNode -> IO LLVMBool 58 | 59 | foreign import ccall unsafe "LLVM_General_GetNamedMetadataName" getNamedMetadataName :: 60 | Ptr NamedMetadata -> Ptr CUInt -> IO (Ptr CChar) 61 | 62 | foreign import ccall unsafe "LLVM_General_GetNamedMetadataNumOperands" getNamedMetadataNumOperands :: 63 | Ptr NamedMetadata -> IO CUInt 64 | 65 | foreign import ccall unsafe "LLVM_General_GetNamedMetadataOperands" getNamedMetadataOperands :: 66 | Ptr NamedMetadata -> Ptr (Ptr MDNode) -> IO () 67 | 68 | foreign import ccall unsafe "LLVM_General_NamedMetadataAddOperands" namedMetadataAddOperands' :: 69 | Ptr NamedMetadata -> Ptr (Ptr MDNode) -> CUInt -> IO () 70 | 71 | namedMetadataAddOperands nm (n, vs) = namedMetadataAddOperands' nm vs n 72 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/MetadataC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/Config/llvm-config.h" 3 | #include "llvm/IR/LLVMContext.h" 4 | #include "llvm/IR/Metadata.h" 5 | #include "llvm-c/Core.h" 6 | 7 | using namespace llvm; 8 | 9 | extern "C" { 10 | 11 | unsigned LLVM_General_GetMDKindNames( 12 | LLVMContextRef c, 13 | const char **s, 14 | unsigned *l, 15 | unsigned n 16 | ) { 17 | SmallVector ns; 18 | unwrap(c)->getMDKindNames(ns); 19 | if (ns.size() <= n) { 20 | for(unsigned i=0; i < ns.size(); ++i) { 21 | s[i] = ns[i].data(); 22 | l[i] = ns[i].size(); 23 | } 24 | } 25 | return ns.size(); 26 | } 27 | 28 | unsigned LLVM_General_GetMDNodeNumOperands(LLVMValueRef v) { 29 | return unwrap(v)->getNumOperands(); 30 | } 31 | 32 | unsigned LLVM_General_MDNodeIsFunctionLocal(LLVMValueRef v) { 33 | return unwrap(v)->isFunctionLocal(); 34 | } 35 | 36 | void LLVM_General_NamedMetadataAddOperands( 37 | NamedMDNode *n, 38 | LLVMValueRef *ops, 39 | unsigned nOps 40 | ) { 41 | for(unsigned i = 0; i != nOps; ++i) n->addOperand(unwrap(ops[i])); 42 | } 43 | 44 | const char *LLVM_General_GetNamedMetadataName( 45 | NamedMDNode *n, 46 | unsigned *len 47 | ) { 48 | StringRef s = n->getName(); 49 | *len = s.size(); 50 | return s.data(); 51 | } 52 | 53 | unsigned LLVM_General_GetNamedMetadataNumOperands(NamedMDNode *n) { 54 | return n->getNumOperands(); 55 | } 56 | 57 | void LLVM_General_GetNamedMetadataOperands(NamedMDNode *n, LLVMValueRef *dest) { 58 | for(unsigned i = 0; i != n->getNumOperands(); ++i) 59 | dest[i] = wrap(n->getOperand(i)); 60 | } 61 | 62 | LLVMValueRef LLVM_General_CreateTemporaryMDNodeInContext(LLVMContextRef c) { 63 | return wrap(MDNode::getTemporary(*unwrap(c), ArrayRef())); 64 | } 65 | 66 | void LLVM_General_DestroyTemporaryMDNode(LLVMValueRef v) { 67 | MDNode::deleteTemporary(unwrap(v)); 68 | } 69 | 70 | } 71 | 72 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Module.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__MODULE__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__MODULE__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_LINKER_MODE(macro) \ 5 | macro(DestroySource) \ 6 | macro(PreserveSource) 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Module.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.Module where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.Ptr 9 | import Foreign.C 10 | 11 | import LLVM.General.Internal.FFI.Context 12 | import LLVM.General.Internal.FFI.GlobalValue (COMDAT) 13 | import LLVM.General.Internal.FFI.LLVMCTypes 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | import LLVM.General.Internal.FFI.Type 16 | 17 | data Module 18 | 19 | foreign import ccall unsafe "LLVMModuleCreateWithNameInContext" moduleCreateWithNameInContext :: 20 | CString -> Ptr Context -> IO (Ptr Module) 21 | 22 | foreign import ccall unsafe "LLVMGetModuleContext" getModuleContext :: 23 | Ptr Module -> IO (Ptr Context) 24 | 25 | foreign import ccall unsafe "LLVMDisposeModule" disposeModule :: 26 | Ptr Module -> IO () 27 | 28 | foreign import ccall unsafe "LLVMGetDataLayout" getDataLayout :: 29 | Ptr Module -> IO CString 30 | 31 | foreign import ccall unsafe "LLVMSetDataLayout" setDataLayout :: 32 | Ptr Module -> CString -> IO () 33 | 34 | foreign import ccall unsafe "LLVMGetTarget" getTargetTriple :: 35 | Ptr Module -> IO CString 36 | 37 | foreign import ccall unsafe "LLVMSetTarget" setTargetTriple :: 38 | Ptr Module -> CString -> IO () 39 | 40 | foreign import ccall unsafe "LLVM_General_GetModuleIdentifier" getModuleIdentifier :: 41 | Ptr Module -> IO (OwnerTransfered CString) 42 | 43 | foreign import ccall unsafe "LLVMGetFirstGlobal" getFirstGlobal :: 44 | Ptr Module -> IO (Ptr GlobalVariable) 45 | 46 | foreign import ccall unsafe "LLVMGetNextGlobal" getNextGlobal :: 47 | Ptr GlobalVariable -> IO (Ptr GlobalVariable) 48 | 49 | foreign import ccall unsafe "LLVM_General_GetFirstAlias" getFirstAlias :: 50 | Ptr Module -> IO (Ptr GlobalAlias) 51 | 52 | foreign import ccall unsafe "LLVM_General_GetNextAlias" getNextAlias :: 53 | Ptr GlobalAlias -> IO (Ptr GlobalAlias) 54 | 55 | foreign import ccall unsafe "LLVM_General_GetOrInsertCOMDAT" getOrInsertCOMDAT :: 56 | Ptr Module -> CString -> IO (Ptr COMDAT) 57 | 58 | foreign import ccall unsafe "LLVMGetFirstFunction" getFirstFunction :: 59 | Ptr Module -> IO (Ptr Function) 60 | 61 | foreign import ccall unsafe "LLVMGetNextFunction" getNextFunction :: 62 | Ptr Function -> IO (Ptr Function) 63 | 64 | foreign import ccall unsafe "LLVM_General_GetFirstNamedMetadata" getFirstNamedMetadata :: 65 | Ptr Module -> IO (Ptr NamedMetadata) 66 | 67 | foreign import ccall unsafe "LLVM_General_GetNextNamedMetadata" getNextNamedMetadata :: 68 | Ptr NamedMetadata -> IO (Ptr NamedMetadata) 69 | 70 | foreign import ccall unsafe "LLVMAddGlobalInAddressSpace" addGlobalInAddressSpace :: 71 | Ptr Module -> Ptr Type -> CString -> CUInt -> IO (Ptr GlobalVariable) 72 | 73 | foreign import ccall unsafe "LLVM_General_JustAddAlias" justAddAlias :: 74 | Ptr Module -> Ptr Type -> AddrSpace -> CString -> IO (Ptr GlobalAlias) 75 | 76 | 77 | foreign import ccall unsafe "LLVMAddFunction" addFunction :: 78 | Ptr Module -> CString -> Ptr Type -> IO (Ptr Function) 79 | 80 | foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction :: 81 | Ptr Module -> CString -> IO (Ptr Function) 82 | 83 | foreign import ccall unsafe "LLVM_General_GetOrAddNamedMetadata" getOrAddNamedMetadata :: 84 | Ptr Module -> CString -> IO (Ptr NamedMetadata) 85 | 86 | foreign import ccall unsafe "LLVM_General_ModuleAppendInlineAsm" moduleAppendInlineAsm' :: 87 | Ptr Module -> Ptr CChar -> CUInt -> IO () 88 | 89 | newtype ModuleAsm a = ModuleAsm a 90 | 91 | moduleAppendInlineAsm m (ModuleAsm (c, n)) = moduleAppendInlineAsm' m c n 92 | 93 | foreign import ccall unsafe "LLVM_General_ModuleGetInlineAsm" moduleGetInlineAsm :: 94 | Ptr Module -> IO (ModuleAsm CString) 95 | 96 | foreign import ccall unsafe "LLVMLinkModules" linkModules :: 97 | Ptr Module -> Ptr Module -> LinkerMode -> Ptr (OwnerTransfered CString) -> IO LLVMBool 98 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ModuleC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/IR/Module.h" 3 | #include "llvm-c/Core.h" 4 | 5 | using namespace llvm; 6 | 7 | extern "C" { 8 | 9 | char *LLVM_General_GetModuleIdentifier(LLVMModuleRef val) { 10 | return strdup(unwrap(val)->getModuleIdentifier().c_str()); 11 | } 12 | 13 | LLVMValueRef LLVM_General_GetFirstAlias(LLVMModuleRef m) { 14 | Module *mod = unwrap(m); 15 | Module::alias_iterator i = mod->alias_begin(); 16 | return i == mod->alias_end() ? 0 : wrap(i); 17 | } 18 | 19 | LLVMValueRef LLVM_General_GetNextAlias(LLVMValueRef a) { 20 | GlobalAlias *alias = unwrap(a); 21 | Module::alias_iterator i = alias; 22 | if (++i == alias->getParent()->alias_end()) return 0; 23 | return wrap(i); 24 | } 25 | 26 | Comdat *LLVM_General_GetOrInsertCOMDAT(LLVMModuleRef m, const char *name) { 27 | return unwrap(m)->getOrInsertComdat(name); 28 | } 29 | 30 | LLVMValueRef LLVM_General_JustAddAlias(LLVMModuleRef m, LLVMTypeRef ty, unsigned addrspace, const char *name) { 31 | return wrap(GlobalAlias::create(unwrap(ty), addrspace, GlobalValue::ExternalLinkage, name, 0, unwrap(m))); 32 | } 33 | 34 | NamedMDNode *LLVM_General_GetOrAddNamedMetadata(LLVMModuleRef m, const char *name) { 35 | return unwrap(m)->getOrInsertNamedMetadata(name); 36 | } 37 | 38 | NamedMDNode *LLVM_General_GetFirstNamedMetadata(LLVMModuleRef m) { 39 | Module *mod = unwrap(m); 40 | Module::named_metadata_iterator i = mod->named_metadata_begin(); 41 | return i == mod->named_metadata_end() ? 0 : i; 42 | } 43 | 44 | NamedMDNode *LLVM_General_GetNextNamedMetadata(NamedMDNode *a) { 45 | Module::named_metadata_iterator i = a; 46 | if (++i == a->getParent()->named_metadata_end()) return 0; 47 | return i; 48 | } 49 | 50 | void LLVM_General_ModuleAppendInlineAsm(LLVMModuleRef m, const char *s, unsigned l) { 51 | unwrap(m)->appendModuleInlineAsm(StringRef(s,l)); 52 | } 53 | 54 | const char *LLVM_General_ModuleGetInlineAsm(LLVMModuleRef m) { 55 | return unwrap(m)->getModuleInlineAsm().c_str(); 56 | } 57 | 58 | } 59 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/PtrHierarchy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | FunctionalDependencies, 5 | UndecidableInstances, 6 | CPP 7 | #-} 8 | #if __GLASGOW_HASKELL__ < 710 9 | {-# LANGUAGE OverlappingInstances #-} 10 | #define CPP_OVERLAPPING 11 | #else 12 | #define CPP_OVERLAPPING {-# OVERLAPPING #-} 13 | #endif 14 | -- | This module defines typeclasses to represent the relationships of an object-oriented inheritance hierarchy 15 | module LLVM.General.Internal.FFI.PtrHierarchy where 16 | 17 | import LLVM.General.Prelude 18 | 19 | import Foreign.Ptr 20 | 21 | -- | a class to represent safe casting of pointers to objects of descendant-classes to ancestor-classes. 22 | class DescendentOf a b where 23 | upCast :: Ptr b -> Ptr a 24 | upCast = castPtr 25 | 26 | -- | trivial casts 27 | instance CPP_OVERLAPPING DescendentOf a a where 28 | upCast = id 29 | 30 | -- | a class to represent direct parent-child relationships 31 | class ChildOf b c | c -> b 32 | 33 | -- | ancestor-descentant relationships are build out of parent-child relationships 34 | instance (DescendentOf a b, ChildOf b c) => DescendentOf a c 35 | 36 | -- | 37 | data Value 38 | 39 | -- | 40 | data Constant 41 | 42 | instance ChildOf User Constant 43 | 44 | -- | 45 | data GlobalValue 46 | 47 | instance ChildOf Constant GlobalValue 48 | 49 | -- | 50 | data GlobalObject 51 | 52 | instance ChildOf GlobalValue GlobalObject 53 | 54 | -- | 55 | data GlobalVariable 56 | 57 | instance ChildOf GlobalObject GlobalVariable 58 | 59 | -- | 60 | data GlobalAlias 61 | 62 | instance ChildOf GlobalValue GlobalAlias 63 | 64 | -- | 65 | data Function 66 | 67 | instance ChildOf GlobalObject Function 68 | 69 | -- | 70 | data BasicBlock 71 | 72 | instance ChildOf Value BasicBlock 73 | 74 | -- | 75 | data Parameter 76 | 77 | instance ChildOf Value Parameter 78 | 79 | -- | 80 | data Instruction 81 | 82 | instance ChildOf User Instruction 83 | 84 | -- | 85 | data BinaryOperator 86 | 87 | instance ChildOf Instruction BinaryOperator 88 | 89 | -- | 90 | data User 91 | 92 | instance ChildOf Value User 93 | 94 | -- | 95 | data MDNode 96 | 97 | instance ChildOf Value MDNode 98 | 99 | -- | 100 | data MDString 101 | 102 | instance ChildOf Value MDString 103 | 104 | -- | 105 | data NamedMetadata 106 | 107 | -- | 108 | data InlineAsm 109 | 110 | instance ChildOf Value InlineAsm 111 | 112 | -- | 113 | data Type 114 | 115 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/RawOStream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.RawOStream where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.Ptr 9 | import Foreign.C 10 | import Control.Exception (bracket) 11 | 12 | import LLVM.General.Internal.FFI.ByteRangeCallback 13 | import LLVM.General.Internal.FFI.LLVMCTypes 14 | 15 | data RawOStream 16 | 17 | type RawOStreamCallback = Ptr RawOStream -> IO () 18 | foreign import ccall "wrapper" wrapRawOStreamCallback :: 19 | RawOStreamCallback -> IO (FunPtr RawOStreamCallback) 20 | 21 | foreign import ccall safe "LLVM_General_WithFileRawOStream" withFileRawOStream' :: 22 | CString -> LLVMBool -> LLVMBool -> Ptr (OwnerTransfered CString) -> FunPtr RawOStreamCallback -> IO LLVMBool 23 | 24 | withFileRawOStream :: CString -> LLVMBool -> LLVMBool -> Ptr (OwnerTransfered CString) -> RawOStreamCallback -> IO LLVMBool 25 | withFileRawOStream p ex bin err c = 26 | bracket (wrapRawOStreamCallback c) freeHaskellFunPtr (withFileRawOStream' p ex bin err) 27 | 28 | foreign import ccall safe "LLVM_General_WithBufferRawOStream" withBufferRawOStream' :: 29 | FunPtr ByteRangeCallback -> FunPtr RawOStreamCallback -> IO () 30 | 31 | withBufferRawOStream :: ByteRangeCallback -> RawOStreamCallback -> IO () 32 | withBufferRawOStream oc c = 33 | bracket (wrapRawOStreamCallback c) freeHaskellFunPtr $ \c -> 34 | bracket (wrapByteRangeCallback oc) freeHaskellFunPtr $ \oc -> 35 | withBufferRawOStream' oc c 36 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/RawOStreamC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/Support/raw_ostream.h" 3 | #include "llvm/Support/FileSystem.h" 4 | #include "llvm-c/Core.h" 5 | 6 | using namespace llvm; 7 | using sys::fs::F_None; 8 | using sys::fs::F_Excl; 9 | using sys::fs::F_Text; 10 | 11 | extern "C" { 12 | 13 | LLVMBool LLVM_General_WithFileRawOStream( 14 | const char *filename, 15 | LLVMBool excl, 16 | LLVMBool text, 17 | const char *&error, 18 | void (&callback)(raw_ostream &ostream) 19 | ) { 20 | std::string e; 21 | raw_fd_ostream os(filename, e, (excl ? F_Excl : F_None) | (text ? F_Text : F_None)); 22 | if (!e.empty()) { 23 | error = strdup(e.c_str()); 24 | return false; 25 | } 26 | callback(os); 27 | return true; 28 | } 29 | 30 | void LLVM_General_WithBufferRawOStream( 31 | void (&outputCallback)(const char *start, size_t length), 32 | void (&streamCallback)(raw_ostream &ostream) 33 | ) { 34 | std::string s; 35 | { 36 | raw_string_ostream os(s); 37 | streamCallback(os); 38 | } 39 | outputCallback(s.data(), s.size()); 40 | } 41 | 42 | } 43 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/SMDiagnostic.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__SMDIAGNOSTIC__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__SMDIAGNOSTIC__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_DIAGNOSTIC_KIND(macro) \ 5 | macro(Error) \ 6 | macro(Warning) \ 7 | macro(Note) 8 | 9 | typedef enum { 10 | #define ENUM_CASE(k) LLVMDiagnosticKind ## k, 11 | LLVM_GENERAL_FOR_EACH_DIAGNOSTIC_KIND(ENUM_CASE) 12 | #undef ENUM_CASE 13 | } LLVMDiagnosticKind; 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/SMDiagnostic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | -- | FFI functions for handling the LLVM SMDiagnostic class 5 | module LLVM.General.Internal.FFI.SMDiagnostic where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Foreign.Ptr 10 | import Foreign.C 11 | 12 | import LLVM.General.Internal.FFI.LLVMCTypes 13 | 14 | data SMDiagnostic 15 | 16 | -- | allocate an SMDiagnostic object 17 | foreign import ccall unsafe "LLVM_General_CreateSMDiagnostic" createSMDiagnostic :: 18 | IO (Ptr SMDiagnostic) 19 | 20 | foreign import ccall unsafe "LLVM_General_DisposeSMDiagnostic" disposeSMDiagnostic :: 21 | Ptr SMDiagnostic -> IO () 22 | 23 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticKind" getSMDiagnosticKind :: 24 | Ptr SMDiagnostic -> IO DiagnosticKind 25 | 26 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticLineNo" getSMDiagnosticLineNo :: 27 | Ptr SMDiagnostic -> IO CInt 28 | 29 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticColumnNo" getSMDiagnosticColumnNo :: 30 | Ptr SMDiagnostic -> IO CInt 31 | 32 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticFilename" getSMDiagnosticFilename :: 33 | Ptr SMDiagnostic -> Ptr CUInt -> IO CString 34 | 35 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticMessage" getSMDiagnosticMessage :: 36 | Ptr SMDiagnostic -> Ptr CUInt -> IO CString 37 | 38 | foreign import ccall unsafe "LLVM_General_GetSMDiagnosticLineContents" getSMDiagnosticLineContents :: 39 | Ptr SMDiagnostic -> Ptr CUInt -> IO CString 40 | 41 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/SMDiagnosticC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm/Config/llvm-config.h" 3 | #include "llvm/IR/LLVMContext.h" 4 | 5 | #include "llvm/Support/SourceMgr.h" 6 | #include "llvm-c/Core.h" 7 | 8 | #include "LLVM/General/Internal/FFI/SMDiagnostic.h" 9 | 10 | using namespace llvm; 11 | 12 | extern "C" { 13 | 14 | SMDiagnostic *LLVM_General_CreateSMDiagnostic() { return new SMDiagnostic(); } 15 | void LLVM_General_DisposeSMDiagnostic(SMDiagnostic *p) { delete p; } 16 | 17 | LLVMDiagnosticKind LLVM_General_GetSMDiagnosticKind(SMDiagnostic *p) { 18 | switch(p->getKind()) { 19 | #define ENUM_CASE(k) case SourceMgr::DK_ ## k: return LLVMDiagnosticKind ## k; 20 | LLVM_GENERAL_FOR_EACH_DIAGNOSTIC_KIND(ENUM_CASE) 21 | #undef ENUM_CASE 22 | default: return LLVMDiagnosticKind(0); 23 | } 24 | } 25 | 26 | int LLVM_General_GetSMDiagnosticLineNo(SMDiagnostic *p) { return p->getLineNo(); } 27 | int LLVM_General_GetSMDiagnosticColumnNo(SMDiagnostic *p) { return p->getColumnNo(); } 28 | 29 | const char *LLVM_General_GetSMDiagnosticFilename(SMDiagnostic *p, unsigned *len) { 30 | *len = p->getFilename().size(); 31 | return p->getFilename().data(); 32 | } 33 | const char *LLVM_General_GetSMDiagnosticMessage(SMDiagnostic *p, unsigned *len) { 34 | *len = p->getMessage().size(); 35 | return p->getMessage().data(); 36 | } 37 | const char *LLVM_General_GetSMDiagnosticLineContents(SMDiagnostic *p, unsigned *len) { 38 | *len = p->getLineContents().size(); 39 | return p->getLineContents().data(); 40 | } 41 | 42 | } 43 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Target.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__TARGET__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__TARGET__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_RELOC_MODEL(macro) \ 5 | macro(Default, Default) \ 6 | macro(Static, Static) \ 7 | macro(PIC, PIC_) \ 8 | macro(DynamicNoPic, DynamicNoPIC) 9 | 10 | #define LLVM_GENERAL_FOR_EACH_CODE_MODEL(macro) \ 11 | macro(Default) \ 12 | macro(JITDefault) \ 13 | macro(Small) \ 14 | macro(Kernel) \ 15 | macro(Medium) \ 16 | macro(Large) 17 | 18 | #define LLVM_GENERAL_FOR_EACH_CODE_GEN_OPT_LEVEL(macro) \ 19 | macro(None) \ 20 | macro(Less) \ 21 | macro(Default) \ 22 | macro(Aggressive) 23 | 24 | #define LLVM_GENERAL_FOR_EACH_CODE_GEN_FILE_TYPE(macro) \ 25 | macro(Assembly) \ 26 | macro(Object) 27 | 28 | #define LLVM_GENERAL_FOR_EACH_TARGET_OPTION_FLAG(macro) \ 29 | macro(PrintMachineCode) \ 30 | macro(NoFramePointerElim) \ 31 | macro(LessPreciseFPMADOption) \ 32 | macro(UnsafeFPMath) \ 33 | macro(NoInfsFPMath) \ 34 | macro(NoNaNsFPMath) \ 35 | macro(HonorSignDependentRoundingFPMathOption) \ 36 | macro(UseSoftFloat) \ 37 | macro(NoZerosInBSS) \ 38 | macro(JITEmitDebugInfo) \ 39 | macro(JITEmitDebugInfoToDisk) \ 40 | macro(GuaranteedTailCallOpt) \ 41 | macro(DisableTailCalls) \ 42 | macro(EnableFastISel) \ 43 | macro(PositionIndependentExecutable) \ 44 | macro(UseInitArray) \ 45 | macro(DisableIntegratedAS) \ 46 | macro(CompressDebugSections) \ 47 | macro(TrapUnreachable) 48 | 49 | typedef enum { 50 | #define ENUM_CASE(n) LLVM_General_TargetOptionFlag_ ## n, 51 | LLVM_GENERAL_FOR_EACH_TARGET_OPTION_FLAG(ENUM_CASE) 52 | #undef ENUM_CASE 53 | } LLVM_General_TargetOptionFlag; 54 | 55 | #define LLVM_GENERAL_FOR_EACH_FLOAT_ABI(macro) \ 56 | macro(Default) \ 57 | macro(Soft) \ 58 | macro(Hard) 59 | 60 | typedef enum { 61 | #define ENUM_CASE(n) LLVM_General_FloatABI_ ## n, 62 | LLVM_GENERAL_FOR_EACH_FLOAT_ABI(ENUM_CASE) 63 | #undef ENUM_CASE 64 | } LLVM_General_FloatABI; 65 | 66 | #define LLVM_GENERAL_FOR_EACH_FP_OP_FUSION_MODE(macro) \ 67 | macro(Fast) \ 68 | macro(Standard) \ 69 | macro(Strict) 70 | 71 | typedef enum { 72 | #define ENUM_CASE(n) LLVM_General_FPOpFusionMode_ ## n, 73 | LLVM_GENERAL_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) 74 | #undef ENUM_CASE 75 | } LLVM_General_FPOpFusionMode; 76 | 77 | #endif 78 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Threading.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Internal.FFI.Threading where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Foreign.C 9 | 10 | import LLVM.General.Internal.FFI.LLVMCTypes 11 | 12 | foreign import ccall unsafe "LLVMIsMultithreaded" isMultithreaded :: 13 | IO LLVMBool 14 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Transforms.hs: -------------------------------------------------------------------------------- 1 | -- | Code used with Template Haskell to build the FFI for transform passes. 2 | module LLVM.General.Internal.FFI.Transforms where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | does the constructor for this pass require a TargetMachine object 7 | needsTargetMachine "CodeGenPrepare" = True 8 | needsTargetMachine _ = False 9 | 10 | -- | Translate a Haskell name (used in the public Haskell interface, typically not abbreviated) 11 | -- | for a pass into the (sometimes obscure, sometimes abbreviated) name used in the LLVM C interface. 12 | -- | This translation includes, by choice of prefix, whether the C interface implementation is found in 13 | -- | the LLVM distribution ("LLVM" prefix) or either not available or broken there and so implemented 14 | -- | as part of this Haskell package ("LLVM_General_" prefix). 15 | cName n = 16 | let core = case n of 17 | "AddressSanitizer" -> "AddressSanitizerFunction" 18 | "AggressiveDeadCodeElimination" -> "AggressiveDCE" 19 | "AlwaysInline" -> "AlwaysInliner" 20 | "DeadInstructionElimination" -> "DeadInstElimination" 21 | "EarlyCommonSubexpressionElimination" -> "EarlyCSE" 22 | "FunctionAttributes" -> "FunctionAttrs" 23 | "GlobalDeadCodeElimination" -> "GlobalDCE" 24 | "InductionVariableSimplify" -> "IndVarSimplify" 25 | "InternalizeFunctions" -> "Internalize" 26 | "InterproceduralConstantPropagation" -> "IPConstantPropagation" 27 | "InterproceduralSparseConditionalConstantPropagation" -> "IPSCCP" 28 | "LoopClosedSingleStaticAssignment" -> "LCSSA" 29 | "LoopInvariantCodeMotion" -> "LICM" 30 | "LoopInstructionSimplify" -> "LoopInstSimplify" 31 | "MemcpyOptimization" -> "MemCpyOpt" 32 | "PruneExceptionHandling" -> "PruneEH" 33 | "ScalarReplacementOfAggregates" -> "SROA" 34 | "OldScalarReplacementOfAggregates" -> "ScalarReplAggregates" 35 | "SimplifyControlFlowGraph" -> "CFGSimplification" 36 | "SparseConditionalConstantPropagation" -> "SCCP" 37 | "SuperwordLevelParallelismVectorize" -> "SLPVectorize" 38 | h -> h 39 | patchImpls = [ 40 | "AddressSanitizer", 41 | "AddressSanitizerModule", 42 | "BoundsChecking", 43 | "CodeGenPrepare", 44 | "GlobalValueNumbering", 45 | "InternalizeFunctions", 46 | "BasicBlockVectorize", 47 | "BlockPlacement", 48 | "BreakCriticalEdges", 49 | "DeadCodeElimination", 50 | "DeadInstructionElimination", 51 | "DebugExistingIR", 52 | "DebugGeneratedIR", 53 | "DemoteRegisterToMemory", 54 | "EdgeProfiler", 55 | "GCOVProfiler", 56 | "LoopClosedSingleStaticAssignment", 57 | "LoopInstructionSimplify", 58 | "LoopStrengthReduce", 59 | "LoopVectorize", 60 | "LowerAtomic", 61 | "LowerInvoke", 62 | "LowerSwitch", 63 | "MemorySanitizer", 64 | "MergeFunctions", 65 | "OptimalEdgeProfiler", 66 | "PathProfiler", 67 | "PartialInlining", 68 | "ScalarReplacementOfAggregates", 69 | "Sinking", 70 | "StripDeadDebugInfo", 71 | "StripDebugDeclare", 72 | "StripNonDebugSymbols", 73 | "ThreadSanitizer" 74 | ] 75 | in 76 | (if (n `elem` patchImpls) then "LLVM_General_" else "LLVM") ++ "Add" ++ core ++ "Pass" 77 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Type.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__TYPE__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__TYPE__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_TYPE_KIND(macro) \ 5 | macro(Void) \ 6 | macro(Half) \ 7 | macro(Float) \ 8 | macro(Double) \ 9 | macro(X86_FP80) \ 10 | macro(FP128) \ 11 | macro(PPC_FP128) \ 12 | macro(Label) \ 13 | macro(Integer) \ 14 | macro(Function) \ 15 | macro(Struct) \ 16 | macro(Array) \ 17 | macro(Pointer) \ 18 | macro(Vector) \ 19 | macro(Metadata) \ 20 | macro(X86_MMX) 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/TypeC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm-c/Core.h" 3 | #include "llvm/IR/LLVMContext.h" 4 | #include "llvm/IR/Type.h" 5 | #include "llvm/IR/DerivedTypes.h" 6 | 7 | using namespace llvm; 8 | 9 | extern "C" { 10 | 11 | LLVMTypeRef LLVM_General_StructCreateNamed(LLVMContextRef C, const char *Name) { 12 | if (Name) { 13 | return wrap(StructType::create(*unwrap(C), Name)); 14 | } else { 15 | return wrap(StructType::create(*unwrap(C))); 16 | } 17 | } 18 | 19 | LLVMBool LLVM_General_StructIsLiteral(LLVMTypeRef t) { 20 | return unwrap(t)->isLiteral(); 21 | } 22 | 23 | LLVMBool LLVM_General_StructIsOpaque(LLVMTypeRef t) { 24 | return unwrap(t)->isOpaque(); 25 | } 26 | 27 | LLVMTypeRef LLVM_General_ArrayType(LLVMTypeRef ElementType, uint64_t ElementCount) { 28 | return wrap(ArrayType::get(unwrap(ElementType), ElementCount)); 29 | } 30 | 31 | uint64_t LLVM_General_GetArrayLength(LLVMTypeRef ArrayTy) { 32 | return unwrap(ArrayTy)->getNumElements(); 33 | } 34 | 35 | LLVMTypeRef LLVM_General_MetadataTypeInContext(LLVMContextRef C) { 36 | return wrap(Type::getMetadataTy(*unwrap(C))); 37 | } 38 | 39 | } 40 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/User.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM User class 7 | module LLVM.General.Internal.FFI.User where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | import Foreign.C 13 | 14 | import LLVM.General.Internal.FFI.PtrHierarchy 15 | 16 | -- | a blind type to correspond to llvm::Use 17 | data Use 18 | 19 | -- | test if a 'Value' is a 'User' 20 | foreign import ccall unsafe "LLVMIsAUser" isAUser :: 21 | Ptr Value -> IO (Ptr User) 22 | 23 | -- | 24 | foreign import ccall unsafe "LLVMGetFirstUse" getFirstUse :: 25 | Ptr User -> IO (Ptr Use) 26 | 27 | -- | 28 | foreign import ccall unsafe "LLVMGetNextUse" getNextUse :: 29 | Ptr Use -> IO (Ptr Use) 30 | 31 | -- | 32 | foreign import ccall unsafe "LLVMGetNumOperands" getNumOperands :: 33 | Ptr User -> IO CUInt 34 | 35 | -- | 36 | foreign import ccall unsafe "LLVMGetOperand" getOperand :: 37 | Ptr User -> CUInt -> IO (Ptr Value) 38 | 39 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Value.h: -------------------------------------------------------------------------------- 1 | #ifndef __LLVM_GENERAL_INTERNAL_FFI__VALUE__H__ 2 | #define __LLVM_GENERAL_INTERNAL_FFI__VALUE__H__ 3 | 4 | #define LLVM_GENERAL_FOR_EACH_VALUE_SUBCLASS(macro) \ 5 | macro(Argument) \ 6 | macro(BasicBlock) \ 7 | macro(Function) \ 8 | macro(GlobalAlias) \ 9 | macro(GlobalVariable) \ 10 | macro(UndefValue) \ 11 | macro(BlockAddress) \ 12 | macro(ConstantExpr) \ 13 | macro(ConstantAggregateZero) \ 14 | macro(ConstantDataArray) \ 15 | macro(ConstantDataVector) \ 16 | macro(ConstantInt) \ 17 | macro(ConstantFP) \ 18 | macro(ConstantArray) \ 19 | macro(ConstantStruct) \ 20 | macro(ConstantVector) \ 21 | macro(ConstantPointerNull) \ 22 | macro(MDNode) \ 23 | macro(MDString) \ 24 | macro(InlineAsm) \ 25 | macro(Instruction) 26 | 27 | typedef enum { 28 | #define ENUM_CASE(class) LLVM ## class ## SubclassId, 29 | LLVM_GENERAL_FOR_EACH_VALUE_SUBCLASS(ENUM_CASE) 30 | #undef ENUM_CASE 31 | } LLVMValueSubclassId; 32 | 33 | #endif 34 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/Value.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface, 3 | MultiParamTypeClasses, 4 | UndecidableInstances 5 | #-} 6 | -- | FFI functions for handling the LLVM Value class 7 | module LLVM.General.Internal.FFI.Value where 8 | 9 | import LLVM.General.Prelude 10 | 11 | import Foreign.Ptr 12 | import Foreign.C 13 | 14 | import LLVM.General.Internal.FFI.LLVMCTypes 15 | import LLVM.General.Internal.FFI.PtrHierarchy 16 | 17 | -- | 18 | foreign import ccall unsafe "LLVMTypeOf" typeOf :: 19 | Ptr Value -> IO (Ptr Type) 20 | 21 | -- | 22 | foreign import ccall unsafe "LLVMGetValueName" getValueName :: 23 | Ptr Value -> IO CString 24 | 25 | -- | 26 | foreign import ccall unsafe "LLVMSetValueName" setValueName :: 27 | Ptr Value -> CString -> IO () 28 | 29 | -- | This function exposes the ID returned by llvm::Value::getValueID() 30 | -- | . 31 | foreign import ccall unsafe "LLVM_General_GetValueSubclassId" getValueSubclassId :: 32 | Ptr Value -> IO ValueSubclassId 33 | 34 | foreign import ccall unsafe "LLVMReplaceAllUsesWith" replaceAllUsesWith :: 35 | Ptr Value -> Ptr Value -> IO () 36 | 37 | foreign import ccall unsafe "LLVM_General_CreateArgument" createArgument :: 38 | Ptr Type -> CString -> IO (Ptr Value) 39 | 40 | foreign import ccall unsafe "LLVMDumpValue" dumpValue :: 41 | Ptr Value -> IO () 42 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FFI/ValueC.cpp: -------------------------------------------------------------------------------- 1 | #define __STDC_LIMIT_MACROS 2 | #include "llvm-c/Core.h" 3 | #include "llvm/IR/Type.h" 4 | #include "llvm/IR/Value.h" 5 | #include "llvm/IR/Argument.h" 6 | #include "LLVM/General/Internal/FFI/Value.h" 7 | 8 | using namespace llvm; 9 | 10 | extern "C" { 11 | 12 | LLVMValueSubclassId LLVM_General_GetValueSubclassId(LLVMValueRef v) { 13 | switch(unwrap(v)->getValueID()) { 14 | #define VALUE_SUBCLASS_ID_CASE(class) case Value::class ## Val: return LLVM ## class ## SubclassId; 15 | LLVM_GENERAL_FOR_EACH_VALUE_SUBCLASS(VALUE_SUBCLASS_ID_CASE) 16 | #undef VALUE_SUBCLASS_ID_CASE 17 | default: break; 18 | } 19 | return LLVMValueSubclassId(0); 20 | } 21 | 22 | LLVMValueRef LLVM_General_CreateArgument( 23 | LLVMTypeRef t, 24 | const char *name 25 | ) { 26 | return wrap(new Argument(unwrap(t), name)); 27 | } 28 | 29 | } 30 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FastMathFlags.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses 3 | #-} 4 | module LLVM.General.Internal.FastMathFlags where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Control.Monad.Trans 9 | import Control.Monad.AnyCont 10 | import Control.Monad.State 11 | import Control.Exception 12 | 13 | import Data.Bits 14 | 15 | import qualified LLVM.General.Internal.FFI.Builder as FFI 16 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 17 | 18 | import LLVM.General.Internal.Coding 19 | import LLVM.General.Internal.EncodeAST 20 | 21 | import qualified LLVM.General.AST as A 22 | 23 | instance EncodeM IO A.FastMathFlags FFI.FastMathFlags where 24 | encodeM A.NoFastMathFlags = return 0 25 | encodeM A.UnsafeAlgebra = return FFI.fastMathFlagsUnsafeAlgebra 26 | encodeM f = return $ foldr1 (.|.) [ 27 | if a f then b else 0 28 | | (a,b) <- [ 29 | (A.noNaNs, FFI.fastMathFlagsNoNaNs), 30 | (A.noInfs, FFI.fastMathFlagsNoInfs), 31 | (A.noSignedZeros, FFI.fastMathFlagsNoSignedZeros), 32 | (A.allowReciprocal, FFI.fastMathFlagsAllowReciprocal) 33 | ] 34 | ] 35 | 36 | instance EncodeM EncodeAST A.FastMathFlags () where 37 | encodeM f = do 38 | f <- liftIO $ encodeM f 39 | builder <- gets encodeStateBuilder 40 | anyContToM $ bracket (FFI.setFastMathFlags builder f) (\() -> FFI.setFastMathFlags builder 0) 41 | 42 | instance Monad m => DecodeM m A.FastMathFlags FFI.FastMathFlags where 43 | decodeM 0 = return A.NoFastMathFlags 44 | decodeM f | FFI.fastMathFlagsUnsafeAlgebra .&. f /= 0 = return A.UnsafeAlgebra 45 | decodeM f = return A.FastMathFlags { 46 | A.noNaNs = FFI.fastMathFlagsNoNaNs .&. f /= 0, 47 | A.noInfs = FFI.fastMathFlagsNoInfs .&. f /= 0, 48 | A.noSignedZeros = FFI.fastMathFlagsNoSignedZeros .&. f /= 0, 49 | A.allowReciprocal = FFI.fastMathFlagsAllowReciprocal .&. f /= 0 50 | } 51 | 52 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/FloatingPointPredicate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses, 3 | TemplateHaskell 4 | #-} 5 | module LLVM.General.Internal.FloatingPointPredicate where 6 | 7 | import LLVM.General.Internal.Coding 8 | 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | import qualified LLVM.General.AST.FloatingPointPredicate as A.FPPred 11 | 12 | genCodingInstance [t| A.FPPred.FloatingPointPredicate |] ''FFI.FCmpPredicate [ 13 | (FFI.fCmpPredFalse, A.FPPred.False), 14 | (FFI.fCmpPredOEQ, A.FPPred.OEQ), 15 | (FFI.fCmpPredOGT, A.FPPred.OGT), 16 | (FFI.fCmpPredOGE, A.FPPred.OGE), 17 | (FFI.fCmpPredOLT, A.FPPred.OLT), 18 | (FFI.fCmpPredOLE, A.FPPred.OLE), 19 | (FFI.fCmpPredONE, A.FPPred.ONE), 20 | (FFI.fCmpPredORD, A.FPPred.ORD), 21 | (FFI.fCmpPredUNO, A.FPPred.UNO), 22 | (FFI.fCmpPredUEQ, A.FPPred.UEQ), 23 | (FFI.fCmpPredUGT, A.FPPred.UGT), 24 | (FFI.fCmpPredUGE, A.FPPred.UGE), 25 | (FFI.fCmpPredULT, A.FPPred.ULT), 26 | (FFI.fCmpPredULE, A.FPPred.ULE), 27 | (FFI.fCmpPredUNE, A.FPPred.UNE), 28 | (FFI.fcmpPredTrue, A.FPPred.True) 29 | ] 30 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Function.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.Function where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.Trans 6 | import Control.Monad.AnyCont 7 | 8 | import Foreign.C (CUInt) 9 | import Foreign.Ptr 10 | 11 | import Data.Map (Map) 12 | import qualified Data.Map as Map 13 | 14 | import qualified LLVM.General.Internal.FFI.Function as FFI 15 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 16 | 17 | import LLVM.General.Internal.DecodeAST 18 | import LLVM.General.Internal.EncodeAST 19 | import LLVM.General.Internal.Value 20 | import LLVM.General.Internal.Coding 21 | import LLVM.General.Internal.Constant () 22 | import LLVM.General.Internal.Attribute 23 | 24 | import qualified LLVM.General.AST as A 25 | import qualified LLVM.General.AST.Constant as A 26 | import qualified LLVM.General.AST.ParameterAttribute as A.PA 27 | 28 | getMixedAttributeSet :: Ptr FFI.Function -> DecodeAST MixedAttributeSet 29 | getMixedAttributeSet = decodeM <=< liftIO . FFI.getMixedAttributeSet 30 | 31 | setFunctionAttributes :: Ptr FFI.Function -> MixedAttributeSet -> EncodeAST () 32 | setFunctionAttributes f = (liftIO . FFI.setMixedAttributeSet f) <=< encodeM 33 | 34 | getParameters :: Ptr FFI.Function -> Map CUInt [A.PA.ParameterAttribute] -> DecodeAST [A.Parameter] 35 | getParameters f attrs = scopeAnyCont $ do 36 | n <- liftIO (FFI.countParams f) 37 | ps <- allocaArray n 38 | liftIO $ FFI.getParams f ps 39 | params <- peekArray n ps 40 | forM (zip params [0..]) $ \(param, i) -> 41 | return A.Parameter 42 | `ap` typeOf param 43 | `ap` getLocalName param 44 | `ap` (return $ Map.findWithDefault [] i attrs) 45 | 46 | getGC :: Ptr FFI.Function -> DecodeAST (Maybe String) 47 | getGC f = scopeAnyCont $ decodeM =<< liftIO (FFI.getGC f) 48 | 49 | setGC :: Ptr FFI.Function -> Maybe String -> EncodeAST () 50 | setGC f gc = scopeAnyCont $ liftIO . FFI.setGC f =<< encodeM gc 51 | 52 | getPrefixData :: Ptr FFI.Function -> DecodeAST (Maybe A.Constant) 53 | getPrefixData f = do 54 | has <- decodeM =<< (liftIO $ FFI.hasPrefixData f) 55 | if has 56 | then decodeM =<< (liftIO $ FFI.getPrefixData f) 57 | else return Nothing 58 | 59 | setPrefixData :: Ptr FFI.Function -> Maybe A.Constant -> EncodeAST () 60 | setPrefixData f = maybe (return ()) (liftIO . FFI.setPrefixData f <=< encodeM) 61 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Inject.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | module LLVM.General.Internal.Inject where 3 | 4 | import LLVM.General.Prelude 5 | 6 | class Inject a b where 7 | inject :: a -> b 8 | 9 | instance Inject a a where 10 | inject = id 11 | 12 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/InlineAssembly.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.InlineAssembly where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Control.Monad.IO.Class 10 | 11 | import Foreign.C 12 | import Foreign.Ptr 13 | 14 | import qualified LLVM.General.Internal.FFI.InlineAssembly as FFI 15 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 16 | import qualified LLVM.General.Internal.FFI.Module as FFI 17 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 18 | 19 | import qualified LLVM.General.AST as A (Definition(..)) 20 | import qualified LLVM.General.AST.InlineAssembly as A 21 | import qualified LLVM.General.AST.Type as A 22 | 23 | import LLVM.General.Internal.Coding 24 | import LLVM.General.Internal.EncodeAST 25 | import LLVM.General.Internal.DecodeAST 26 | import LLVM.General.Internal.Value 27 | 28 | genCodingInstance [t| A.Dialect |] ''FFI.AsmDialect [ 29 | (FFI.asmDialectATT, A.ATTDialect), 30 | (FFI.asmDialectIntel, A.IntelDialect) 31 | ] 32 | 33 | instance EncodeM EncodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where 34 | encodeM (A.InlineAssembly { 35 | A.type' = t, 36 | A.assembly = assembly, 37 | A.constraints = constraints, 38 | A.hasSideEffects = hasSideEffects, 39 | A.alignStack = alignStack, 40 | A.dialect = dialect 41 | }) = do 42 | t <- encodeM t 43 | assembly <- encodeM assembly 44 | constraints <- encodeM constraints 45 | hasSideEffects <- encodeM hasSideEffects 46 | alignStack <- encodeM alignStack 47 | dialect <- encodeM dialect 48 | liftIO $ FFI.createInlineAsm t assembly constraints hasSideEffects alignStack dialect 49 | 50 | instance DecodeM DecodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where 51 | decodeM p = do 52 | return A.InlineAssembly 53 | `ap` (liftM (\(A.PointerType f _) -> f) (typeOf p)) 54 | `ap` (decodeM =<< liftIO (FFI.getInlineAsmAssemblyString p)) 55 | `ap` (decodeM =<< liftIO (FFI.getInlineAsmConstraintString p)) 56 | `ap` (decodeM =<< liftIO (FFI.inlineAsmHasSideEffects p)) 57 | `ap` (decodeM =<< liftIO (FFI.inlineAsmIsAlignStack p)) 58 | `ap` (decodeM =<< liftIO (FFI.getInlineAsmDialect p)) 59 | 60 | instance DecodeM DecodeAST [A.Definition] (FFI.ModuleAsm CString) where 61 | decodeM (FFI.ModuleAsm s) = do 62 | s <- decodeM s 63 | let takeModIA "" = [] 64 | takeModIA s = 65 | let (a,r) = break (== '\n') s 66 | in A.ModuleInlineAssembly a : takeModIA (dropWhile (== '\n') r) 67 | return $ takeModIA s 68 | 69 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/InstructionDefs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell 3 | #-} 4 | module LLVM.General.Internal.InstructionDefs ( 5 | astInstructionRecs, 6 | astConstantRecs, 7 | instructionDefs, 8 | ID.InstructionKind(..), 9 | ID.InstructionDef(..), 10 | instrP, 11 | innerJoin, 12 | outerJoin 13 | ) where 14 | 15 | import LLVM.General.Prelude 16 | 17 | import qualified Language.Haskell.TH as TH 18 | import qualified Language.Haskell.TH.Quote as TH 19 | 20 | import Data.Map (Map) 21 | import qualified Data.Map as Map 22 | 23 | import qualified LLVM.General.Internal.FFI.InstructionDefs as ID 24 | 25 | import qualified LLVM.General.AST.Instruction as A 26 | import qualified LLVM.General.AST.Constant as A.C 27 | 28 | $(do 29 | let ctorRecs t = do 30 | TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify t 31 | TH.dataToExpQ (const Nothing) $ [ (TH.nameBase n, rec) | rec@(TH.RecC n _) <- cons ] 32 | 33 | [d| 34 | astInstructionRecs = Map.fromList $(ctorRecs ''A.Instruction) 35 | astConstantRecs = Map.fromList $(ctorRecs ''A.C.Constant) 36 | |] 37 | ) 38 | 39 | instructionDefs = Map.fromList [ ((refName . ID.cAPIName $ i), i) | i <- ID.instructionDefs ] 40 | where 41 | refName "AtomicCmpXchg" = "CmpXchg" 42 | refName "PHI" = "Phi" 43 | refName x = x 44 | 45 | innerJoin :: Ord k => Map k a -> Map k b -> Map k (a,b) 46 | innerJoin = Map.intersectionWith (,) 47 | 48 | outerJoin :: Ord k => Map k a -> Map k b -> Map k (Maybe a, Maybe b) 49 | outerJoin xs ys = Map.unionWith combine 50 | (Map.map (\a -> (Just a, Nothing)) xs) 51 | (Map.map (\b -> (Nothing, Just b)) ys) 52 | where 53 | combine (Just a, Nothing) (Nothing, Just b) = (Just a, Just b) 54 | combine _ _ = error "outerJoin: the impossible happened" 55 | 56 | instrP = TH.QuasiQuoter { 57 | TH.quoteExp = undefined, 58 | TH.quotePat = let m = Map.fromList [ (ID.cAPIName i, ID.cppOpcode i) | i <- ID.instructionDefs ] 59 | in TH.dataToPatQ (const Nothing) . (m Map.!), 60 | TH.quoteType = undefined, 61 | TH.quoteDec = undefined 62 | } 63 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/IntegerPredicate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.IntegerPredicate where 6 | 7 | import LLVM.General.Internal.Coding 8 | 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | import qualified LLVM.General.AST.IntegerPredicate as A.IPred 11 | 12 | genCodingInstance [t| A.IPred.IntegerPredicate |] ''FFI.ICmpPredicate [ 13 | (FFI.iCmpPredEQ, A.IPred.EQ), 14 | (FFI.iCmpPredNE, A.IPred.NE), 15 | (FFI.iCmpPredUGT, A.IPred.UGT), 16 | (FFI.iCmpPredUGE, A.IPred.UGE), 17 | (FFI.iCmpPredULT, A.IPred.ULT), 18 | (FFI.iCmpPredULE, A.IPred.ULE), 19 | (FFI.iCmpPredSGT, A.IPred.SGT), 20 | (FFI.iCmpPredSGE, A.IPred.SGE), 21 | (FFI.iCmpPredSLT, A.IPred.SLT), 22 | (FFI.iCmpPredSLE, A.IPred.SLE) 23 | ] 24 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/LibraryFunction.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses 3 | #-} 4 | module LLVM.General.Internal.LibraryFunction where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 9 | 10 | import LLVM.General.Internal.Coding 11 | 12 | #include "LLVM/General/Internal/FFI/LibFunc.h" 13 | 14 | #{ 15 | define hsc_inject(m) { \ 16 | struct { const char *s; unsigned n; } *p, list[] = { LLVM_GENERAL_FOR_EACH_LIB_FUNC(m) }; \ 17 | hsc_printf("data LibraryFunction\n"); \ 18 | for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ 19 | hsc_printf(" %s LF__%s\n", (p == list ? "=" : "|"), p->s); \ 20 | } \ 21 | hsc_printf(" deriving (Eq, Ord, Enum, Bounded, Read, Show)"); \ 22 | hsc_printf("\n"); \ 23 | hsc_printf("instance Monad m => EncodeM m LibraryFunction FFI.LibFunc where\n"); \ 24 | for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ 25 | hsc_printf(" encodeM LF__%s = return (FFI.LibFunc %u)\n", p->s, p->n); \ 26 | } \ 27 | hsc_printf("\n"); \ 28 | hsc_printf("instance Monad m => DecodeM m LibraryFunction FFI.LibFunc where\n"); \ 29 | for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ 30 | hsc_printf(" decodeM (FFI.LibFunc %u) = return LF__%s \n", p->n, p->s); \ 31 | } \ 32 | } 33 | } 34 | 35 | -- | 36 | #define Mac(n) { #n, LLVMLibFunc__ ## n }, 37 | #{inject Mac} 38 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/MemoryBuffer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses, 3 | UndecidableInstances 4 | #-} 5 | module LLVM.General.Internal.MemoryBuffer where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Control.Exception 10 | import Control.Monad.Exceptable 11 | import Control.Monad.AnyCont 12 | import qualified Data.ByteString as BS 13 | import qualified Data.ByteString.Unsafe as BS 14 | import Foreign.Ptr 15 | 16 | import LLVM.General.Internal.Coding 17 | import LLVM.General.Internal.String 18 | import LLVM.General.Internal.Inject 19 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 20 | import qualified LLVM.General.Internal.FFI.MemoryBuffer as FFI 21 | 22 | data Specification 23 | = Bytes { name :: String, content :: BS.ByteString } 24 | | File { pathName :: String } 25 | 26 | instance (Inject String e, MonadError e m, Monad m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer)) where 27 | encodeM spec = liftM FFI.OwnerTransfered $ do 28 | case spec of 29 | Bytes name content -> do 30 | (s,l) <- anyContToM $ BS.unsafeUseAsCStringLen (BS.snoc content 0) 31 | name <- encodeM name 32 | nullTerminate <- encodeM True 33 | liftIO $ FFI.createMemoryBufferWithMemoryRange s (fromIntegral (l-1)) name nullTerminate 34 | File pathName -> do 35 | pathName <- encodeM pathName 36 | mbPtr <- alloca 37 | msgPtr <- alloca 38 | result <- decodeM =<< (liftIO $ FFI.createMemoryBufferWithContentsOfFile pathName mbPtr msgPtr) 39 | when result $ do 40 | msg <- decodeM msgPtr 41 | throwError (inject (msg :: String)) 42 | peek mbPtr 43 | 44 | instance (Inject String e, MonadError e m, Monad m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (Ptr FFI.MemoryBuffer) where 45 | encodeM spec = do 46 | FFI.OwnerTransfered mb <- encodeM spec 47 | anyContToM $ bracket (return mb) FFI.disposeMemoryBuffer 48 | 49 | instance MonadIO d => DecodeM d BS.ByteString (Ptr FFI.MemoryBuffer) where 50 | decodeM p = do 51 | s <- liftIO $ FFI.getBufferStart p 52 | l <- liftIO $ FFI.getBufferSize p 53 | liftIO $ BS.packCStringLen (s, fromIntegral l) 54 | 55 | instance MonadIO d => DecodeM d String (Ptr FFI.MemoryBuffer) where 56 | decodeM = decodeM . UTF8ByteString <=< decodeM 57 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Metadata.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses 3 | #-} 4 | module LLVM.General.Internal.Metadata where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Control.Monad.State hiding (mapM, forM) 9 | import Control.Monad.AnyCont 10 | 11 | import Foreign.Ptr 12 | 13 | import qualified Foreign.Marshal.Array as FMA 14 | import qualified Data.Array as Array 15 | 16 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 17 | import qualified LLVM.General.Internal.FFI.Metadata as FFI 18 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 19 | 20 | import LLVM.General.Internal.Context 21 | import LLVM.General.Internal.Coding 22 | import LLVM.General.Internal.EncodeAST 23 | import LLVM.General.Internal.DecodeAST 24 | import LLVM.General.Internal.Value () 25 | 26 | instance EncodeM EncodeAST String FFI.MDKindID where 27 | encodeM s = do 28 | Context c <- gets encodeStateContext 29 | s <- encodeM s 30 | liftIO $ FFI.getMDKindIDInContext c s 31 | 32 | getMetadataKindNames :: Context -> DecodeAST () 33 | getMetadataKindNames (Context c) = scopeAnyCont $ do 34 | let g n = do 35 | ps <- allocaArray n 36 | ls <- allocaArray n 37 | n' <- liftIO $ FFI.getMDKindNames c ps ls n 38 | if n' > n 39 | then g n' 40 | else do 41 | csls <- return zip 42 | `ap` liftIO (FMA.peekArray (fromIntegral n') ps) 43 | `ap` liftIO (FMA.peekArray (fromIntegral n') ls) 44 | mapM decodeM csls 45 | strs <- g 16 46 | modify $ \s -> s { metadataKinds = Array.listArray (0, fromIntegral (length strs) - 1) strs } 47 | 48 | instance DecodeM DecodeAST String FFI.MDKindID where 49 | decodeM (FFI.MDKindID k) = gets $ (Array.! (fromIntegral k)) . metadataKinds 50 | 51 | instance DecodeM DecodeAST String (Ptr FFI.MDString) where 52 | decodeM p = do 53 | np <- alloca 54 | s <- liftIO $ FFI.getMDString p np 55 | n <- peek np 56 | decodeM (s, n) 57 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Operand.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses 3 | #-} 4 | module LLVM.General.Internal.Operand where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Control.Monad.State 9 | import Control.Monad.AnyCont 10 | import qualified Data.Map as Map 11 | 12 | import Foreign.Ptr 13 | 14 | import qualified LLVM.General.Internal.FFI.Constant as FFI 15 | import qualified LLVM.General.Internal.FFI.InlineAssembly as FFI 16 | import qualified LLVM.General.Internal.FFI.Metadata as FFI 17 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 18 | import qualified LLVM.General.Internal.FFI.Value as FFI 19 | 20 | import LLVM.General.Internal.Coding 21 | import LLVM.General.Internal.Constant () 22 | import LLVM.General.Internal.Context 23 | import LLVM.General.Internal.DecodeAST 24 | import LLVM.General.Internal.EncodeAST 25 | import LLVM.General.Internal.InlineAssembly () 26 | import LLVM.General.Internal.Metadata () 27 | 28 | import qualified LLVM.General.AST as A 29 | 30 | instance DecodeM DecodeAST A.Operand (Ptr FFI.Value) where 31 | decodeM v = do 32 | c <- liftIO $ FFI.isAConstant v 33 | if (c /= nullPtr) 34 | then 35 | return A.ConstantOperand `ap` decodeM c 36 | else 37 | do 38 | mds <- liftIO $ FFI.isAMDString v 39 | if mds /= nullPtr 40 | then return A.MetadataStringOperand `ap` decodeM mds 41 | else 42 | do 43 | mdn <- liftIO $ FFI.isAMDNode v 44 | if mdn /= nullPtr 45 | then return A.MetadataNodeOperand `ap` decodeM mdn 46 | else 47 | return A.LocalReference 48 | `ap` (decodeM =<< (liftIO $ FFI.typeOf v)) 49 | `ap` getLocalName v 50 | 51 | instance DecodeM DecodeAST A.CallableOperand (Ptr FFI.Value) where 52 | decodeM v = do 53 | ia <- liftIO $ FFI.isAInlineAsm v 54 | if ia /= nullPtr 55 | then liftM Left (decodeM ia) 56 | else liftM Right (decodeM v) 57 | 58 | instance EncodeM EncodeAST A.Operand (Ptr FFI.Value) where 59 | encodeM (A.ConstantOperand c) = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) <$> encodeM c 60 | encodeM (A.LocalReference t n) = do 61 | lv <- refer encodeStateLocals n $ do 62 | lv <- do 63 | n <- encodeM n 64 | t <- encodeM t 65 | v <- liftIO $ FFI.createArgument t n 66 | return $ ForwardValue v 67 | modify $ \s -> s { encodeStateLocals = Map.insert n lv $ encodeStateLocals s } 68 | return lv 69 | return $ case lv of DefinedValue v -> v; ForwardValue v -> v 70 | 71 | encodeM (A.MetadataStringOperand s) = do 72 | Context c <- gets encodeStateContext 73 | s <- encodeM s 74 | liftM FFI.upCast $ liftIO $ FFI.mdStringInContext c s 75 | encodeM (A.MetadataNodeOperand mdn) = (FFI.upCast :: Ptr FFI.MDNode -> Ptr FFI.Value) <$> encodeM mdn 76 | 77 | instance EncodeM EncodeAST A.CallableOperand (Ptr FFI.Value) where 78 | encodeM (Right o) = encodeM o 79 | encodeM (Left i) = liftM (FFI.upCast :: Ptr FFI.InlineAsm -> Ptr FFI.Value) (encodeM i) 80 | 81 | instance EncodeM EncodeAST A.MetadataNode (Ptr FFI.MDNode) where 82 | encodeM (A.MetadataNode ops) = scopeAnyCont $ do 83 | Context c <- gets encodeStateContext 84 | ops <- encodeM ops 85 | liftIO $ FFI.createMDNodeInContext c ops 86 | encodeM (A.MetadataNodeReference n) = referMDNode n 87 | 88 | instance DecodeM DecodeAST [Maybe A.Operand] (Ptr FFI.MDNode) where 89 | decodeM p = scopeAnyCont $ do 90 | n <- liftIO $ FFI.getMDNodeNumOperands p 91 | ops <- allocaArray n 92 | liftIO $ FFI.getMDNodeOperands p ops 93 | decodeM (n, ops) 94 | 95 | instance DecodeM DecodeAST A.MetadataNode (Ptr FFI.MDNode) where 96 | decodeM p = scopeAnyCont $ do 97 | fl <- decodeM =<< liftIO (FFI.mdNodeIsFunctionLocal p) 98 | if fl 99 | then 100 | return A.MetadataNode `ap` decodeM p 101 | else 102 | return A.MetadataNodeReference `ap` getMetadataNodeID p 103 | 104 | getMetadataDefinitions :: DecodeAST [A.Definition] 105 | getMetadataDefinitions = fix $ \continue -> do 106 | mdntd <- takeMetadataNodeToDefine 107 | flip (maybe (return [])) mdntd $ \(mid, p) -> do 108 | return (:) 109 | `ap` (return A.MetadataNodeDefinition `ap` return mid `ap` decodeM p) 110 | `ap` continue 111 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/RMWOperation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.RMWOperation where 6 | 7 | import LLVM.General.AST.RMWOperation 8 | 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | 11 | import LLVM.General.Internal.Coding 12 | 13 | genCodingInstance [t| RMWOperation |] ''FFI.RMWOperation [ 14 | (FFI.rmwOperationXchg, Xchg), 15 | (FFI.rmwOperationAdd, Add), 16 | (FFI.rmwOperationSub, Sub), 17 | (FFI.rmwOperationAnd, And), 18 | (FFI.rmwOperationNand, Nand), 19 | (FFI.rmwOperationOr, Or), 20 | (FFI.rmwOperationXor, Xor), 21 | (FFI.rmwOperationMax, Max), 22 | (FFI.rmwOperationMin, Min), 23 | (FFI.rmwOperationUMax, UMax), 24 | (FFI.rmwOperationUMin, UMin) 25 | ] 26 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/RawOStream.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.RawOStream where 2 | 3 | import LLVM.General.Prelude 4 | 5 | import Control.Monad.Exceptable 6 | import Control.Monad.AnyCont 7 | 8 | import Data.IORef 9 | import Foreign.C 10 | import Foreign.Ptr 11 | 12 | import qualified LLVM.General.Internal.FFI.RawOStream as FFI 13 | 14 | import LLVM.General.Internal.Coding 15 | import LLVM.General.Internal.Inject 16 | import LLVM.General.Internal.String () 17 | 18 | withFileRawOStream :: 19 | (Inject String e, MonadError e m, MonadAnyCont IO m, MonadIO m) 20 | => String 21 | -> Bool 22 | -> Bool 23 | -> (Ptr FFI.RawOStream -> ExceptT String IO ()) 24 | -> m () 25 | withFileRawOStream path excl text c = do 26 | path <- encodeM path 27 | excl <- encodeM excl 28 | text <- encodeM text 29 | msgPtr <- alloca 30 | errorRef <- liftIO $ newIORef undefined 31 | succeeded <- decodeM =<< (liftIO $ FFI.withFileRawOStream path excl text msgPtr $ \os -> do 32 | r <- runExceptableT (ExceptableT $ c os) 33 | writeIORef errorRef r) 34 | unless succeeded $ do 35 | s <- decodeM msgPtr 36 | throwError $ inject (s :: String) 37 | e <- liftIO $ readIORef errorRef 38 | either (throwError . inject) return e 39 | 40 | withBufferRawOStream :: 41 | (Inject String e, MonadError e m, MonadIO m, DecodeM IO a (Ptr CChar, CSize)) 42 | => (Ptr FFI.RawOStream -> ExceptT String IO ()) 43 | -> m a 44 | withBufferRawOStream c = do 45 | resultRef <- liftIO $ newIORef Nothing 46 | errorRef <- liftIO $ newIORef undefined 47 | let saveBuffer :: Ptr CChar -> CSize -> IO () 48 | saveBuffer start size = do 49 | r <- decodeM (start, size) 50 | writeIORef resultRef (Just r) 51 | saveError os = do 52 | r <- runExceptableT (ExceptableT $ c os) 53 | writeIORef errorRef r 54 | liftIO $ FFI.withBufferRawOStream saveBuffer saveError 55 | e <- liftIO $ readIORef errorRef 56 | case e of 57 | Left e -> throwError $ inject e 58 | _ -> do 59 | Just r <- liftIO $ readIORef resultRef 60 | return r 61 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/String.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses, 3 | UndecidableInstances 4 | #-} 5 | module LLVM.General.Internal.String where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import Control.Arrow 10 | import Control.Monad.AnyCont 11 | import Control.Monad.IO.Class 12 | import Control.Exception (finally) 13 | import Data.Maybe (fromMaybe) 14 | import Foreign.C (CString, CChar) 15 | import Foreign.Ptr 16 | import Foreign.Storable (Storable) 17 | import Foreign.Marshal.Alloc as F.M (alloca, free) 18 | 19 | import LLVM.General.Internal.FFI.LLVMCTypes 20 | 21 | import LLVM.General.Internal.Coding 22 | 23 | import qualified Data.ByteString as BS 24 | import qualified Data.ByteString.Unsafe as BS 25 | import qualified Data.ByteString.UTF8 as BSUTF8 26 | 27 | newtype UTF8ByteString = UTF8ByteString { utf8Bytes :: BS.ByteString } 28 | 29 | instance (Monad e) => EncodeM e String UTF8ByteString where 30 | encodeM = return . UTF8ByteString . BSUTF8.fromString 31 | 32 | instance (Monad d) => DecodeM d String UTF8ByteString where 33 | decodeM = return . BSUTF8.toString . utf8Bytes 34 | 35 | instance (MonadAnyCont IO e) => EncodeM e String CString where 36 | encodeM s = anyContToM (BS.unsafeUseAsCString . utf8Bytes =<< encodeM (s ++ "\0")) 37 | 38 | instance (Integral i, MonadAnyCont IO e) => EncodeM e String (Ptr CChar, i) where 39 | encodeM s = anyContToM ((. (. second fromIntegral)) $ BS.useAsCStringLen . utf8Bytes =<< encodeM s) 40 | 41 | instance (MonadIO d) => DecodeM d String CString where 42 | decodeM = decodeM . UTF8ByteString <=< liftIO . BS.packCString 43 | 44 | instance (MonadIO d) => DecodeM d String (OwnerTransfered CString) where 45 | decodeM (OwnerTransfered s) = liftIO $ finally (decodeM s) (free s) 46 | 47 | instance (MonadIO d) => DecodeM d String (Ptr (OwnerTransfered CString)) where 48 | decodeM = liftIO . decodeM <=< peek 49 | 50 | instance (Integral i, MonadIO d) => DecodeM d String (Ptr CChar, i) where 51 | decodeM = decodeM . UTF8ByteString <=< liftIO . BS.packCStringLen . second fromIntegral 52 | 53 | instance (Integral i, MonadIO d) => DecodeM d BS.ByteString (Ptr CChar, i) where 54 | decodeM = liftIO . BS.packCStringLen . second fromIntegral 55 | 56 | instance (Integral i, Storable i, MonadIO d) => DecodeM d String (Ptr i -> IO (Ptr CChar)) where 57 | decodeM f = decodeM =<< (liftIO $ F.M.alloca $ \p -> (,) `liftM` f p `ap` peek p) 58 | 59 | instance (Monad e, EncodeM e String c) => EncodeM e (Maybe String) (NothingAsEmptyString c) where 60 | encodeM = liftM NothingAsEmptyString . encodeM . fromMaybe "" 61 | 62 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/TailCallKind.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | TemplateHaskell, 3 | MultiParamTypeClasses 4 | #-} 5 | module LLVM.General.Internal.TailCallKind where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI 10 | 11 | import LLVM.General.Internal.Coding 12 | import qualified LLVM.General.AST as A 13 | 14 | genCodingInstance [t| Maybe A.TailCallKind |] ''FFI.TailCallKind [ 15 | (FFI.tailCallKindNone, Nothing), 16 | (FFI.tailCallKindTail, Just A.Tail), 17 | (FFI.tailCallKindMustTail, Just A.MustTail) 18 | ] 19 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Threading.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Internal.Threading ( 2 | isMultithreaded 3 | ) where 4 | 5 | import LLVM.General.Prelude 6 | 7 | import qualified LLVM.General.Internal.FFI.Threading as FFI 8 | 9 | import LLVM.General.Internal.Coding 10 | 11 | -- | Check if multithreading is enabled in LLVM 12 | isMultithreaded :: IO Bool 13 | isMultithreaded = FFI.isMultithreaded >>= decodeM 14 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Internal/Value.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | MultiParamTypeClasses 3 | #-} 4 | module LLVM.General.Internal.Value where 5 | 6 | import LLVM.General.Prelude 7 | 8 | import Control.Monad.State 9 | 10 | import Foreign.Ptr 11 | 12 | import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI 13 | import qualified LLVM.General.Internal.FFI.Value as FFI 14 | 15 | import LLVM.General.Internal.Coding 16 | import LLVM.General.Internal.DecodeAST 17 | import LLVM.General.Internal.Type () 18 | import LLVM.General.Internal.Constant () 19 | 20 | import qualified LLVM.General.AST.Type as A 21 | 22 | typeOf :: FFI.DescendentOf FFI.Value v => Ptr v -> DecodeAST A.Type 23 | typeOf = decodeM <=< liftIO . FFI.typeOf . FFI.upCast 24 | 25 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Module.hs: -------------------------------------------------------------------------------- 1 | -- | A 'Module' holds a C++ LLVM IR module. 'Module's may be converted to or from strings or Haskell ASTs, or 2 | -- added to an 'LLVM.General.ExecutionEngine.ExecutionEngine' and so JIT compiled to get function pointers. 3 | module LLVM.General.Module ( 4 | Module, 5 | File(..), 6 | 7 | withModuleFromAST, 8 | moduleAST, 9 | 10 | withModuleFromLLVMAssembly, 11 | moduleLLVMAssembly, 12 | writeLLVMAssemblyToFile, 13 | 14 | withModuleFromBitcode, 15 | moduleBitcode, 16 | writeBitcodeToFile, 17 | 18 | moduleTargetAssembly, 19 | writeTargetAssemblyToFile, 20 | 21 | moduleObject, 22 | writeObjectToFile, 23 | 24 | linkModules 25 | ) where 26 | 27 | import LLVM.General.Internal.Module 28 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/PassManager.hs: -------------------------------------------------------------------------------- 1 | -- | A 'PassManager' holds collection of passes, to be run on 'Module's. 2 | -- Build one with 'withPassManager': 3 | -- 4 | -- * using 'CuratedPassSetSpec' if you want optimization but not to play with your compiler 5 | -- 6 | -- * using 'PassSetSpec' if you do want to play with your compiler 7 | module LLVM.General.PassManager ( 8 | PassManager, 9 | PassSetSpec(..), defaultPassSetSpec, defaultCuratedPassSetSpec, 10 | withPassManager, 11 | runPassManager 12 | ) where 13 | 14 | import LLVM.General.Internal.PassManager 15 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Relocation.hs: -------------------------------------------------------------------------------- 1 | -- | Relocations, used in specifying TargetMachine 2 | module LLVM.General.Relocation where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data Model 8 | = Default 9 | | Static 10 | | PIC 11 | | DynamicNoPIC 12 | deriving (Eq, Read, Show, Typeable, Data) 13 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Target.hs: -------------------------------------------------------------------------------- 1 | -- | A 'Target' describes that for which code may be intended. Targets are used both during actual 2 | -- | lowering of LLVM IR to machine code and by some optimization passes which use the target to 3 | -- | judge costs. 4 | module LLVM.General.Target ( 5 | lookupTarget, 6 | TargetOptions, 7 | Target, TargetMachine, TargetLowering, 8 | CPUFeature(..), 9 | withTargetOptions, peekTargetOptions, pokeTargetOptions, 10 | withTargetMachine, withHostTargetMachine, 11 | getTargetLowering, 12 | getDefaultTargetTriple, getProcessTargetTriple, getHostCPUName, getHostCPUFeatures, 13 | getTargetMachineDataLayout, initializeNativeTarget, initializeAllTargets, 14 | TargetLibraryInfo, 15 | getLibraryFunction, 16 | getLibraryFunctionName, 17 | setLibraryFunctionAvailableWithName, 18 | withTargetLibraryInfo 19 | ) where 20 | 21 | import LLVM.General.Internal.Target 22 | 23 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Target/LibraryFunction.hs: -------------------------------------------------------------------------------- 1 | -- | A 'LibraryFunction' identifies a function of which LLVM has particular knowledge. 2 | module LLVM.General.Target.LibraryFunction ( 3 | LibraryFunction(..) 4 | ) where 5 | 6 | 7 | import LLVM.General.Internal.LibraryFunction 8 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Target/Options.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | module LLVM.General.Target.Options where 3 | 4 | import LLVM.General.Prelude 5 | 6 | -- | 7 | data FloatABI 8 | = FloatABIDefault 9 | | FloatABISoft 10 | | FloatABIHard 11 | deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data) 12 | 13 | -- | 14 | data FloatingPointOperationFusionMode 15 | = FloatingPointOperationFusionFast 16 | | FloatingPointOperationFusionStandard 17 | | FloatingPointOperationFusionStrict 18 | deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data) 19 | 20 | -- | The options of a 'LLVM.General.Target.TargetOptions' 21 | -- 22 | data Options = Options { 23 | printMachineCode :: Bool, 24 | noFramePointerElimination :: Bool, 25 | lessPreciseFloatingPointMultiplyAddOption :: Bool, 26 | unsafeFloatingPointMath :: Bool, 27 | noInfinitiesFloatingPointMath :: Bool, 28 | noNaNsFloatingPointMath :: Bool, 29 | honorSignDependentRoundingFloatingPointMathOption :: Bool, 30 | useSoftFloat :: Bool, 31 | noZerosInBSS :: Bool, 32 | jITEmitDebugInfo :: Bool, 33 | jITEmitDebugInfoToDisk :: Bool, 34 | guaranteedTailCallOptimization :: Bool, 35 | disableTailCalls :: Bool, 36 | enableFastInstructionSelection :: Bool, 37 | positionIndependentExecutable :: Bool, 38 | useInitArray :: Bool, 39 | disableIntegratedAssembler :: Bool, 40 | compressDebugSections :: Bool, 41 | trapUnreachable :: Bool, 42 | stackAlignmentOverride :: Word32, 43 | trapFunctionName :: String, 44 | floatABIType :: FloatABI, 45 | allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode 46 | } 47 | deriving (Eq, Ord, Read, Show) 48 | 49 | -------------------------------------------------------------------------------- /llvm-general/src/LLVM/General/Threading.hs: -------------------------------------------------------------------------------- 1 | -- | functionality necessary when running LLVM in multiple threads at the same time. 2 | module LLVM.General.Threading ( 3 | setMultithreaded, 4 | isMultithreaded 5 | ) where 6 | 7 | import LLVM.General.Prelude 8 | 9 | import LLVM.General.Internal.Threading 10 | 11 | {-# DEPRECATED setMultithreaded "LLVM no longer features runtime control of multithreading support" #-} 12 | -- | This function used set the multithreading mode of LLVM, but that feature no longer exists. Threading is 13 | -- controlled only at runtime with the configure flag --enable-threads (default is YES). This function will 14 | -- now check that the the compiled-in multithreading support (returned by 'isMultithreaded') is 15 | -- sufficient to support the requested access, and fail if not, so as to prevent uncontrolled use of a 16 | -- version of LLVM compiled to be capable only of singled threaded use by haskell code requesting 17 | -- multithreading support. 18 | setMultithreaded :: Bool -> IO () 19 | setMultithreaded desired = do 20 | actual <- isMultithreaded 21 | when (desired && not actual) $ 22 | fail $ "Multithreading support requested but not available. " ++ 23 | "Please use an LLVM built with threading enabled" 24 | return () 25 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Analysis.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Analysis where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import Control.Monad.Trans.Except 10 | 11 | import LLVM.General.Module 12 | import LLVM.General.Context 13 | import LLVM.General.Analysis 14 | 15 | import LLVM.General.AST as A 16 | import LLVM.General.AST.Type as A.T 17 | import LLVM.General.AST.Name 18 | import LLVM.General.AST.AddrSpace 19 | import LLVM.General.AST.DataLayout 20 | import qualified LLVM.General.AST.IntegerPredicate as IPred 21 | import qualified LLVM.General.AST.Linkage as L 22 | import qualified LLVM.General.AST.Visibility as V 23 | import qualified LLVM.General.AST.CallingConvention as CC 24 | import qualified LLVM.General.AST.Attribute as A 25 | import qualified LLVM.General.AST.Global as G 26 | import qualified LLVM.General.AST.Constant as C 27 | 28 | import qualified LLVM.General.Relocation as R 29 | import qualified LLVM.General.CodeModel as CM 30 | import qualified LLVM.General.CodeGenOpt as CGO 31 | 32 | tests = testGroup "Analysis" [ 33 | testGroup "Verifier" [ 34 | {- 35 | -- this test will cause an assertion if LLVM is compiled with assertions on. 36 | testCase "Module" $ do 37 | let ast = Module "" Nothing Nothing [ 38 | GlobalDefinition $ Function L.External V.Default CC.C [] A.T.void (Name "foo") ([ 39 | Parameter i32 (Name "x") [] 40 | ],False) 41 | [] 42 | Nothing 0 Nothing 43 | [ 44 | BasicBlock (UnName 0) [ 45 | UnName 1 := Call { 46 | isTailCall = False, 47 | callingConvention = CC.C, 48 | returnAttributes = [], 49 | function = Right (ConstantOperand (C.GlobalReference (A.T.FunctionType A.T.void [A.T.i32] False) (Name "foo"))), 50 | arguments = [ 51 | (ConstantOperand (C.Int 8 1), []) 52 | ], 53 | functionAttributes = [], 54 | metadata = [] 55 | } 56 | ] ( 57 | Do $ Ret Nothing [] 58 | ) 59 | ] 60 | ] 61 | Left s <- withContext $ \context -> withModuleFromAST' context ast $ runExceptT . verify 62 | s @?= "Call parameter type does not match function signature!\n\ 63 | \i8 1\n\ 64 | \ i32 call void @foo(i8 1)\n\ 65 | \Broken module found, compilation terminated.\n\ 66 | \Broken module found, compilation terminated.\n", 67 | -} 68 | 69 | testGroup "regression" [ 70 | testCase "load synchronization" $ do 71 | let str = "; ModuleID = ''\n\ 72 | \\n\ 73 | \define double @my_function2(double* %input_0) {\n\ 74 | \foo:\n\ 75 | \ %tmp_input_w0 = getelementptr inbounds double* %input_0, i64 0\n\ 76 | \ %0 = load double* %tmp_input_w0, align 8\n\ 77 | \ ret double %0\n\ 78 | \}\n" 79 | ast = 80 | Module "" Nothing Nothing [ 81 | GlobalDefinition $ functionDefaults { 82 | G.returnType = double, 83 | G.name = Name "my_function2", 84 | G.parameters = ([ 85 | Parameter (ptr double) (Name "input_0") [] 86 | ],False), 87 | G.basicBlocks = [ 88 | BasicBlock (Name "foo") [ 89 | Name "tmp_input_w0" := GetElementPtr { 90 | inBounds = True, 91 | address = LocalReference (ptr double) (Name "input_0"), 92 | indices = [ConstantOperand (C.Int 64 0)], 93 | metadata = [] 94 | }, 95 | UnName 0 := Load { 96 | volatile = False, 97 | address = LocalReference (ptr double) (Name "tmp_input_w0"), 98 | maybeAtomicity = Nothing, 99 | alignment = 8, 100 | metadata = [] 101 | } 102 | ] ( 103 | Do $ Ret (Just (LocalReference double (UnName 0))) [] 104 | ) 105 | ] 106 | } 107 | ] 108 | strCheck ast str 109 | s <- withContext $ \context -> withModuleFromAST' context ast $ runExceptT . verify 110 | s @?= Right () 111 | ] 112 | ] 113 | ] 114 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/CallingConvention.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.CallingConvention where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import Data.Maybe 10 | import qualified Data.Set as Set 11 | import qualified Data.Map as Map 12 | 13 | import LLVM.General.Context 14 | import LLVM.General.Module 15 | import LLVM.General.AST 16 | import LLVM.General.AST.Type as T 17 | import qualified LLVM.General.AST.CallingConvention as CC 18 | import qualified LLVM.General.AST.Global as G 19 | 20 | tests = testGroup "CallingConvention" [ 21 | testCase name $ strCheck (defaultModule { 22 | moduleDefinitions = [ 23 | GlobalDefinition $ functionDefaults { 24 | G.returnType = i32, 25 | G.name = Name "foo", 26 | G.callingConvention = cc 27 | } 28 | ] 29 | }) ("; ModuleID = ''\n\ 30 | \\n\ 31 | \declare" ++ (if name == "" then "" else (" " ++ name)) ++ " i32 @foo()\n") 32 | | (name, cc) <- [ 33 | ("", CC.C), 34 | ("fastcc", CC.Fast), 35 | ("coldcc", CC.Cold), 36 | ("cc10", CC.GHC), 37 | ("cc11", CC.HiPE), 38 | ("webkit_jscc", CC.WebKit_JS), 39 | ("anyregcc", CC.AnyReg), 40 | ("preserve_mostcc", CC.PreserveMost), 41 | ("preserve_allcc", CC.PreserveAll), 42 | ("x86_stdcallcc", CC.X86_StdCall), 43 | ("x86_fastcallcc", CC.X86_FastCall), 44 | ("arm_apcscc", CC.ARM_APCS), 45 | ("arm_aapcscc", CC.ARM_AAPCS), 46 | ("arm_aapcs_vfpcc", CC.ARM_AAPCS_VFP), 47 | ("msp430_intrcc", CC.MSP430_INTR), 48 | ("x86_thiscallcc", CC.X86_ThisCall), 49 | ("ptx_kernel", CC.PTX_Kernel), 50 | ("ptx_device", CC.PTX_Device), 51 | ("spir_func", CC.SPIR_FUNC), 52 | ("spir_kernel", CC.SPIR_KERNEL), 53 | ("intel_ocl_bicc", CC.Intel_OCL_BI), 54 | ("x86_64_sysvcc", CC.X86_64_SysV), 55 | ("x86_64_win64cc", CC.X86_64_Win64) 56 | ] 57 | ] 58 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/DataLayout.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.DataLayout where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import Data.Maybe 10 | import qualified Data.Set as Set 11 | import qualified Data.Map as Map 12 | 13 | import LLVM.General.Context 14 | import LLVM.General.Module 15 | import LLVM.General.AST 16 | import LLVM.General.AST.DataLayout 17 | import LLVM.General.AST.AddrSpace 18 | import qualified LLVM.General.AST.Global as G 19 | 20 | m s = "; ModuleID = ''\n" ++ s 21 | t s = "target datalayout = \"" ++ s ++ "\"\n" 22 | ddl = defaultDataLayout BigEndian 23 | 24 | tests = testGroup "DataLayout" [ 25 | testCase name $ strCheckC (Module "" mdl Nothing []) (m sdl) (m sdlc) 26 | | (name, mdl, sdl, sdlc) <- [ 27 | ("none", Nothing, "", "") 28 | ] ++ [ 29 | (name, Just mdl, t sdl, t (fromMaybe sdl msdlc)) 30 | | (name, mdl, sdl, msdlc) <- [ 31 | ("little-endian", defaultDataLayout LittleEndian, "e", Nothing), 32 | ("big-endian", defaultDataLayout BigEndian, "E", Nothing), 33 | ("native", ddl { nativeSizes = Just (Set.fromList [8,32]) }, "E-n8:32", Nothing), 34 | ( 35 | "no pref", 36 | ddl { 37 | pointerLayouts = 38 | Map.singleton 39 | (AddrSpace 0) 40 | ( 41 | 8, 42 | AlignmentInfo { 43 | abiAlignment = 64, 44 | preferredAlignment = Nothing 45 | } 46 | ) 47 | }, 48 | "E-p:8:64", 49 | Nothing 50 | ), ( 51 | "no pref", 52 | ddl { 53 | pointerLayouts = 54 | Map.insert (AddrSpace 1) (8, AlignmentInfo 32 (Just 64)) (pointerLayouts ddl) 55 | }, 56 | "E-p1:8:32:64", 57 | Nothing 58 | ), ( 59 | "big", 60 | ddl { 61 | endianness = LittleEndian, 62 | mangling = Just ELFMangling, 63 | stackAlignment = Just 128, 64 | pointerLayouts = Map.fromList [ 65 | (AddrSpace 0, (8, AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 16})) 66 | ], 67 | typeLayouts = Map.fromList [ 68 | ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}), 69 | ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}), 70 | ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 256}), 71 | ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}), 72 | ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 73 | ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 74 | ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256}), 75 | ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}), 76 | ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}), 77 | ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256}) 78 | ] `Map.union` typeLayouts ddl, 79 | aggregateLayout = AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 256}, 80 | nativeSizes = Just (Set.fromList [8,16,32,64]) 81 | }, 82 | "e-m:e-p:8:8:16-i1:8:256-i8:8:256-i16:16:256-i32:32:256-i64:64:256-f32:32:256-f64:64:256-v64:64:256-v128:128:256-a:0:256-f80:128:256-n8:16:32:64-S128", 83 | Just "e-m:e-p:8:8:16-i1:8:256-i8:8:256-i16:16:256-i32:32:256-i64:64:256-f32:32:256-f64:64:256-v64:64:256-v128:128:256-a:0:256-f80:128:256-n8:16:32:64-S128" 84 | ) 85 | ] 86 | ] 87 | ] 88 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/ExecutionEngine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | ForeignFunctionInterface 3 | #-} 4 | module LLVM.General.Test.ExecutionEngine where 5 | 6 | import Test.Framework 7 | import Test.Framework.Providers.HUnit 8 | import Test.HUnit 9 | 10 | import LLVM.General.Test.Support 11 | 12 | import Control.Monad 13 | import Data.Functor 14 | import Data.Maybe 15 | 16 | import Foreign.Ptr 17 | import Data.Word 18 | 19 | import LLVM.General.Context 20 | import LLVM.General.Module 21 | import LLVM.General.ExecutionEngine 22 | import LLVM.General.AST 23 | import LLVM.General.AST.Type 24 | import LLVM.General.AST.Name 25 | import LLVM.General.AST.AddrSpace 26 | import qualified LLVM.General.AST.IntegerPredicate as IPred 27 | 28 | import qualified LLVM.General.AST.Linkage as L 29 | import qualified LLVM.General.AST.Visibility as V 30 | import qualified LLVM.General.AST.CallingConvention as CC 31 | import qualified LLVM.General.AST.Attribute as A 32 | import qualified LLVM.General.AST.Global as G 33 | import qualified LLVM.General.AST.Constant as C 34 | 35 | foreign import ccall "dynamic" mkIO32Stub :: FunPtr (Word32 -> IO Word32) -> (Word32 -> IO Word32) 36 | 37 | testJIT :: ExecutionEngine e (FunPtr ()) => (Context -> (e -> IO ()) -> IO ()) -> Assertion 38 | testJIT withEE = withContext $ \context -> withEE context $ \executionEngine -> do 39 | let mAST = Module "runSomethingModule" Nothing Nothing [ 40 | GlobalDefinition $ functionDefaults { 41 | G.returnType = i32, 42 | G.name = Name "_foo", 43 | G.parameters = ([Parameter i32 (Name "bar") []],False), 44 | G.basicBlocks = [ 45 | BasicBlock (UnName 0) [] ( 46 | Do $ Ret (Just (ConstantOperand (C.Int 32 42))) [] 47 | ) 48 | ] 49 | } 50 | ] 51 | 52 | s <- withModuleFromAST' context mAST $ \m -> do 53 | withModuleInEngine executionEngine m $ \em -> do 54 | Just p <- getFunction em (Name "_foo") 55 | (mkIO32Stub ((castFunPtr p) :: FunPtr (Word32 -> IO Word32))) 7 56 | s @?= 42 57 | 58 | tests = testGroup "ExecutionEngine" [ 59 | testCase "run something with JIT" $ testJIT (\c -> withJIT c 2), 60 | testCase "run something with MCJIT" $ testJIT (\c -> withMCJIT c Nothing Nothing Nothing Nothing) 61 | ] 62 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Global.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Global where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import LLVM.General.Context 10 | import LLVM.General.Module 11 | import LLVM.General.AST 12 | import LLVM.General.AST.Type as A.T 13 | import qualified LLVM.General.AST.Global as G 14 | 15 | tests = testGroup "Global" [ 16 | testGroup "Alignment" [ 17 | testCase name $ withContext $ \context -> do 18 | let ast = Module "" Nothing Nothing [ GlobalDefinition g ] 19 | ast' <- withModuleFromAST' context ast moduleAST 20 | ast' @?= ast 21 | | a <- [0,1], 22 | s <- [Nothing, Just "foo"], 23 | g <- [ 24 | globalVariableDefaults { 25 | G.name = UnName 0, 26 | G.type' = i32, 27 | G.alignment = a, 28 | G.section = s 29 | }, 30 | functionDefaults { 31 | G.returnType = A.T.void, 32 | G.name = UnName 0, 33 | G.parameters = ([], False), 34 | G.alignment = a, 35 | G.section = s 36 | } 37 | ], 38 | let 39 | gn (G.Function {}) = "function" 40 | gn (G.GlobalVariable {}) = "variable" 41 | name = gn g ++ ", align " ++ show a ++ (maybe "" (" section " ++ ) s) 42 | ] 43 | ] 44 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/InlineAssembly.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.InlineAssembly where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import LLVM.General.Context 10 | import LLVM.General.Module 11 | 12 | import LLVM.General.AST 13 | import LLVM.General.AST.Type 14 | import LLVM.General.AST.InlineAssembly as IA 15 | import qualified LLVM.General.AST.Linkage as L 16 | import qualified LLVM.General.AST.Visibility as V 17 | import qualified LLVM.General.AST.CallingConvention as CC 18 | import qualified LLVM.General.AST.Constant as C 19 | import qualified LLVM.General.AST.Global as G 20 | 21 | tests = testGroup "InlineAssembly" [ 22 | testCase "expression" $ do 23 | let ast = Module "" Nothing Nothing [ 24 | GlobalDefinition $ 25 | functionDefaults { 26 | G.returnType = i32, 27 | G.name = Name "foo", 28 | G.parameters = ([Parameter i32 (Name "x") []],False), 29 | G.basicBlocks = [ 30 | BasicBlock (UnName 0) [ 31 | UnName 1 := Call { 32 | tailCallKind = Nothing, 33 | callingConvention = CC.C, 34 | returnAttributes = [], 35 | function = Left $ InlineAssembly { 36 | IA.type' = FunctionType i32 [i32] False, 37 | assembly = "bswap $0", 38 | constraints = "=r,r", 39 | hasSideEffects = False, 40 | alignStack = False, 41 | dialect = ATTDialect 42 | }, 43 | arguments = [ 44 | (LocalReference i32 (Name "x"), []) 45 | ], 46 | functionAttributes = [], 47 | metadata = [] 48 | } 49 | ] ( 50 | Do $ Ret (Just (LocalReference i32 (UnName 1))) [] 51 | ) 52 | ] 53 | } 54 | 55 | ] 56 | s = "; ModuleID = ''\n\ 57 | \\n\ 58 | \define i32 @foo(i32 %x) {\n\ 59 | \ %1 = call i32 asm \"bswap $0\", \"=r,r\"(i32 %x)\n\ 60 | \ ret i32 %1\n\ 61 | \}\n" 62 | strCheck ast s, 63 | 64 | testCase "module" $ do 65 | let ast = Module "" Nothing Nothing [ 66 | ModuleInlineAssembly "foo", 67 | ModuleInlineAssembly "bar", 68 | GlobalDefinition $ globalVariableDefaults { 69 | G.name = UnName 0, 70 | G.type' = i32 71 | } 72 | ] 73 | s = "; ModuleID = ''\n\ 74 | \\n\ 75 | \module asm \"foo\"\n\ 76 | \module asm \"bar\"\n\ 77 | \\n\ 78 | \@0 = external global i32\n" 79 | strCheck ast s 80 | ] 81 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Linking.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Linking where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import LLVM.General.Test.Support 8 | 9 | import Control.Monad.Trans.Except 10 | import Data.Functor 11 | import qualified Data.Set as Set 12 | import qualified Data.Map as Map 13 | 14 | import LLVM.General.Module 15 | import LLVM.General.Context 16 | import LLVM.General.PassManager 17 | import LLVM.General.Transforms 18 | import LLVM.General.Target 19 | 20 | import LLVM.General.AST as A 21 | import LLVM.General.AST.Type 22 | import LLVM.General.AST.Name 23 | import LLVM.General.AST.AddrSpace 24 | import LLVM.General.AST.DataLayout 25 | import qualified LLVM.General.AST.IntegerPredicate as IPred 26 | import qualified LLVM.General.AST.Linkage as L 27 | import qualified LLVM.General.AST.Visibility as V 28 | import qualified LLVM.General.AST.CallingConvention as CC 29 | import qualified LLVM.General.AST.Attribute as A 30 | import qualified LLVM.General.AST.Global as G 31 | import qualified LLVM.General.AST.Constant as C 32 | 33 | tests = testGroup "Linking" [ 34 | testCase "basic" $ do 35 | let 36 | ast0 = Module "" Nothing Nothing [ 37 | GlobalDefinition $ functionDefaults { 38 | G.linkage = L.Private, 39 | G.returnType = i32, 40 | G.name = Name "private0" 41 | }, 42 | GlobalDefinition $ functionDefaults { 43 | G.linkage = L.External, 44 | G.returnType = i32, 45 | G.name = Name "external0" 46 | } 47 | ] 48 | ast1 = Module "" Nothing Nothing [ 49 | GlobalDefinition $ functionDefaults { 50 | G.linkage = L.Private, 51 | G.returnType = i32, 52 | G.name = Name "private1" 53 | }, 54 | GlobalDefinition $ functionDefaults { 55 | G.linkage = L.External, 56 | G.returnType = i32, 57 | G.name = Name "external1" 58 | } 59 | ] 60 | 61 | Module { moduleDefinitions = defs } <- withContext $ \context -> 62 | withModuleFromAST' context ast0 $ \m0 -> 63 | withModuleFromAST' context ast1 $ \m1 -> do 64 | runExceptT $ linkModules False m0 m1 65 | moduleAST m0 66 | [ n | GlobalDefinition g <- defs, let Name n = G.name g ] @?= [ "private0", "external0", "external1" ] 67 | ] 68 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Support.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Support where 2 | 3 | import Test.Framework 4 | import Test.Framework.Providers.HUnit 5 | import Test.HUnit 6 | 7 | import Data.Functor 8 | import Control.Monad 9 | import Control.Monad.Trans.Except 10 | 11 | import LLVM.General.Context 12 | import LLVM.General.Module 13 | import LLVM.General.Diagnostic 14 | import LLVM.General.PrettyPrint 15 | 16 | class FailInIO f where 17 | errorToString :: f -> String 18 | 19 | failInIO :: FailInIO f => ExceptT f IO a -> IO a 20 | failInIO = either (fail . errorToString) return <=< runExceptT 21 | 22 | instance FailInIO String where 23 | errorToString = id 24 | 25 | instance FailInIO (Either String Diagnostic) where 26 | errorToString = either id diagnosticDisplay 27 | 28 | withModuleFromLLVMAssembly' c s f = failInIO $ withModuleFromLLVMAssembly c s f 29 | withModuleFromAST' c a f = failInIO $ withModuleFromAST c a f 30 | withModuleFromBitcode' c a f = failInIO $ withModuleFromBitcode c ("", a) f 31 | 32 | assertEqPretty :: (Eq a, PrettyShow a) => a -> a -> Assertion 33 | assertEqPretty actual expected = do 34 | let showPretty = showPrettyEx 80 " " shortPrefixScheme 35 | assertBool 36 | ("expected: " ++ showPretty expected ++ "\n" ++ "but got: " ++ showPretty actual ++ "\n") 37 | (expected == actual) 38 | 39 | strCheckC mAST mStr mStrCanon = withContext $ \context -> do 40 | a <- withModuleFromLLVMAssembly' context mStr moduleAST 41 | s <- withModuleFromAST' context mAST moduleLLVMAssembly 42 | (a,s) `assertEqPretty` (mAST, mStrCanon) 43 | 44 | strCheck mAST mStr = strCheckC mAST mStr mStr 45 | 46 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Target.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | RecordWildCards 3 | #-} 4 | module LLVM.General.Test.Target where 5 | 6 | import Test.Framework 7 | import Test.Framework.Providers.HUnit 8 | import Test.HUnit 9 | import Test.Framework.Providers.QuickCheck2 10 | import Test.QuickCheck 11 | import Test.QuickCheck.Property 12 | 13 | import Control.Monad 14 | 15 | import LLVM.General.Target 16 | import LLVM.General.Target.Options 17 | import LLVM.General.Target.LibraryFunction 18 | 19 | instance Arbitrary FloatABI where 20 | arbitrary = elements [minBound .. maxBound] 21 | 22 | instance Arbitrary FloatingPointOperationFusionMode where 23 | arbitrary = elements [minBound .. maxBound] 24 | 25 | instance Arbitrary Options where 26 | arbitrary = do 27 | printMachineCode <- arbitrary 28 | noFramePointerElimination <- arbitrary 29 | lessPreciseFloatingPointMultiplyAddOption <- arbitrary 30 | unsafeFloatingPointMath <- arbitrary 31 | noInfinitiesFloatingPointMath <- arbitrary 32 | noNaNsFloatingPointMath <- arbitrary 33 | honorSignDependentRoundingFloatingPointMathOption <- arbitrary 34 | useSoftFloat <- arbitrary 35 | noZerosInBSS <- arbitrary 36 | jITEmitDebugInfo <- arbitrary 37 | jITEmitDebugInfoToDisk <- arbitrary 38 | guaranteedTailCallOptimization <- arbitrary 39 | disableTailCalls <- arbitrary 40 | enableFastInstructionSelection <- arbitrary 41 | positionIndependentExecutable <- arbitrary 42 | useInitArray <- arbitrary 43 | disableIntegratedAssembler <- arbitrary 44 | compressDebugSections <- arbitrary 45 | trapUnreachable <- arbitrary 46 | stackAlignmentOverride <- arbitrary 47 | trapFunctionName <- elements [ "foo", "bar", "baz" ] 48 | floatABIType <- arbitrary 49 | allowFloatingPointOperationFusion <- arbitrary 50 | return Options { .. } 51 | 52 | tests = testGroup "Target" [ 53 | testGroup "Options" [ 54 | testProperty "basic" $ \options -> ioProperty $ do 55 | withTargetOptions $ \to -> do 56 | pokeTargetOptions options to 57 | options' <- peekTargetOptions to 58 | return $ options == options' 59 | ], 60 | testGroup "LibraryFunction" [ 61 | testGroup "set-get" [ 62 | testCase (show lf) $ do 63 | triple <- getDefaultTargetTriple 64 | withTargetLibraryInfo triple $ \tli -> do 65 | setLibraryFunctionAvailableWithName tli lf "foo" 66 | nm <- getLibraryFunctionName tli lf 67 | nm @?= "foo" 68 | | lf <- [minBound, maxBound] 69 | ], 70 | testCase "get" $ do 71 | triple <- getDefaultTargetTriple 72 | withTargetLibraryInfo triple $ \tli -> do 73 | lf <- getLibraryFunction tli "printf" 74 | lf @?= Just LF__printf 75 | ], 76 | testCase "Host" $ do 77 | features <- getHostCPUFeatures 78 | return () 79 | ] 80 | -------------------------------------------------------------------------------- /llvm-general/test/LLVM/General/Test/Tests.hs: -------------------------------------------------------------------------------- 1 | module LLVM.General.Test.Tests where 2 | 3 | import Test.Framework 4 | 5 | import qualified LLVM.General.Test.CallingConvention as CallingConvention 6 | import qualified LLVM.General.Test.Constants as Constants 7 | import qualified LLVM.General.Test.DataLayout as DataLayout 8 | import qualified LLVM.General.Test.ExecutionEngine as ExecutionEngine 9 | import qualified LLVM.General.Test.Global as Global 10 | import qualified LLVM.General.Test.InlineAssembly as InlineAssembly 11 | import qualified LLVM.General.Test.Instructions as Instructions 12 | import qualified LLVM.General.Test.Metadata as Metadata 13 | import qualified LLVM.General.Test.Module as Module 14 | import qualified LLVM.General.Test.Optimization as Optimization 15 | import qualified LLVM.General.Test.Target as Target 16 | import qualified LLVM.General.Test.Analysis as Analysis 17 | import qualified LLVM.General.Test.Linking as Linking 18 | import qualified LLVM.General.Test.Instrumentation as Instrumentation 19 | 20 | tests = testGroup "llvm-general" [ 21 | CallingConvention.tests, 22 | Constants.tests, 23 | DataLayout.tests, 24 | ExecutionEngine.tests, 25 | Global.tests, 26 | InlineAssembly.tests, 27 | Instructions.tests, 28 | Metadata.tests, 29 | Module.tests, 30 | Optimization.tests, 31 | Target.tests, 32 | Analysis.tests, 33 | Linking.tests, 34 | Instrumentation.tests 35 | ] 36 | -------------------------------------------------------------------------------- /llvm-general/test/Test.hs: -------------------------------------------------------------------------------- 1 | import Test.Framework 2 | import qualified LLVM.General.Test.Tests as LLVM.General 3 | import LLVM.General.CommandLine 4 | 5 | main = do 6 | parseCommandLineOptions [ 7 | "test", 8 | "-bb-vectorize-ignore-target-info" 9 | ] Nothing 10 | defaultMain [ 11 | LLVM.General.tests 12 | ] 13 | --------------------------------------------------------------------------------