packages feed

llvm-extra 0.7.2 → 0.7.3

raw patch · 9 files changed

+464/−25 lines, 9 filesdep +bifunctorsdep ~containers

Dependencies added: bifunctors

Dependency ranges changed: containers

Files

llvm-extra.cabal view
@@ -1,5 +1,5 @@ Name:           llvm-extra-Version:        0.7.2+Version:        0.7.3 License:        BSD3 License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -29,6 +29,10 @@   * various kinds of loops (while) and condition structures (if-then-else)     in "LLVM.Extra.Control"   .+  * more functional loop construction using "LLVM.Extra.Iterator"+  .+  * complex Haskell values mapped to LLVM values in "LLVM.Extra.Multi.Value"+  .   * automatic adaption to target specific extensions,     currently used for access of vector operations     that are specific to an SSE level on x86 processors@@ -71,7 +75,7 @@   default:     True  Source-Repository this-  Tag:         0.7.2+  Tag:         0.7.3   Type:        darcs   Location:    http://code.haskell.org/~thielema/llvm-extra/ @@ -87,6 +91,7 @@     tfp >=1.0 && <1.1,     non-empty >=0.2.1 && <0.4,     containers >=0.1 && <0.6,+    bifunctors >=5.4 && <6,     transformers >=0.1.1 && <0.6,     utility-ht >=0.0.1 && <0.1 @@ -124,6 +129,8 @@     LLVM.Extra.Scalar     LLVM.Extra.Vector     LLVM.Extra.ScalarOrVector+    LLVM.Extra.Iterator+    LLVM.Extra.Multi.Iterator     LLVM.Extra.Multi.Value     LLVM.Extra.Multi.Value.Memory     LLVM.Extra.Multi.Vector
src/Array.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-} module Main where  import LLVM.Extra.Control (arrayLoop, )@@ -12,20 +13,21 @@ import qualified LLVM.Extra.Class as Class import qualified LLVM.Extra.Arithmetic as A +import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Core as LLVM+import LLVM.ExecutionEngine (simpleFunction, ) import LLVM.Core          (Value, valueOf, value, constOf, undef, zero, add, sub, mul, frem,           createFunction, Function, Linkage(ExternalLinkage), ret,           CodeGenModule, CodeGenFunction, store,           Vector, extractelement, insertelement, shufflevector, )-import LLVM.ExecutionEngine (simpleFunction, ) import qualified System.IO as IO  import Type.Data.Num.Decimal(D4, ) import Data.Word (Word32, ) import qualified Foreign.Storable as St import Foreign.Marshal.Array (allocaArray, )-import Foreign.Ptr (Ptr, )+import Foreign.Ptr (FunPtr, Ptr, )  import qualified Data.Empty as Empty import Data.NonEmpty ((!:), )@@ -72,7 +74,8 @@  would not work, because Vector is not of type Generic. -}-mChorusVectorArg :: CodeGenModule (Function (Word32 -> Ptr Float -> Vector D4 Float -> IO Float))+mChorusVectorArg ::+  CodeGenModule (Function (Word32 -> Ptr Float -> Vector D4 Float -> IO Float)) mChorusVectorArg =   createFunction ExternalLinkage $ \ size ptr freq -> do     const1 <- constVec 1@@ -143,7 +146,10 @@     z <- Ext.runUnsafe X86.dpps x y (valueOf 0xF1)     extractelement z (valueOf 0) -mChorusVector :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))+mChorusVector ::+  CodeGenModule+    (Function+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)) mChorusVector =   createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do     freq <- Vector.assemble [f0,f1,f2,f3]@@ -164,7 +170,10 @@ osciSaw freq phase =   liftM2 (,) (waveSaw phase) (SoV.incPhase freq phase) -mChorus :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))+mChorus ::+  CodeGenModule+    (Function+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)) mChorus =   createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do     s <- arrayLoop size ptr Class.zeroTuple $@@ -207,7 +216,10 @@      c <- add a b      return (c, (s1,t1)) -mChorusMonadic :: CodeGenModule (Function (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float))+mChorusMonadic ::+  CodeGenModule+    (Function+      (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)) mChorusMonadic =   createFunction ExternalLinkage $ \ size ptr f0 f1 f2 f3 -> do     s <- arrayLoop size ptr Class.zeroTuple $@@ -220,13 +232,28 @@       return phases'     ret (fst (fst s)) -renderChorus :: IO ()-renderChorus = do++type Importer func = FunPtr func -> func++generateFunction ::+  EE.ExecutionFunction f =>+  Importer f -> CodeGenModule (Function f) -> IO f+generateFunction imprt code = do   m <- LLVM.newModule-  _f <- LLVM.defineModule m mChorusVector+  fill <- do+    func <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> code+    EE.runEngineAccessWithModule m $ EE.getExecutionFunction imprt func   LLVM.writeBitcodeToFile "array.bc" m+  return fill -  fill <- simpleFunction mChorusVector++foreign import ccall safe "dynamic" derefChorusPtr ::+  Importer+    (Word32 -> Ptr Float -> Float -> Float -> Float -> Float -> IO Float)++renderChorus :: IO ()+renderChorus = do+  fill <- generateFunction derefChorusPtr mChorusVector   IO.withFile "speedtest.f32" IO.WriteMode $ \h ->     let len = 10000000     in  allocaArray len $ \ ptr ->@@ -243,9 +270,12 @@       return phase'     ret (s :: Value Float) +foreign import ccall safe "dynamic" derefSawPtr ::+  Importer (Word32 -> Ptr Float -> Float -> IO Float)+ renderSaw :: IO () renderSaw = do-  fill <- simpleFunction mSaw+  fill <- generateFunction derefSawPtr mSaw   IO.withFile "speedtest.f32" IO.WriteMode $ \h ->     let len = 10000000     in  allocaArray len $ \ ptr ->
src/LLVM/Extra/Control.hs view
@@ -211,6 +211,10 @@    return state  +{- |+This is a loop with a single point for exit from within the loop.+The @Bool@ value indicates whether the loop shall be continued.+-} loopWithExit ::    Phi a =>    a ->
+ src/LLVM/Extra/Iterator.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+module LLVM.Extra.Iterator where++import qualified LLVM.Extra.MaybeContinuation as MaybeCont+import qualified LLVM.Extra.Maybe as Maybe++import qualified LLVM.Extra.ArithmeticPrivate as A+import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Control as C+import qualified LLVM.Core as LLVM+import LLVM.Util.Loop (Phi, )+import LLVM.Core+   (CodeGenFunction, Value, value, valueOf,+    CmpRet, CmpResult, IsInteger, IsType, IsConst, )++import Foreign.Ptr (Ptr, )++import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative as App+import qualified Control.Functor.HT as FuncHT+import Control.Monad (void, (<=<), )+import Control.Applicative (Applicative, liftA2, (<$>), (<$), )++import Data.Tuple.HT (mapFst, mapSnd, )++import Prelude hiding (iterate, takeWhile, take, mapM)+++{- |+Simulates a non-strict list.+-}+data T r a =+   forall s. (Phi s) =>+   Cons s (forall z. (Phi z) => s -> MaybeCont.T r z (a,s))++mapM_ :: (a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r ()+mapM_ f (Cons s next) =+   void $+   C.loopWithExit s+      (\s0 ->+         MaybeCont.resolve (next s0)+            (return (valueOf False, s0))+            (\(a,s1) -> (valueOf True, s1) <$ f a))+      return++mapState_ ::+   (Phi t) =>+   (a -> t -> CodeGenFunction r t) ->+   T r a -> t -> CodeGenFunction r t+mapState_ f (Cons s next) t =+   snd <$>+   C.loopWithExit (s,t)+      (\(s0,t0) ->+         MaybeCont.resolve (next s0)+            (return (valueOf False, (s0,t0)))+            (\(a,s1) -> (\t1 -> (valueOf True, (s1,t1))) <$> f a t0))+      return++mapStateM_ ::+   (Phi t) =>+   (a -> MS.StateT t (CodeGenFunction r) ()) ->+   T r a -> MS.StateT t (CodeGenFunction r) ()+mapStateM_ f xs =+   MS.StateT $ \t ->+      (,) () <$> mapState_ (\a t0 -> snd <$> MS.runStateT (f a) t0) xs t+++mapWhileState_ ::+   (Phi t) =>+   (a -> t -> CodeGenFunction r (Value Bool, t)) ->+   T r a -> t -> CodeGenFunction r t+mapWhileState_ f (Cons s next) t =+   snd <$>+   C.loopWithExit (s,t)+      (\(s0,t0) ->+         MaybeCont.resolve (next s0)+            (return (valueOf False, (s0,t0)))+            (\(a,s1) -> (\(b,t1) -> (b, (s1,t1))) <$> f a t0))+      return+++empty :: T r a+empty = Cons () (\() -> MaybeCont.nothing)++singleton :: a -> T r a+singleton a =+   Cons+      (valueOf True)+      (\running -> MaybeCont.guard running >> return (a, valueOf False))+++instance Functor (T r) where+   fmap f (Cons s next) = Cons s (\s0 -> mapFst f <$> next s0)++{- |+@ZipList@ semantics+-}+instance Applicative (T r) where+   pure a = Cons () (\() -> return (a,()))+   Cons fs fnext <*> Cons as anext =+      Cons (fs,as)+         (\(fs0,as0) -> do+            (f,fs1) <- fnext fs0+            (a,as1) <- anext as0+            return (f a, (fs1,as1)))+++{-+On the one hand,+I did not want to name it @map@ because it differs from @fmap@.+On the other hand, @mapM@ does not fit very well+because the result is not in the CodeGenFunction monad.+-}+mapM :: (a -> CodeGenFunction r b) -> T r a -> T r b+mapM f (Cons s next) = Cons s (MaybeCont.lift . FuncHT.mapFst f <=< next)++mapMaybe ::+   (Phi b, Class.Undefined b) =>+   (a -> CodeGenFunction r (Maybe.T b)) -> T r a -> T r b+mapMaybe f = catMaybes . mapM f++catMaybes :: (Phi a, Class.Undefined a) => T r (Maybe.T a) -> T r a+catMaybes (Cons s next) =+   Cons s+      (\s0 ->+         MaybeCont.fromMaybe $+         fmap (\(ma,s2) -> fmap (flip (,) s2) ma) $+         C.loopWithExit s0+            (\s1 ->+               MaybeCont.resolve (next s1)+                  (return (valueOf False, (Maybe.nothing, s1)))+                  (\(ma,s2) ->+                     Maybe.run ma+                        (return (valueOf True, (Maybe.nothing, s2)))+                        (\a -> return (valueOf False, (Maybe.just a, s2)))))+            (return . snd))++takeWhile :: (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a+takeWhile p (Cons s next) =+   Cons s+      (\s0 -> do+         (a,s1) <- next s0+         MaybeCont.guard =<< MaybeCont.lift (p a)+         return (a,s1))++{- |+Attention:+This always performs one function call more than necessary.+I.e. if 'f' reads from or writes to memory+make sure that accessing one more pointer is legal.+-}+iterate :: (Phi a) => (a -> CodeGenFunction r a) -> a -> T r a+iterate f a = Cons a (\a0 -> MaybeCont.lift $ fmap ((,) a0) $ f a0)++{- |+This is MaybeCont.toMaybe' where @('Undefined' a)@ constraint+is replaced by a custom value.+This way, we do not need 'Undefined' constraint in 'T'.+On the other hand, an LLVM-undefined value would enable more LLVM optimizations.+-}+maybeFromCont ::+   a -> MaybeCont.T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a)+maybeFromCont undef (MaybeCont.Cons m) =+   m (return $ Maybe.Cons (valueOf False) undef) (return . Maybe.just)++cartesianAux ::+   (Phi a, Phi b, Class.Undefined a, Class.Undefined b) =>+   T r a -> T r b -> T r (Maybe.T (a,b))+cartesianAux (Cons sa nextA) (Cons sb nextB) =+   Cons (Maybe.nothing,sa,sb)+      (\(ma0,sa0,sb0) -> do+         (a1,sa1) <-+            MaybeCont.fromMaybe $+            Maybe.run ma0+               (maybeFromCont (Class.undefTuple,sa0) $ nextA sa0)+               (\a0 -> return (Maybe.just (a0,sa0)))+         MaybeCont.lift $+            MaybeCont.resolve (nextB sb0)+               (return (Maybe.nothing,(Maybe.nothing,sa1,sb)))+               (\(b1,sb1) ->+                  return (Maybe.just (a1,b1), (Maybe.just a1, sa1, sb1))))+++-- * helper functions++cartesian ::+   (Phi a, Phi b, Class.Undefined a, Class.Undefined b) =>+   T r a -> T r b -> T r (a,b)+cartesian as bs = catMaybes $ cartesianAux as bs++countDown ::+   (Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> T r (Value i)+countDown len =+   takeWhile (A.cmp LLVM.CmpLT (value LLVM.zero)) $ iterate A.dec len++take ::+   (Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> T r a -> T r a+take len xs = liftA2 const xs (countDown len)++arrayPtrs :: (IsType a) => Value (Ptr a) -> T r (Value (Ptr a))+arrayPtrs = iterate A.advanceArrayElementPtr+++-- * examples++fixedLengthLoop ::+   (Phi s,+    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> s ->+   (s -> CodeGenFunction r s) ->+   CodeGenFunction r s+fixedLengthLoop len start loopBody =+   mapState_ (const loopBody) (countDown len) start++arrayLoop ::+   (Phi a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> Value (Ptr b) -> a ->+   (Value (Ptr b) -> a -> CodeGenFunction r a) ->+   CodeGenFunction r a+arrayLoop len ptr start loopBody =+   mapState_ loopBody (take len $ arrayPtrs ptr) start++arrayLoopWithExit ::+   (Phi s, IsType a,+    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> Value (Ptr a) -> s ->+   (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)) ->+   CodeGenFunction r (Value i, s)+arrayLoopWithExit len ptr0 start loopBody = do+   (i, end) <-+      mapWhileState_+         (\(i,ptr) (_i,s) -> mapSnd ((,) i) <$> loopBody ptr s)+         (liftA2 (,) (countDown len) (arrayPtrs ptr0))+         (len,start)+   pos <- A.sub len i+   return (pos, end)++arrayLoop2 ::+   (Phi s, IsType a, IsType b,+    Num i, IsConst i, IsInteger i, CmpRet i, CmpResult i ~ Bool) =>+   Value i -> Value (Ptr a) -> Value (Ptr b) -> s ->+   (Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s) ->+   CodeGenFunction r s+arrayLoop2 len ptrA ptrB start loopBody =+   mapState_ (uncurry loopBody)+      (take len $ liftA2 (,) (arrayPtrs ptrA) (arrayPtrs ptrB)) start
src/LLVM/Extra/MaybeContinuation.hs view
@@ -118,13 +118,11 @@ guard b = Cons $ \n j ->    ifThenElse b (j ()) n -{--just :: CodeGenFunction r a -> T r z a-just a = Cons $ \ _n j -> j =<< a+just :: a -> T r z a+just a = Cons $ \ _n j -> j a  nothing :: T r z a-nothing = Cons \n _j -> n--}+nothing = Cons $ \n _j -> n  bind ::    T r z a ->
src/LLVM/Extra/Memory.hs view
@@ -46,9 +46,9 @@ import Data.Word (Word8, Word16, Word32, Word64, ) import Data.Int  (Int8,  Int16,  Int32,  Int64, ) +import qualified Control.Applicative as App import Control.Monad (ap, ) import Control.Applicative (pure, liftA2, liftA3, )-import qualified Control.Applicative as App  import Data.Tuple.HT (fst3, snd3, thd3, )
+ src/LLVM/Extra/Multi/Iterator.hs view
@@ -0,0 +1,39 @@+module LLVM.Extra.Multi.Iterator (+   takeWhile,+   countDown,+   take,+   ) where++import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.Iterator as Iter++import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction)++import Control.Applicative (liftA2)++import Prelude hiding (take, takeWhile)++++takeWhile ::+   (a -> CodeGenFunction r (MultiValue.T Bool)) ->+   Iter.T r a -> Iter.T r a+takeWhile p = Iter.takeWhile (fmap unpackBool . p)++unpackBool :: MultiValue.T Bool -> LLVM.Value Bool+unpackBool (MultiValue.Cons b) = b++countDown ::+   (MultiValue.Additive i, MultiValue.Comparison i,+    MultiValue.IntegerConstant i) =>+   MultiValue.T i -> Iter.T r (MultiValue.T i)+countDown len =+   takeWhile (MultiValue.cmp LLVM.CmpLT MultiValue.zero) $+   Iter.iterate MultiValue.dec len++take ::+   (MultiValue.Additive i, MultiValue.Comparison i,+    MultiValue.IntegerConstant i) =>+   MultiValue.T i -> Iter.T r a -> Iter.T r a+take len xs = liftA2 const xs (countDown len)
src/LLVM/Extra/Multi/Value.hs view
@@ -26,7 +26,8 @@ import Data.Complex (Complex((:+))) import Data.Function (id, (.), ($), ) import Data.Tuple.HT (uncurry3, )-import Data.Bool (Bool, )+import Data.Maybe (Maybe(Nothing,Just), )+import Data.Bool (Bool(False,True), ) import Data.Word (Word8, Word16, Word32, Word64, ) import Data.Int (Int8, Int16, Int32, Int64, ) @@ -208,6 +209,34 @@ addPhisUnit _bb (Cons ()) (Cons ()) = return ()  +instance (C a) => C (Maybe a) where+   type Repr f (Maybe a) = (f Bool, Repr f a)+   cons Nothing = nothing+   cons (Just a) = just $ cons a+   undef = toMaybe undef undef+   zero = toMaybe (cons False) zero+   phis bb ma =+      case splitMaybe ma of+         (b,a) -> Monad.lift2 toMaybe (phis bb b) (phis bb a)+   addPhis bb x y =+      case (splitMaybe x, splitMaybe y) of+         ((xb,xa), (yb,ya)) ->+            addPhis bb xb yb >>+            addPhis bb xa ya++splitMaybe :: T (Maybe a) -> (T Bool, T a)+splitMaybe (Cons (b,a)) = (Cons b, Cons a)++toMaybe :: T Bool -> T a -> T (Maybe a)+toMaybe (Cons b) (Cons a) = Cons (b,a)++nothing :: (C a) => T (Maybe a)+nothing = toMaybe (cons False) undef++just :: T a -> T (Maybe a)+just = toMaybe (cons True)++ instance (C a, C b) => C (a,b) where    type Repr f (a, b) = (Repr f a, Repr f b)    cons (a,b) = zip (cons a) (cons b)@@ -626,7 +655,12 @@    sub = sub    neg = neg +inc, dec ::+   (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)+inc = add (fromInteger' 1)+dec = sub (fromInteger' 1) + class (Additive a) => PseudoRing a where    mul :: T a -> T a -> LLVM.CodeGenFunction r (T a) @@ -938,17 +972,61 @@    inv :: T a -> LLVM.CodeGenFunction r (T a)  instance Logic Bool where-   and = liftM2 LLVM.and-   or = liftM2 LLVM.or-   xor = liftM2 LLVM.xor-   inv = liftM LLVM.inv+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv +instance Logic Word8 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv +instance Logic Word16 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word32 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++instance Logic Word64 where+   and = liftM2 LLVM.and; or = liftM2 LLVM.or+   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv++ instance Logic a => A.Logic (T a) where    and = and    or = or    xor = xor    inv = inv++++class BitShift a where+   shl :: T a -> T a -> LLVM.CodeGenFunction r (T a)+   shr :: T a -> T a -> LLVM.CodeGenFunction r (T a)++instance BitShift Word8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Int8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
src/LLVM/Extra/Multi/Vector.hs view
@@ -44,6 +44,7 @@    FloatingComparison(..),    Comparison(..),    Logic(..),+   BitShift(..),    ) where  import qualified LLVM.Extra.Multi.Value as MultiValue@@ -71,7 +72,8 @@ import Data.Tuple (snd, ) import Data.Maybe (maybe, ) import Data.List (take, (++), )-import Data.Word (Word32, )+import Data.Word (Word8, Word16, Word32, Word64, )+import Data.Int (Int8, Int16, Int32, Int64, ) import Data.Bool (Bool, )  import qualified Control.Applicative as App@@ -767,3 +769,33 @@    or = or    xor = xor    inv = inv++++class BitShift a where+   shl :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+   shr :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)++instance BitShift Word8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Word64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr++instance BitShift Int8 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int16 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int32 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr++instance BitShift Int64 where+   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr