llvm-general 3.3.13.1 → 3.3.13.2
raw patch · 18 files changed
+308/−75 lines, 18 filesdep +transformers-compatdep ~llvm-generaldep ~llvm-general-puredep ~mtl
Dependencies added: transformers-compat
Dependency ranges changed: llvm-general, llvm-general-pure, mtl, transformers
Files
- llvm-general.cabal +16/−12
- src/Control/Monad/AnyCont/Class.hs +11/−3
- src/Control/Monad/Exceptable.hs +220/−0
- src/LLVM/General/Internal/Analysis.hs +2/−2
- src/LLVM/General/Internal/DataLayout.hs +1/−1
- src/LLVM/General/Internal/EncodeAST.hs +7/−7
- src/LLVM/General/Internal/ExecutionEngine.hs +2/−2
- src/LLVM/General/Internal/Instruction.hs +2/−2
- src/LLVM/General/Internal/MemoryBuffer.hs +1/−1
- src/LLVM/General/Internal/Module.hs +17/−17
- src/LLVM/General/Internal/RawOStream.hs +6/−6
- src/LLVM/General/Internal/Target.hs +7/−7
- src/LLVM/General/Internal/Type.hs +10/−10
- test/LLVM/General/Test/Analysis.hs +1/−1
- test/LLVM/General/Test/Instrumentation.hs +2/−1
- test/LLVM/General/Test/Linking.hs +1/−1
- test/LLVM/General/Test/Module.hs +1/−1
- test/LLVM/General/Test/Support.hs +1/−1
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.3.13.1+version: 3.3.13.2 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -29,7 +29,7 @@ src/LLVM/General/Internal/FFI/Target.h src/LLVM/General/Internal/FFI/Type.h src/LLVM/General/Internal/FFI/Value.h- + source-repository head type: git location: git://github.com/bscarlet/llvm-general.git@@ -38,7 +38,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3- tag: llvm-general-v3.3.13.1+ tag: v3.3.13.2 flag shared-llvm description: link against llvm shared rather than static library@@ -51,18 +51,19 @@ library build-tools: llvm-config ghc-options: -fwarn-unused-imports- build-depends: + build-depends: base >= 4.5.0.0 && < 5, utf8-string >= 0.3.7, bytestring >= 0.9.1.10,- transformers >= 0.4.0.0,- mtl >= 2.2.1,+ transformers >= 0.3.0.0,+ transformers-compat,+ mtl >= 2.1.3, template-haskell >= 2.5.0.0, containers >= 0.4.2.1, parsec >= 3.1.3, array >= 0.4.0.0, setenv >= 0.1.0,- llvm-general-pure == 3.3.13.0+ llvm-general-pure == 3.3.13.1 extra-libraries: stdc++ hs-source-dirs: src extensions:@@ -93,6 +94,7 @@ other-modules: Control.Monad.AnyCont+ Control.Monad.Exceptable Control.Monad.AnyCont.Class Control.Monad.Trans.AnyCont LLVM.General.Internal.Analysis@@ -168,7 +170,7 @@ LLVM.General.Internal.FFI.Value include-dirs: src- c-sources: + c-sources: src/LLVM/General/Internal/FFI/AssemblyC.cpp src/LLVM/General/Internal/FFI/BitcodeC.cpp src/LLVM/General/Internal/FFI/BuilderC.cpp@@ -194,17 +196,19 @@ test-suite test type: exitcode-stdio-1.0- build-depends: + build-depends: base >= 3 && < 5, test-framework >= 0.5, test-framework-hunit >= 0.2.7, HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1,- llvm-general == 3.3.13.1,- llvm-general-pure == 3.3.13.0,+ llvm-general == 3.3.13.2,+ llvm-general-pure == 3.3.13.1, containers >= 0.4.2.1,- mtl >= 2.2.1+ mtl >= 2.1,+ transformers >= 0.3.0.0,+ transformers-compat hs-source-dirs: test extensions: TupleSections
src/Control/Monad/AnyCont/Class.hs view
@@ -10,6 +10,7 @@ import qualified Control.Monad.Trans.AnyCont as AnyCont import Control.Monad.Trans.Except as Except import Control.Monad.Trans.State as State+import Control.Monad.Exceptable as Exceptable class ScopeAnyCont m where scopeAnyCont :: m a -> m a@@ -23,8 +24,8 @@ instance Monad m => ScopeAnyCont (AnyContT m) where scopeAnyCont = lift . flip AnyCont.runAnyContT return- + instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (StateT s m) where anyContToM x = lift $ anyContToM x @@ -35,11 +36,15 @@ instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (ExceptT e m) where anyContToM x = lift $ anyContToM x -instance ScopeAnyCont m => ScopeAnyCont (ExceptT e m) where- scopeAnyCont = mapExceptT scopeAnyCont+instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (Exceptable.ExceptableT e m) where+ anyContToM x = lift $ anyContToM x +instance ScopeAnyCont m => ScopeAnyCont (ExceptT e m) where+ scopeAnyCont = mapExceptT scopeAnyCont +instance ScopeAnyCont m => ScopeAnyCont (Exceptable.ExceptableT e m) where+ scopeAnyCont = Exceptable.mapExceptableT scopeAnyCont class MonadTransAnyCont b m where liftAnyCont :: (forall r . (a -> b r) -> b r) -> (forall r . (a -> m r) -> m r)@@ -52,3 +57,6 @@ instance MonadTransAnyCont b m => MonadTransAnyCont b (ExceptT e m) where liftAnyCont c = (\c q -> ExceptT . c $ runExceptT . q) (liftAnyCont c)++instance MonadTransAnyCont b m => MonadTransAnyCont b (Exceptable.ExceptableT e m) where+ liftAnyCont c = (\c q -> makeExceptableT . c $ Exceptable.runExceptableT . q) (liftAnyCont c)
+ src/Control/Monad/Exceptable.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE+ GeneralizedNewtypeDeriving,+ MultiParamTypeClasses,+ UndecidableInstances+ #-}++module Control.Monad.Exceptable(+ -- * MonadError class+ MonadError(..),++ -- * The Exceptable monad+ Exceptable,+ exceptable,+ runExceptable,+ mapExceptable,+ withExceptable,+ makeExceptableT,+ -- * The ExceptT monad transformer+ ExceptableT(ExceptableT),+ unExceptableT,+ runExceptableT,+ mapExceptableT,+ withExceptableT,+ -- * Exception operations+ throwE,+ catchE,+ -- * Lifting other operations+ liftCallCC,+ liftListen,+ liftPass,+ -- * underlying ExceptT type+ Except.Except,+ Except.ExceptT,++ module Control.Monad,+ module Control.Monad.Fix,+ module Control.Monad.Trans,+ -- * Example 1: Custom Error Data Type+ -- $customErrorExample++ -- * Example 2: Using ExceptT Monad Transformer+ -- $ExceptTExample+ ) where++import qualified Control.Monad.Trans.Except as Except++import Control.Monad.Trans+--import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Signatures+--import Control.Monad.Trans.Class+import Data.Functor.Classes+import Data.Functor.Identity++--import qualified Control.Monad.AnyCont.Class as AnyCont+import Control.Monad.State.Class as State+import Control.Monad.Error.Class as Error++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.Foldable+import Data.Traversable (Traversable(traverse))+++{- |+Why does the Exceptable module exist? The present llvm general design+is around the use of the ExceptT transformer, first defined in transformers 0.4.++Well, the goal of this module is to allow LLVM-General to be compatible with+GHC 7.8 apis, and GHC 7.8 comes bundled with transformers 0.3. Thus LLVM-General+must be compatible with transformers 0.3 (via the use of transformers-compat)+in order to be usable in conjunction with usage of GHC as a library.++At some future point where the active "power users" base of LLVM-General+no longer needs to support GHC 7.8 heavily, removing this Module and reverting other+changes elsewhere to using ExceptT / Except will be a good idea.++A good "signpost" for reverting will be around GHC 7.12's release,+because then there will be >=2 GHC major version releases that come bundled with+Transformers >= 0.4++-}+++type Exceptable e = ExceptableT e Identity++-- | Constructor for computations in the exception monad.+-- (The inverse of 'runExcept').+except :: Either e a -> Exceptable e a+except m = makeExceptableT (Identity m)++exceptable :: Except.Except e a -> Exceptable e a+exceptable = ExceptableT++-- | Extractor for computations in the exception monad.+-- (The inverse of 'except').+runExceptable :: Exceptable e a -> Either e a+runExceptable (ExceptableT m) = runIdentity $ Except.runExceptT m++-- | Map the unwrapped computation using the given function.+--+-- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@+mapExceptable :: (Either e a -> Either e' b)+ -> Exceptable e a+ -> Exceptable e' b+mapExceptable f = mapExceptableT (Identity . f . runIdentity)++-- | Transform any exceptions thrown by the computation using the given+-- function (a specialization of 'withExceptT').+withExceptable :: (e -> e') -> Exceptable e a -> Exceptable e' a+withExceptable = withExceptableT++++newtype ExceptableT e m a = ExceptableT { unExceptableT :: Except.ExceptT e m a }+ deriving (+ Eq,+ Eq1,+ Ord,+ Ord1,+ Functor,+ Foldable,+ Applicative,+ Alternative,+ Monad,+ MonadPlus,+ MonadTrans,+ MonadIO+ )++instance MonadState s m => MonadState s (ExceptableT e m) where+ get = lift get+ put = lift . put+ state = lift . state++instance Monad m => MonadError e (ExceptableT e m) where+ throwError = throwE+ catchError = catchE++instance (Traversable f) => Traversable (ExceptableT e f) where+ traverse f a =+ (ExceptableT . Except.ExceptT) <$>+ traverse (either (pure . Left) (fmap Right . f)) (runExceptableT a)+++instance (Read e, Read1 m, Read a) => Read (ExceptableT e m a) where+ readsPrec = readsData $ readsUnary1 "ExceptableT" ExceptableT++instance (Show e, Show1 m, Show a) => Show (ExceptableT e m a) where+ showsPrec d (ExceptableT m) = showsUnary1 "ExceptableT" d m++instance (Read e, Read1 m) => Read1 (ExceptableT e m) where readsPrec1 = readsPrec+instance (Show e, Show1 m) => Show1 (ExceptableT e m) where showsPrec1 = showsPrec++runExceptableT :: ExceptableT e m a -> m (Either e a)+runExceptableT = Except.runExceptT . unExceptableT++makeExceptableT :: m (Either e a) -> ExceptableT e m a+makeExceptableT = ExceptableT . Except.ExceptT+++++-- | Map the unwrapped computation using the given function.+--+-- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@+mapExceptableT :: (m (Either e a) -> n (Either e' b))+ -> ExceptableT e m a+ -> ExceptableT e' n b+mapExceptableT f m = makeExceptableT $ f (runExceptableT m)++-- | Transform any exceptions thrown by the computation using the+-- given function.+withExceptableT :: (Functor m) => (e -> e') -> ExceptableT e m a -> ExceptableT e' m a+withExceptableT f = mapExceptableT $ fmap $ either (Left . f) Right+++-- | Signal an exception value @e@.+--+-- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@+--+-- * @'throwE' e >>= m = 'throwE' e@+throwE :: (Monad m) => e -> ExceptableT e m a+throwE = makeExceptableT . return . Left++-- | Handle an exception.+--+-- * @'catchE' h ('lift' m) = 'lift' m@+--+-- * @'catchE' h ('throwE' e) = h e@+catchE :: (Monad m) =>+ ExceptableT e m a -- ^ the inner computation+ -> (e -> ExceptableT e' m a) -- ^ a handler for exceptions in the inner+ -- computation+ -> ExceptableT e' m a+m `catchE` h = makeExceptableT $ do+ a <- runExceptableT m+ case a of+ Left l -> runExceptableT (h l)+ Right r -> return (Right r)++-- | Lift a @callCC@ operation to the new monad.+liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptableT e m) a b+liftCallCC callCC f = makeExceptableT $+ callCC $ \ c ->+ runExceptableT (f (\ a -> makeExceptableT $ c (Right a)))++-- | Lift a @listen@ operation to the new monad.+liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptableT e m) a+liftListen listen = mapExceptableT $ \ m -> do+ (a, w) <- listen m+ return $! fmap (\ r -> (r, w)) a++-- | Lift a @pass@ operation to the new monad.+liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ExceptableT e m) a+liftPass pass = mapExceptableT $ \ m -> pass $ do+ a <- m+ return $! case a of+ Left l -> (Left l, id)+ Right (r, f) -> (Right r, f)
src/LLVM/General/Internal/Analysis.hs view
@@ -1,6 +1,6 @@ module LLVM.General.Internal.Analysis where -import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import qualified LLVM.General.Internal.FFI.Analysis as FFI@@ -12,7 +12,7 @@ -- | Run basic sanity checks on a 'Module'. Note that the same checks will trigger assertions -- within LLVM if LLVM was built with them turned on, before this function can be is called. verify :: Module -> ExceptT String IO ()-verify (Module m) = flip runAnyContT return $ do+verify (Module m) = unExceptableT $ flip runAnyContT return $ do errorPtr <- alloca result <- decodeM =<< (liftIO $ FFI.verifyModule m FFI.verifierFailureActionReturnStatus errorPtr) when result $ throwError =<< decodeM errorPtr
src/LLVM/General/Internal/DataLayout.hs view
@@ -1,6 +1,6 @@ module LLVM.General.Internal.DataLayout where -import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import Control.Exception
src/LLVM/General/Internal/EncodeAST.hs view
@@ -8,7 +8,7 @@ import Control.Applicative import Control.Exception import Control.Monad.State-import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import Foreign.Ptr@@ -31,7 +31,7 @@ = ForwardValue (Ptr FFI.Value) | DefinedValue (Ptr FFI.Value) -data EncodeState = EncodeState { +data EncodeState = EncodeState { encodeStateBuilder :: Ptr FFI.Builder, encodeStateContext :: Context, encodeStateLocals :: Map A.Name LocalValue,@@ -42,7 +42,7 @@ encodeStateNamedTypes :: Map A.Name (Ptr FFI.Type) } -newtype EncodeAST a = EncodeAST { unEncodeAST :: AnyContT (ExceptT String (StateT EncodeState IO)) a }+newtype EncodeAST a = EncodeAST { unEncodeAST :: AnyContT (ExceptableT String (StateT EncodeState IO)) a } deriving ( Functor, Applicative,@@ -63,9 +63,9 @@ defineType n t = modify $ \s -> s { encodeStateNamedTypes = Map.insert n t (encodeStateNamedTypes s) } runEncodeAST :: Context -> EncodeAST a -> ExceptT String IO a-runEncodeAST context@(Context ctx) (EncodeAST a) = ExceptT $ +runEncodeAST context@(Context ctx) (EncodeAST a) = unExceptableT $ makeExceptableT $ bracket (FFI.createBuilderInContext ctx) FFI.disposeBuilder $ \builder -> do- let initEncodeState = EncodeState { + let initEncodeState = EncodeState { encodeStateBuilder = builder, encodeStateContext = context, encodeStateLocals = Map.empty,@@ -75,7 +75,7 @@ encodeStateMDNodes = Map.empty, encodeStateNamedTypes = Map.empty }- flip evalStateT initEncodeState . runExceptT . flip runAnyContT return $ a+ flip evalStateT initEncodeState . runExceptableT . flip runAnyContT return $ a withName :: A.Name -> (CString -> IO a) -> IO a withName (A.Name n) = withCString n@@ -87,7 +87,7 @@ phase :: EncodeAST a -> EncodeAST (EncodeAST a) phase p = do- let s0 `withLocalsFrom` s1 = s0 { + let s0 `withLocalsFrom` s1 = s0 { encodeStateLocals = encodeStateLocals s1, encodeStateBlocks = encodeStateBlocks s1 }
src/LLVM/General/Internal/ExecutionEngine.hs view
@@ -9,7 +9,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.AnyCont-import Control.Monad.Except+import Control.Monad.Exceptable import Data.Word import Data.IORef@@ -68,7 +68,7 @@ liftIO initializeNativeTarget outExecutionEngine <- alloca outErrorCStringPtr <- alloca- Module dummyModule <- maybe (anyContToM $ liftM (either undefined id) . runExceptT+ Module dummyModule <- maybe (anyContToM $ liftM (either undefined id) . runExceptableT . ExceptableT . withModuleFromAST c (A.Module "" Nothing Nothing [])) (return . Module) m r <- liftIO $ createEngine outExecutionEngine dummyModule outErrorCStringPtr
src/LLVM/General/Internal/Instruction.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE +{-# LANGUAGE TemplateHaskell, QuasiQuotes, MultiParamTypeClasses,@@ -14,7 +14,7 @@ import Data.Functor import Control.Monad-import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import Control.Monad.State
src/LLVM/General/Internal/MemoryBuffer.hs view
@@ -6,7 +6,7 @@ import Control.Exception import Control.Monad-import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS
src/LLVM/General/Internal/Module.hs view
@@ -9,7 +9,7 @@ import Control.Monad.Trans import Control.Monad.State-import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import Control.Applicative import Control.Exception@@ -47,7 +47,7 @@ import LLVM.General.Internal.Global import LLVM.General.Internal.Inject import LLVM.General.Internal.Instruction ()-import qualified LLVM.General.Internal.MemoryBuffer as MB +import qualified LLVM.General.Internal.MemoryBuffer as MB import LLVM.General.Internal.Metadata import LLVM.General.Internal.Operand import LLVM.General.Internal.RawOStream@@ -83,12 +83,12 @@ -- Note that this operation is not commutative - not only concretely (e.g. the destination module -- is modified, becoming the result) but abstractly (e.g. unused private globals in the source -- module do not appear in the result, but similar globals in the destination remain).-linkModules :: +linkModules :: Bool -- ^ True to leave the right module unmodified, False to cannibalize it (for efficiency's sake). -> Module -- ^ The module into which to link -> Module -- ^ The module to link into the other (and cannibalize or not) -> ExceptT String IO ()-linkModules preserveRight (Module m) (Module m') = flip runAnyContT return $ do+linkModules preserveRight (Module m) (Module m') = unExceptableT $ flip runAnyContT return $ do preserveRight <- encodeM preserveRight msgPtr <- alloca result <- decodeM =<< (liftIO $ FFI.linkModules m m' preserveRight msgPtr)@@ -112,7 +112,7 @@ -- | parse 'Module' from LLVM assembly withModuleFromLLVMAssembly :: LLVMAssemblyInput s => Context -> s -> (Module -> IO a) -> ExceptT (Either String Diagnostic) IO a-withModuleFromLLVMAssembly (Context c) s f = flip runAnyContT return $ do+withModuleFromLLVMAssembly (Context c) s f = unExceptableT $ flip runAnyContT return $ do mb <- llvmAssemblyMemoryBuffer s smDiag <- anyContToM withSMDiagnostic m <- anyContToM $ bracket (FFI.parseLLVMAssembly c mb smDiag) FFI.disposeModule@@ -133,7 +133,7 @@ -- | write LLVM assembly for a 'Module' to a file writeLLVMAssemblyToFile :: File -> Module -> ExceptT String IO ()-writeLLVMAssemblyToFile (File path) (Module m) = flip runAnyContT return $ do+writeLLVMAssemblyToFile (File path) (Module m) = unExceptableT $ flip runAnyContT return $ do withFileRawOStream path False False $ liftIO . FFI.writeLLVMAssembly m class BitcodeInput b where@@ -148,7 +148,7 @@ -- | parse 'Module' from LLVM bitcode withModuleFromBitcode :: BitcodeInput b => Context -> b -> (Module -> IO a) -> ExceptT String IO a-withModuleFromBitcode (Context c) b f = flip runAnyContT return $ do+withModuleFromBitcode (Context c) b f = unExceptableT $ flip runAnyContT return $ do mb <- bitcodeMemoryBuffer b msgPtr <- alloca m <- anyContToM $ bracket (FFI.parseBitcode c mb msgPtr) FFI.disposeModule@@ -158,26 +158,26 @@ -- | generate LLVM bitcode from a 'Module' moduleBitcode :: Module -> IO BS.ByteString moduleBitcode (Module m) = do- r <- runExceptT $ withBufferRawOStream (liftIO . FFI.writeBitcode m)+ r <- runExceptableT $ withBufferRawOStream (liftIO . FFI.writeBitcode m) either fail return r -- | write LLVM bitcode from a 'Module' into a file writeBitcodeToFile :: File -> Module -> ExceptT String IO ()-writeBitcodeToFile (File path) (Module m) = flip runAnyContT return $ do+writeBitcodeToFile (File path) (Module m) = unExceptableT $ flip runAnyContT return $ do withFileRawOStream path False True $ liftIO . FFI.writeBitcode m targetMachineEmit :: FFI.CodeGenFileType -> TargetMachine -> Module -> Ptr FFI.RawOStream -> ExceptT String IO ()-targetMachineEmit fileType (TargetMachine tm) (Module m) os = flip runAnyContT return $ do+targetMachineEmit fileType (TargetMachine tm) (Module m) os = unExceptableT $ flip runAnyContT return $ do msgPtr <- alloca r <- decodeM =<< (liftIO $ FFI.targetMachineEmit tm m fileType msgPtr os) when r $ throwError =<< decodeM msgPtr emitToFile :: FFI.CodeGenFileType -> TargetMachine -> File -> Module -> ExceptT String IO ()-emitToFile fileType tm (File path) m = flip runAnyContT return $ do+emitToFile fileType tm (File path) m = unExceptableT$ flip runAnyContT return $ do withFileRawOStream path False True $ targetMachineEmit fileType tm m emitToByteString :: FFI.CodeGenFileType -> TargetMachine -> Module -> ExceptT String IO BS.ByteString-emitToByteString fileType tm m = flip runAnyContT return $ do+emitToByteString fileType tm m = unExceptableT $ flip runAnyContT return $ do withBufferRawOStream $ targetMachineEmit fileType tm m -- | write target-specific assembly directly into a file@@ -259,8 +259,8 @@ eg' :: EncodeAST (Ptr FFI.GlobalValue) <- case g of g@(A.GlobalVariable { A.G.name = n }) -> do typ <- encodeM (A.G.type' g)- g' <- liftIO $ withName n $ \gName -> - FFI.addGlobalInAddressSpace m typ gName + g' <- liftIO $ withName n $ \gName ->+ FFI.addGlobalInAddressSpace m typ gName (fromIntegral ((\(A.AddrSpace a) -> a) $ A.G.addrSpace g)) defineGlobal n g' liftIO $ do@@ -329,7 +329,7 @@ setVisibility g' (A.G.visibility g) return $ return () - liftIO $ f (Module m) + liftIO $ f (Module m) -- | Get an LLVM.General.AST.'LLVM.General.AST.Module' from a LLVM.General.'Module' - i.e. -- raise C++ objects into an Haskell AST.@@ -337,7 +337,7 @@ moduleAST (Module mod) = runDecodeAST $ do c <- return Context `ap` liftIO (FFI.getModuleContext mod) getMetadataKindNames c- return A.Module + return A.Module `ap` (liftIO $ decodeM =<< FFI.getModuleIdentifier mod) `ap` (liftIO $ getDataLayout mod) `ap` (liftIO $ do@@ -418,7 +418,7 @@ return A.NamedMetadataDefinition `ap` (decodeM $ FFI.getNamedMetadataName nm) `ap` liftM (map (\(A.MetadataNodeReference mid) -> mid)) (decodeM (n, os))- + mds <- getMetadataDefinitions return $ tds ++ ias ++ gs ++ nmds ++ mds
src/LLVM/General/Internal/RawOStream.hs view
@@ -1,7 +1,7 @@ module LLVM.General.Internal.RawOStream where import Control.Monad-import Control.Monad.Except+import Control.Monad.Exceptable import Control.Monad.AnyCont import Data.IORef@@ -14,8 +14,8 @@ import LLVM.General.Internal.Inject import LLVM.General.Internal.String () -withFileRawOStream :: - (Inject String e, MonadError e m, MonadAnyCont IO m, MonadIO m) +withFileRawOStream ::+ (Inject String e, MonadError e m, MonadAnyCont IO m, MonadIO m) => String -> Bool -> Bool@@ -28,7 +28,7 @@ msgPtr <- alloca errorRef <- liftIO $ newIORef undefined succeeded <- decodeM =<< (liftIO $ FFI.withFileRawOStream path excl binary msgPtr $ \os -> do- r <- runExceptT (c os)+ r <- runExceptableT (ExceptableT $ c os) writeIORef errorRef r) unless succeeded $ do s <- decodeM msgPtr@@ -36,7 +36,7 @@ e <- liftIO $ readIORef errorRef either (throwError . inject) return e -withBufferRawOStream :: +withBufferRawOStream :: (Inject String e, MonadError e m, MonadIO m, DecodeM IO a (Ptr CChar, CSize)) => (Ptr FFI.RawOStream -> ExceptT String IO ()) -> m a@@ -48,7 +48,7 @@ r <- decodeM (start, size) writeIORef resultRef (Just r) saveError os = do- r <- runExceptT (c os)+ r <- runExceptableT (ExceptableT $ c os) writeIORef errorRef r liftIO $ FFI.withBufferRawOStream saveBuffer saveError e <- liftIO $ readIORef errorRef
src/LLVM/General/Internal/Target.hs view
@@ -7,7 +7,7 @@ module LLVM.General.Internal.Target where import Control.Monad hiding (forM)-import Control.Monad.Except hiding (forM)+import Control.Monad.Exceptable hiding (forM) import Control.Exception import Data.Functor import Data.Traversable (forM)@@ -84,11 +84,11 @@ -- | Find a 'Target' given an architecture and/or a \"triple\". -- | <http://llvm.org/doxygen/structllvm_1_1TargetRegistry.html#a3105b45e546c9cc3cf78d0f2ec18ad89> -- | Be sure to run either 'initializeAllTargets' or 'initializeNativeTarget' before expecting this to succeed, depending on what target(s) you want to use.-lookupTarget :: +lookupTarget :: Maybe String -- ^ arch -> String -- ^ \"triple\" - e.g. x86_64-unknown-linux-gnu -> ExceptT String IO (Target, String)-lookupTarget arch triple = flip runAnyContT return $ do+lookupTarget arch triple = unExceptableT $ flip runAnyContT return $ do cErrorP <- alloca cNewTripleP <- alloca arch <- encodeM (maybe "" id arch)@@ -140,7 +140,7 @@ -- | get all target options peekTargetOptions :: TargetOptions -> IO TO.Options peekTargetOptions (TargetOptions tOpts) = do- let gof = decodeM <=< FFI.getTargetOptionsFlag tOpts + let gof = decodeM <=< FFI.getTargetOptionsFlag tOpts printMachineCode <- gof FFI.targetOptionFlagPrintMachineCode noFramePointerElimination@@ -192,7 +192,7 @@ newtype TargetMachine = TargetMachine (Ptr FFI.TargetMachine) -- | bracket creation and destruction of a 'TargetMachine'-withTargetMachine :: +withTargetMachine :: Target -> String -- ^ triple -> String -- ^ cpu@@ -262,7 +262,7 @@ -- | a space-separated list of LLVM feature names supported by the host CPU getHostCPUFeatures :: IO (Set CPUFeature) getHostCPUFeatures = decodeM =<< FFI.getHostCPUFeatures- + -- | 'DataLayout' to use for the given 'TargetMachine' getTargetMachineDataLayout :: TargetMachine -> IO DataLayout getTargetMachineDataLayout (TargetMachine m) = do@@ -313,7 +313,7 @@ liftIO $ FFI.libFuncSetAvailableWithName f libraryFunction name -- | look up information about the library functions available on a given platform-withTargetLibraryInfo :: +withTargetLibraryInfo :: String -- ^ triple -> (TargetLibraryInfo -> IO a) -> IO a
src/LLVM/General/Internal/Type.hs view
@@ -7,7 +7,7 @@ import Control.Applicative import Control.Monad.State import Control.Monad.AnyCont-import Control.Monad.Except+import Control.Monad.Exceptable import qualified Data.Set as Set @@ -28,7 +28,7 @@ getStructure :: Ptr FFI.Type -> DecodeAST A.Type getStructure t = scopeAnyCont $ do- return A.StructureType + return A.StructureType `ap` (decodeM =<< liftIO (FFI.isPackedStruct t)) `ap` do n <- liftIO (FFI.countStructElementTypes t)@@ -56,7 +56,7 @@ isArrayType t = do k <- liftIO $ FFI.getTypeKind t return $ k == FFI.typeKindArray- + instance Monad m => EncodeM m A.AddrSpace FFI.AddrSpace where encodeM (A.AddrSpace a) = return FFI.AddrSpace `ap` encodeM a @@ -108,7 +108,7 @@ case k of [typeKindP|Void|] -> return A.VoidType [typeKindP|Integer|] -> A.IntegerType <$> (decodeM =<< liftIO (FFI.getIntTypeWidth t))- [typeKindP|Function|] -> + [typeKindP|Function|] -> return A.FunctionType `ap` (decodeM =<< liftIO (FFI.getReturnType t)) `ap` (do@@ -128,17 +128,17 @@ [typeKindP|FP128|] -> return $ A.FloatingPointType 128 A.IEEE [typeKindP|X86_FP80|] -> return $ A.FloatingPointType 80 A.DoubleExtended [typeKindP|PPC_FP128|] -> return $ A.FloatingPointType 128 A.PairOfFloats- [typeKindP|Vector|] -> + [typeKindP|Vector|] -> return A.VectorType `ap` (decodeM =<< liftIO (FFI.getVectorSize t)) `ap` (decodeM =<< liftIO (FFI.getElementType t)) [typeKindP|Struct|] -> do let ifM c a b = c >>= \x -> if x then a else b- ifM (decodeM =<< liftIO (FFI.structIsLiteral t)) + ifM (decodeM =<< liftIO (FFI.structIsLiteral t)) (getStructure t) (saveNamedType t >> return A.NamedTypeReference `ap` getTypeName t) - [typeKindP|Array|] -> + [typeKindP|Array|] -> return A.ArrayType `ap` (decodeM =<< liftIO (FFI.getArrayLength t)) `ap` (decodeM =<< liftIO (FFI.getElementType t))@@ -149,13 +149,13 @@ Context c <- gets encodeStateContext n <- case n of { A.Name n -> encodeM n; _ -> return nullPtr } liftIO $ FFI.structCreateNamed c n- + setNamedType :: Ptr FFI.Type -> A.Type -> EncodeAST () setNamedType t (A.StructureType packed ets) = do ets <- encodeM ets packed <- encodeM packed liftIO $ FFI.structSetBody t ets packed - - ++
test/LLVM/General/Test/Analysis.hs view
@@ -6,7 +6,7 @@ import LLVM.General.Test.Support -import Control.Monad.Except+import Control.Monad.Trans.Except import LLVM.General.Module import LLVM.General.Context
test/LLVM/General/Test/Instrumentation.hs view
@@ -6,7 +6,8 @@ import LLVM.General.Test.Support -import Control.Monad.Except+import Control.Monad.Trans.Except + import Data.Functor import qualified Data.List as List import qualified Data.Set as Set
test/LLVM/General/Test/Linking.hs view
@@ -6,7 +6,7 @@ import LLVM.General.Test.Support -import Control.Monad.Except+import Control.Monad.Trans.Except import Data.Functor import qualified Data.Set as Set import qualified Data.Map as Map
test/LLVM/General/Test/Module.hs view
@@ -6,7 +6,7 @@ import LLVM.General.Test.Support -import Control.Monad.Except+import Control.Monad.Trans.Except import Data.Bits import Data.Word import Data.Functor
test/LLVM/General/Test/Support.hs view
@@ -6,7 +6,7 @@ import Data.Functor import Control.Monad-import Control.Monad.Except+import Control.Monad.Trans.Except import LLVM.General.Context import LLVM.General.Module