packages feed

libnvvm (empty) → 1.0.0

raw patch · 10 files changed

+967/−0 lines, 10 filesdep +Cabaldep +HUnitdep +basesetup-changed

Dependencies added: Cabal, HUnit, base, bytestring, cuda, libnvvm, test-framework, test-framework-hunit

Files

+ Foreign/LibNVVM.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+-- |+-- Module      : Foreign.LibNVVM.Compile+-- Copyright   : NVIDIA Corporation+-- License     : MIT+--+-- Maintainer  : Sean Lee <selee@nvidia.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--+module Foreign.LibNVVM (+  module Foreign.LibNVVM.Compile,+  module Foreign.LibNVVM.Error,+  module Foreign.LibNVVM.Info,+) where++import Foreign.LibNVVM.Compile+import Foreign.LibNVVM.Error+import Foreign.LibNVVM.Info
+ Foreign/LibNVVM/Compile.chs view
@@ -0,0 +1,320 @@+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ScopedTypeVariables      #-}+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+-- |+-- Module      : Foreign.LibNVVM.Compile+-- Copyright   : NVIDIA Corporation+-- License     : MIT+--+-- Maintainer  : Sean Lee <selee@nvidia.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--+module Foreign.LibNVVM.Compile (++  -- * Compilation result+  Result(..), CompileFlag(..), VerifyFlag,++  -- * Compilation+  compileModule, compileModules,++) where++import Prelude                                          hiding ( log )+import Data.ByteString                                  ( ByteString )+import Data.Word+import Control.Exception+import Control.Monad+import Text.Printf+import qualified Data.ByteString.Char8                  as B+import qualified Data.ByteString.Unsafe                 as B+import qualified Data.ByteString.Internal               as B++import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal+import Foreign.Storable+import Foreign.CUDA.Analysis+import Foreign.LibNVVM.Error+import Foreign.LibNVVM.Internal++#include "cbits/stubs.h"+{# context lib="nvvm" #}+++-- | The return type of compiling a module(s) is the compilation log together+-- with the resulting binary ptx/cubin.+--+data Result = Result {+    -- | Any compilation or verification messages and warnings that were+    -- generated during compilation of the NVVM module. Note that even upon+    -- successful completion, the log may not be empty.+    --+    nvvmLog       :: {-# UNPACK #-} !ByteString+  , nvvmResult    :: {-# UNPACK #-} !ByteString+  }+++-- | An opaque handle to an NVVM program+--+newtype Program = Program { useProgram :: {# type nvvmProgram #}}+  deriving (Eq, Show)+++-- | The available program compilation flags+--+data CompileFlag+    -- | Level of optimisation to apply (0-3) (Default: 3)+  = OptimisationLevel !Int++    -- | Compute architecture to target (Default: Compute 2.0)+  | Target !Compute++    -- | Flush denormal values to zero when performing single-precision floating+    -- point operations (Default: preserve denormal values)+  | FlushToZero++    -- | Use a faster approximation for single-precision floating-point square+    -- root (Default: use IEEE round-to-nearest mode)+  | FastSqrt++    -- | Use a faster approximation for single-precision floating-point division+    -- and reciprocal operations (Default: use IEEE round-to-nearest mode)+  | FastDiv++    -- | Disable fused-multiply-add contraction (Default: enabled)+  | DisableFMA++    -- | Generate debugging symbols (-g) (Default: no)+  | GenerateDebugInfo+++-- | The available program verification flags+--+data VerifyFlag+++compileFlagToArg :: CompileFlag -> String+compileFlagToArg f =+  case f of+    OptimisationLevel o  -> printf "-opt=%d" o+    Target (Compute n m) -> printf "-arch=compute_%d%d" n m+    FlushToZero          -> "-ftz=1"+    FastSqrt             -> "-prec-sqrt=0"+    FastDiv              -> "-prec-div=0"+    DisableFMA           -> "-fma=0"+    GenerateDebugInfo    -> "-g"+++verifyFlagToArg :: VerifyFlag -> String+verifyFlagToArg _ = error "verifyFlagToArg"+++-- High-level interface+-- --------------------++-- | Compile an NVVM IR module according to the specified options. If an error+-- occurs an exception is thrown, otherwise the generated PTX is returned+-- together with any warning or verification messages generated during+-- compilation.+--+-- The input NVVM IR module can be either in the bitcode representation or the+-- text representation.+--+compileModule+    :: String                           -- ^ name of the module (optional)+    -> ByteString                       -- ^ module NVVM IR+    -> [CompileFlag]                    -- ^ compilation options+    -> Bool                             -- ^ verify program?+    -> IO Result+compileModule name bc = compileModules [(name,bc)]+++-- | Compile and link multiple NVVM IR modules together to form a single+-- program. The compiled result is represented in PTX.+--+-- Each NVVM IR module may individually be in either the bitcode representation+-- or in the text representation.+--+compileModules+    :: [(String, ByteString)]           -- ^ modules to compile and link+    -> [CompileFlag]                    -- ^ compilation options+    -> Bool                             -- ^ verify program?+    -> IO Result+compileModules modules opts verify =+  bracket create destroy $ \prg -> do+    res <- try $ do+      mapM_ (uncurry (addModule prg)) modules+      when verify (verifyProgram prg [])+      compileProgram prg opts+      compilerResult prg+    log   <- compilerLog prg+    case res of+      Left (err :: NVVMException) -> nvvmError (unlines [show err, B.unpack log])+      Right ptx                   -> return $! Result log ptx+++-- The raw interface to libNVVM+-- ----------------------------++-- | Create a new program handle+--+create :: IO Program+create = resultIfOk =<< nvvmCreateProgram++{-# INLINE nvvmCreateProgram #-}+{# fun unsafe nvvmCreateProgram+  { alloca- `Program' peekProgram*+  }+  -> `Status' cToEnum #}+  where+    peekProgram = liftM Program . peek+++-- | Destroy a program handle+--+destroy :: Program -> IO ()+destroy p = nothingIfOk =<< nvvmDestroyProgram p++{-# INLINE nvvmDestroyProgram #-}+{# fun unsafe nvvmDestroyProgram+  { withProgram* `Program' } -> `Status' cToEnum #}+  where+    withProgram = with . useProgram+++-- | Add an NVVM IR module to the given program compilation unit. An exception+-- is raised if:+--+--   * The 'Program' to add to is invalid; or+--+--   * The NVVM module IR is invalid.+--+addModule :: Program -> String -> ByteString -> IO ()+addModule prg name mdl =+  B.unsafeUseAsCStringLen mdl $ \(b,n) -> do+    nothingIfOk =<< nvvmAddModuleToProgram prg b n name++{-# INLINE nvvmAddModuleToProgram #-}+{# fun unsafe nvvmAddModuleToProgram+  { useProgram    `Program'+  , id            `CString'+  , cIntConv      `Int'+  , withCString'* `String'+  }+  -> `Status' cToEnum #}+  where+    withCString' [] f   = f nullPtr             -- defaults to "<unnamed>"+    withCString' s  f   = withCString s f+++-- | Compile the given 'Program' and all modules that have been previously added+-- to it.+--+compileProgram :: Program -> [CompileFlag] -> IO ()+compileProgram prg opts =+  bracket+    (mapM (newCString . compileFlagToArg) opts)+    (mapM free)+    (\args -> nothingIfOk =<< withArrayLen args (nvvmCompileProgram prg))++{-# INLINE nvvmCompileProgram #-}+{# fun unsafe nvvmCompileProgram+  { useProgram  `Program'+  , cIntConv    `Int'+  , id          `Ptr CString'+  }+  -> `Status' cToEnum #}+++-- | Retrieve the result of compiling a 'Program' as a 'ByteString' containing+-- the generated PTX. An exception is raised if the compilation unit is invalid.+--+compilerResult :: Program -> IO ByteString+compilerResult prg = do+  n     <- resultIfOk =<< nvvmGetCompiledResultSize prg+  log   <- B.mallocByteString n+  nothingIfOk =<< nvvmGetCompiledResult prg log+  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator++{-# INLINE nvvmGetCompiledResult #-}+{# fun unsafe nvvmGetCompiledResult+  { useProgram       `Program'+  , withForeignPtr'* `ForeignPtr Word8'+  }+  -> `Status' cToEnum #}+  where+    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f++{-# INLINE nvvmGetCompiledResultSize #-}+{# fun unsafe nvvmGetCompiledResultSize+  { useProgram  `Program'+  , alloca-     `Int'     peekIntConv*+  }+  -> `Status' cToEnum #}+++-- | Retrieve the log of compiling a 'Program' as a 'ByteString'.+--+compilerLog :: Program -> IO ByteString+compilerLog prg = do+  n     <- resultIfOk =<< nvvmGetProgramLogSize prg+  log   <- B.mallocByteString n+  nothingIfOk =<< nvvmGetProgramLog prg log+  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator++{-# INLINE nvvmGetProgramLog #-}+{# fun unsafe nvvmGetProgramLog+  { useProgram       `Program'+  , withForeignPtr'* `ForeignPtr Word8'+  }+  -> `Status' cToEnum #}+  where+    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f++{-# INLINE nvvmGetProgramLogSize #-}+{# fun unsafe nvvmGetProgramLogSize+  { useProgram  `Program'+  , alloca-     `Int'     peekIntConv*+  }+  -> `Status' cToEnum #}+++-- | Verify the NVVM program. If an error is encountered, an exception is+-- thrown.+--+verifyProgram :: Program -> [VerifyFlag] -> IO ()+verifyProgram prg opts =+  bracket+    (mapM (newCString . verifyFlagToArg) opts)+    (mapM free)+    (\args -> nothingIfOk =<< withArrayLen args (nvvmVerifyProgram prg))++{# fun unsafe nvvmVerifyProgram+  { useProgram `Program'+  , cIntConv   `Int'+  , id         `Ptr CString'+  }+  -> `Status' cToEnum #}+
+ Foreign/LibNVVM/Error.chs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DeriveDataTypeable       #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+-- |+-- Module      : Foreign.LibNVVM.Error+-- Copyright   : NVIDIA Corporation+-- License     : MIT+--+-- Maintainer  : Sean Lee <selee@nvidia.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--+module Foreign.LibNVVM.Error (++  -- * Error code+  Status(..), NVVMException(..),+  nvvmError, describe,++  -- * Helper functions+  resultIfOk, nothingIfOk,++) where++import Control.Exception+import Data.Typeable+import System.IO.Unsafe+import Foreign.C+import Foreign.Ptr+import Foreign.LibNVVM.Internal++#include "cbits/stubs.h"+{# context lib = "nvvm" #}++-- |+-- The type 'Status' is an enumeration whose values represent the status of the+-- last libNVVM operation.+--+{# enum nvvmResult as Status+    { underscoreToCase+    , NVVM_SUCCESS as Success+    }+    with prefix="NVVM_ERROR" deriving (Eq, Show) #}+++-- | An NVVM Exception+--+data NVVMException+  = ExitCode  Status+  | UserError String+  deriving Typeable++instance Exception NVVMException++instance Show NVVMException where+  showsPrec n (ExitCode s)  = showsPrec n ("NVVM Exception: " ++ describe s)+  showsPrec _ (UserError s) = showString s++-- | Raise an 'NVVMException' in the IO monad+--+nvvmError :: String -> IO a+nvvmError s = throwIO (UserError s)+++-- Helper function+-- ---------------++-- | Get the message string for a given NVVM result code+--+{# fun pure unsafe nvvmGetErrorString as describe+    { cFromEnum `Status' } -> `String' #}++-- |+-- Return the results of a function on successful execution, otherwise throw an+-- exception with an error string associated with the return code+--+{-# INLINE resultIfOk #-}+resultIfOk :: (Status, a) -> IO a+resultIfOk (status, result) =+    case status of+        Success -> return  result+        _       -> throwIO (ExitCode status)++-- |+-- Throw an exception with an error string associated with an unsuccessful+-- return code, otherwise return unit.+--+{-# INLINE nothingIfOk #-}+nothingIfOk :: Status -> IO ()+nothingIfOk status =+    case status of+        Success -> return  ()+        _       -> throwIO (ExitCode status)+
+ Foreign/LibNVVM/Info.chs view
@@ -0,0 +1,62 @@+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+-- |+-- Module      : Foreign.LibNVVM.Info+-- Copyright   : NVIDIA Corporation+-- License     : MIT+--+-- Maintainer  : Sean Lee <selee@nvidia.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Foreign.LibNVVM.Info (++  nvvmVersion,++) where++import Foreign.LibNVVM.Internal+import Foreign.LibNVVM.Error++import Data.Version+import Foreign.C+import Foreign.Ptr+import Foreign.Marshal++#include "cbits/stubs.h"+{# context lib="nvvm" #}+++-- | Return the libNVVM version number+--+nvvmVersion :: IO Version+nvvmVersion = do+  (r, major,minor) <- nvvmVersion'+  resultIfOk (r, Version [major,minor] [])+++{-# INLINE nvvmVersion' #-}+{# fun unsafe nvvmVersion as nvvmVersion'+  { alloca- `Int' peekIntConv*+  , alloca- `Int' peekIntConv*+  }+  -> `Status' cToEnum #}+
+ Foreign/LibNVVM/Internal.chs view
@@ -0,0 +1,89 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DeriveDataTypeable       #-}+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+-- |+-- Module      : Foreign.LibNVVM.Internal+-- Copyright   : NVIDIA Corporation+-- License     : MIT+--+-- Maintainer  : Sean Lee <selee@nvidia.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Foreign.LibNVVM.Internal (++  withIntConv, withFloatConv, peekIntConv, peekFloatConv,++  cIntConv, cFloatConv,+  cToEnum, cFromEnum,++) where++import Control.Monad+import Foreign.C+import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+++-- Composite marshalling functions+-- -------------------------------++withIntConv :: (Storable b, Integral a, Integral b) => a -> (Ptr b -> IO c) -> IO c+withIntConv = with . cIntConv++withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c+withFloatConv = with . cFloatConv++peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b+peekIntConv = liftM cIntConv . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b+peekFloatConv = liftM cFloatConv . peek+++-- Conversion routines+-- -------------------++{-# INLINE cIntConv #-}+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv  = fromIntegral++{-# INLINE [1] cFloatConv #-}+cFloatConv :: (RealFloat a, RealFloat b) => a -> b+cFloatConv  = realToFrac+-- As this conversion by default goes via `Rational', it can be very slow...+{-# RULES+  "cFloatConv/Float->Float"    forall (x::Float).  cFloatConv x = x;+  "cFloatConv/Double->Double"  forall (x::Double). cFloatConv x = x;+  "cFloatConv/Float->CFloat"   forall (x::Float).  cFloatConv x = CFloat x;+  "cFloatConv/CFloat->Float"   forall (x::Float).  cFloatConv CFloat x = x;+  "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x;+  "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x+ #-}++cToEnum :: (Integral i, Enum e) => i -> e+cToEnum  = toEnum . cIntConv++cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum  = cIntConv . fromEnum+
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,22 @@+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++import Distribution.Simple+main = defaultMain
+ Test/simple/Simple.hs view
@@ -0,0 +1,164 @@+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++module Main (main) where++import Foreign.LibNVVM++import Control.Monad+import Control.Exception+import Text.Printf+import Test.HUnit                                       hiding (Test)+import Test.Framework.Providers.HUnit                   (testCase)++import qualified Data.ByteString                        as B+import qualified Data.ByteString.Char8                  as B8+import qualified Test.Framework                         as TF (Test, defaultMain, testGroup)++main :: IO ()+main = TF.defaultMain tests++tests :: [TF.Test]+tests =+  [ TF.testGroup "Positive tests"+          [ testCase "compile HelloWorld.ll"+                     pCompileHelloWorldLL+          , testCase "compile HelloWorld.bc"+                     pCompileHelloWorldBC+          , testCase "compile multiple .ll files"+                     pCompileMultipleLL+          , testCase "compile multiple .bc files"+                     pCompileMultipleBC+          , testCase "compile multiple .ll and .bc files"+                     pCompileMultipleLLBC+          ]+  , TF.testGroup "Negative tests"+          [ testCase "compile HelloWorldWithError.ll"+                     nCompileHelloWorldWithErrorLL+          , testCase "compile multiple .ll files with redefinitions"+                     nCompileMultipleLL+          , testCase "compile multiple .bc files with redefinitions"+                     nCompileMultipleBC+          , testCase "compile multiple .ll and .bc files with redefinitions"+                     nCompileMultipleLLBC+          ]+  ]+++assertRaises+    :: (Exception e, Show e, Eq e)+    => String+    -> e+    -> IO a+    -> Assertion+assertRaises msg selector action =+  let testErr e+        | e == selector = return ()+        | otherwise     = assertFailure $ printf "%s\nReceived unexpected exception: %s\nInstead of exception: %s"+                                                 msg (show e) (show selector)+  in do+    r <- try action+    case r of+      Left e  -> testErr e+      Right _ -> assertFailure $ printf "%s\nReceived no exception, but was expecting: %s" msg (show selector)+++-- Compilation actually returns a UserError so that the compilation error+-- message is returned as part of the string. The first line of the error+-- message does contain the Status error string, however, so just compare that.+--+instance Eq NVVMException where+  s == t = head (lines (show s)) == head (lines (show t))+++-- Positive tests+-- --------------++pCompileHelloWorldLL :: Assertion+pCompileHelloWorldLL = do+  ll   <- B8.readFile "Test/data/HelloWorld.ll"+  void $! compileModule "compileLL" ll [] True++pCompileHelloWorldBC :: Assertion+pCompileHelloWorldBC = do+  bc   <- B.readFile "Test/data/HelloWorld.bc"+  void $! compileModule "compileBC" bc [] True++pCompileMultipleLL :: Assertion+pCompileMultipleLL = do+  lls <- mapM B8.readFile [ "Test/data/HelloWorld0.ll"+                          , "Test/data/HelloWorld1.ll"+                          , "Test/data/HelloWorld2.ll"+                          , "Test/data/HelloWorld3.ll"+                          ]+  void $! compileModules (zip (repeat "compileMultipleLL") lls) [] True++pCompileMultipleBC :: Assertion+pCompileMultipleBC = do+  bcs <- mapM B.readFile [ "Test/data/HelloWorld0.bc"+                         , "Test/data/HelloWorld1.bc"+                         , "Test/data/HelloWorld2.bc"+                         , "Test/data/HelloWorld3.bc"+                         ]+  void $! compileModules (zip (repeat "compileMultipleBC") bcs) [] True++pCompileMultipleLLBC :: Assertion+pCompileMultipleLLBC = do+  llbcs <- sequence [ B8.readFile "Test/data/HelloWorld0.ll"+                    , B.readFile  "Test/data/HelloWorld1.bc"+                    , B8.readFile "Test/data/HelloWorld2.ll"+                    , B.readFile  "Test/data/HelloWorld3.bc"+                    ]+  void $! compileModules (zip (repeat "compileMultipleLLBC") llbcs) [] True++-- Negative tests+-- --------------++compilationError :: IO Result -> Assertion+compilationError action =+  assertRaises "Compilation Error" (ExitCode Compilation) action+++nCompileHelloWorldWithErrorLL :: Assertion+nCompileHelloWorldWithErrorLL = do+  ll <- B8.readFile "Test/data/HelloWorldWithError.ll"+  compilationError $ compileModule "errorLL" ll [] True++nCompileMultipleLL :: Assertion+nCompileMultipleLL = do+  lls <- mapM B8.readFile [ "Test/data/HelloWorld.ll"+                          , "Test/data/HelloWorld.ll"+                          ]+  compilationError $ compileModules (zip (repeat "errorMultipleLL") lls) [] True++nCompileMultipleBC :: Assertion+nCompileMultipleBC = do+  bcs <- mapM B.readFile [ "Test/data/HelloWorld.bc"+                         , "Test/data/HelloWorld.bc"+                         ]+  compilationError $ compileModules (zip (repeat "errorMultipleBC") bcs) [] True++nCompileMultipleLLBC :: Assertion+nCompileMultipleLLBC = do+  llbcs <- sequence [ B8.readFile "Test/data/HelloWorld.ll"+                    ,  B.readFile "Test/data/HelloWorld.bc"+                    ]+  compilationError $ compileModules (zip (repeat "errorMultipleLLBC") llbcs) [] True+
+ cbits/stubs.h view
@@ -0,0 +1,26 @@+#ifndef C_STUBS_H+#define C_STUBS_H++/*+ * This part of the code is from https://github.com/tmcdonell/cuda, which+ * is under BSD3 (https://github.com/tmcdonell/cuda/blob/master/LICENSE).+ */+++/*+ * We need to work around some shortcomings in the C parser of c2hs by disabling advanced attributes etc on Apple platforms.+ */+#ifdef __APPLE__+#define _ANSI_SOURCE+#define __AVAILABILITY__+#define __OSX_AVAILABLE_STARTING(_mac, _iphone)+#define __OSX_AVAILABLE_BUT_DEPRECATED(_macIntro, _macDep, _iphoneIntro, _iphoneDep)+#endif+++/*+ * Standard NVVM include. Make sure this comes after the above defines.+ */+#include <nvvm.h>++#endif /* C_STUBS_H */
+ libnvvm.cabal view
@@ -0,0 +1,116 @@+-- Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++Name:                           libnvvm+Version:                        1.0.0+License:                        MIT+License-file:                   LICENSE+Copyright:                      Copyright (c) 2012-2014 NVIDIA Corporation.  All rights reserved.+Author:                         Sean Lee,+                                Trevor McDonell+Maintainer:                     Sean Lee <selee@nvidia.com>+Build-type:                     Simple+Category:                       Foreign+Stability:                      Experimental+Homepage:                       https://github.com/nvidia-compiler-sdk/hsnvvm+Bug-reports:                    https://github.com/nvidia-compiler-sdk/hsnvvm/issues+Cabal-version:                  >= 1.18+Tested-with:                    GHC == 7.6.*+Synopsis:                       FFI binding to libNVVM, a compiler SDK component from NVIDIA+Description:                    FFI binding to libNVVM, a compiler SDK component from NVIDIA++Extra-source-files:             cbits/stubs.h++Library+  Exposed-modules:              Foreign.LibNVVM+                                Foreign.LibNVVM.Compile+                                Foreign.LibNVVM.Error+                                Foreign.LibNVVM.Info++  Other-modules:                Foreign.LibNVVM.Internal++  Include-dirs:                 .+  Includes:                     nvvm.h+  Extra-Libraries:              nvvm++  if os(darwin)+    CC-options:                 -U__BLOCKS__+    Include-dirs:               /usr/local/cuda/nvvm/include+    Extra-lib-dirs:             /usr/local/cuda/nvvm/lib++  if os(linux)+    Include-dirs:               /usr/local/cuda/nvvm/include++    if arch(i386)+      Extra-lib-dirs:           /usr/local/cuda/nvvm/lib++    if arch(x86_64)+      Extra-lib-dirs:           /usr/local/cuda/nvvm/lib64++  GHC-options:                  -Wall -O2 -fwarn-tabs -funbox-strict-fields++  Build-tools:                  c2hs+  Build-depends:                base                        >= 4 && < 5,+                                bytestring                  >= 0.9,+                                cuda                        >= 0.5++  Default-language:             Haskell2010+++Test-suite test-simple+  Main-is:                      Simple.hs+  hs-source-dirs:               Test/simple++  Build-depends:                libnvvm,+                                base                        >= 4 && < 5,+                                bytestring                  >= 0.9,+                                test-framework              >= 0.2,+                                test-framework-hunit        >= 0.2,+                                Cabal                       >= 1.10.1,+                                HUnit                       >= 1.2++  Type:                         exitcode-stdio-1.0+  GHC-options:                  -Wall -O2 -fwarn-tabs+  Default-language:             Haskell2010+++-- Disable due to a libNVVM parsing error bug of the DataLayout field+--+-- Test-suite test-llvmgen+--   Main-is:                     LLVMGen.hs+--   Other-modules:               HelloWorld+--   hs-source-dirs:              Test/llvm-gen+--+--   Build-depends:               libnvvm,+--                                base                        >= 4 && < 5,+--                                bytestring                  >= 0.9,+--                                containers                  >= 0.5,+--                                cuda                        >= 0.5,+--                                llvm-general                == 3.2.*,+--                                llvm-general-pure           == 3.2.*,+--                                mtl                         >= 2.0+--+--   Type:                        exitcode-stdio-1.0+--   GHC-options:                 -Wall -O2 -fwarn-tabs+--   Default-language:            Haskell2010++Source-repository head+  Type:                         git+  Location:                     https://github.com/nvidia-compiler-sdk/hsnvvm.git