packages feed

llvm-extra 0.4.1.1 → 0.4.2

raw patch · 8 files changed

+274/−9 lines, 8 files

Files

llvm-extra.cabal view
@@ -1,5 +1,5 @@ Name:           llvm-extra-Version:        0.4.1.1+Version:        0.4.2 License:        BSD3 License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -72,7 +72,7 @@   default:     True  Source-Repository this-  Tag:         0.4.1.1+  Tag:         0.4.2   Type:        darcs   Location:    http://code.haskell.org/~thielema/llvm-extra/ @@ -113,6 +113,7 @@     LLVM.Extra.Monad     LLVM.Extra.Memory     LLVM.Extra.ForeignPtr+    LLVM.Extra.Maybe     LLVM.Extra.MaybeContinuation     LLVM.Extra.Class     LLVM.Extra.Control@@ -120,10 +121,12 @@     LLVM.Extra.Extension.X86     LLVM.Extra.ExtensionCheck.X86     LLVM.Extra.Array+    LLVM.Extra.Scalar     LLVM.Extra.Vector     LLVM.Extra.ScalarOrVector   Other-Modules:     LLVM.Extra.ArithmeticPrivate+    LLVM.Extra.MaybePrivate     LLVM.Extra.Extension.X86Auto  Executable tone-llvm
src/LLVM/Extra/Class.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Class where +import qualified LLVM.Extra.MaybePrivate as Maybe import qualified LLVM.Core as LLVM import LLVM.Core    (Value, value, valueOf, undef,@@ -46,7 +47,10 @@ instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where    undefTuple = (undefTuple, undefTuple, undefTuple) +instance (Undefined a) => Undefined (Maybe.T a) where+   undefTuple = Maybe.Cons undefTuple undefTuple + -- * class for tuples of zero values  class Zero a where@@ -90,6 +94,10 @@       MakeValueTuple (ah,bh,ch) where    type ValueTuple (ah,bh,ch) = (ValueTuple ah, ValueTuple bh, ValueTuple ch)    valueTupleOf ~(a,b,c) = (valueTupleOf a, valueTupleOf b, valueTupleOf c)++instance (MakeValueTuple a) => MakeValueTuple (Maybe a) where+   type ValueTuple (Maybe a) = Maybe.T (ValueTuple a)+   valueTupleOf = maybe (Maybe.nothing undefTuple) (Maybe.just . valueTupleOf)  instance MakeValueTuple Float  where type ValueTuple Float  = Value Float  ; valueTupleOf = valueOf instance MakeValueTuple Double where type ValueTuple Double = Value Double ; valueTupleOf = valueOf
src/LLVM/Extra/Control.hs view
@@ -9,6 +9,7 @@    fixedLengthLoop,    whileLoop,    whileLoopShared,+   loopWithExit,    ifThenElse,    ifThen,    Select(select),@@ -161,13 +162,18 @@        liftM2 (,) (dec i) (loopBody s))  -whileLoop ::+whileLoop, _whileLoop ::    Phi a =>    a ->    (a -> CodeGenFunction r (Value Bool)) ->    (a -> CodeGenFunction r a) ->    CodeGenFunction r a-whileLoop start check body = do+whileLoop start check body =+   loopWithExit start+      (\a -> fmap (flip (,) a) $ check a)+      body++_whileLoop start check body = do    top <- getCurrentBasicBlock    loop <- newBasicBlock    cont <- newBasicBlock@@ -186,6 +192,33 @@     defineBasicBlock exit    return state+++loopWithExit ::+   Phi a =>+   a ->+   (a -> CodeGenFunction r (Value Bool, b)) ->+   (b -> CodeGenFunction r a) ->+   CodeGenFunction r b+loopWithExit start check body = do+   top <- getCurrentBasicBlock+   loop <- newBasicBlock+   cont <- newBasicBlock+   exit <- newBasicBlock+   br loop++   defineBasicBlock loop+   state <- phis top start+   (contB,b) <- check state+   condBr contB cont exit+   defineBasicBlock cont+   a <- body b+   cont' <- getCurrentBasicBlock+   addPhis cont' state a+   br loop++   defineBasicBlock exit+   return b   {- |
+ src/LLVM/Extra/Maybe.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TypeFamilies #-}+{- |+LLVM counterpart to 'Maybe' datatype.+-}+module LLVM.Extra.Maybe (+   Maybe.T(..),+   Maybe.run,+   Maybe.fromBool,+   Maybe.toBool,+   Maybe.just,+   nothing,+   ) where++import qualified LLVM.Extra.MaybePrivate as Maybe+import LLVM.Extra.Class (Undefined, undefTuple, )+++nothing :: (Undefined a) => Maybe.T a+nothing = Maybe.nothing undefTuple
src/LLVM/Extra/MaybeContinuation.hs view
@@ -1,15 +1,21 @@ {-# LANGUAGE TypeFamilies #-} {- |-Maybe datatype implemented in continuation passing style.+Maybe transformer datatype implemented in continuation passing style. -} module LLVM.Extra.MaybeContinuation where +import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as C import LLVM.Extra.Control (ifThenElse, )- import LLVM.Extra.Class (Undefined, undefTuple, )-import qualified LLVM.Extra.Arithmetic as A-import LLVM.Core as LLVM++import qualified LLVM.Core as LLVM+import LLVM.Core+   (Value, value, valueOf,+    CodeGenFunction, Ptr,+    IsConst, IsType, IsFirstClass, IsInteger,+    CmpRet, CmpResult, ) import LLVM.Util.Loop (Phi, ) -- (phis, addPhis, )  import Control.Monad.IO.Class (MonadIO(liftIO), )@@ -19,7 +25,7 @@ import Control.Monad.HT ((<=<), ) import Data.Tuple.HT (mapSnd, ) -import Prelude hiding (and, iterate, map, zip, zipWith, writeFile, )+import Prelude hiding (map, )   {- |@@ -81,6 +87,22 @@ toBool (Cons m) =    m (return (valueOf False, undefTuple)) (return . (,) (valueOf True)) ++fromMaybe ::+   (Phi z) =>+   CodeGenFunction r (Maybe.T a) -> T r z a+fromMaybe m = do+   Maybe.Cons b a <- lift m+   guard b+   return a++toMaybe ::+   (Undefined a) =>+   T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a)+toMaybe (Cons m) =+   m (return Maybe.nothing) (return . Maybe.just)++ isJust ::    T r (Value Bool) a -> CodeGenFunction r (Value Bool) isJust (Cons m) =@@ -109,6 +131,15 @@    T r z b bind (Cons ma) mb = Cons $ \n j ->    ma n (\a -> resolve (mb a) n j)++{- |+Run an exception handler if the Maybe-action fails.+The exception is propagated.+That is, the handler is intended for a cleanup procedure.+-}+onFail :: CodeGenFunction r () -> T r z a -> T r z a+onFail handler m = Cons $ \n j -> resolve m (handler >> n) j+  {- | If the returned position is smaller than the array size,
+ src/LLVM/Extra/MaybePrivate.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TypeFamilies #-}+module LLVM.Extra.MaybePrivate where++import LLVM.Extra.Control (ifThenElse, )++import LLVM.Core (Value, valueOf, CodeGenFunction, )+import LLVM.Util.Loop (Phi, phis, addPhis, )++import Control.Monad (liftM2, )+++{- |+If @isJust = False@, then @fromJust@ is an @undefTuple@.+-}+data T a = Cons {isJust :: Value Bool, fromJust :: a}+++instance Functor T where+   fmap f (Cons b a) = Cons b (f a)++instance (Phi a) => Phi (T a) where+   phis bb (Cons b a) = liftM2 Cons (phis bb b) (phis bb a)+   addPhis bb (Cons b0 a0) (Cons b1 a1) =+      addPhis bb b0 b1 >> addPhis bb a0 a1+++{- |+counterpart to 'maybe'+-}+run ::+   (Phi b) =>+   T a ->+   CodeGenFunction r b ->+   (a -> CodeGenFunction r b) ->+   CodeGenFunction r b+run (Cons b a) n j =+   ifThenElse b (j a) n+++{- |+counterpart to Data.Maybe.HT.toMaybe+-}+fromBool :: Value Bool -> a -> T a+fromBool = Cons++toBool :: T a -> (Value Bool, a)+toBool (Cons b a) = (b,a)++just :: a -> T a+just = Cons (valueOf True)++nothing :: a -> T a+nothing undef = Cons (valueOf False) undef
src/LLVM/Extra/Memory.hs view
@@ -16,6 +16,7 @@ import qualified LLVM.Extra.ArithmeticPrivate as A import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Array as Array+import qualified LLVM.Extra.Maybe as Maybe  import qualified LLVM.Core as LLVM import LLVM.Core@@ -41,7 +42,9 @@  import Data.Tuple.HT (fst3, snd3, thd3, ) +import Prelude hiding (maybe, ) + {- | An implementation of both 'MakeValueTuple' and 'Memory.C' must ensure that @haskellValue@ is compatible@@ -177,6 +180,23 @@    store = storeRecord triple    decompose = decomposeRecord triple    compose = composeRecord triple+++maybe ::+   (C a) =>+   Record r (LLVM.Struct (Word32, (Struct a, ()))) (Maybe.T a)+maybe =+   liftA2 Maybe.Cons+      (element Maybe.isJust d0)+      (element Maybe.fromJust d1)++instance (C a) => C (Maybe.T a) where+   type Struct (Maybe.T a) = LLVM.Struct (Word32, (Struct a, ()))+   load = loadRecord maybe+   store = storeRecord maybe+   decompose = decomposeRecord maybe+   compose = composeRecord maybe+   {-
+ src/LLVM/Extra/Scalar.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TypeFamilies #-}+module LLVM.Extra.Scalar where++import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Arithmetic as A++import qualified Control.Monad as Monad+++{- |+The entire purpose of this datatype is to mark a type as scalar,+although it might also be interpreted as vector.+This way you can write generic operations for vectors+using the 'A.PseudoModule' class,+and specialise them to scalar types with respect to the 'A.PseudoRing' class.+From another perspective+you can consider the 'Scalar.T' type constructor a marker+where the 'A.Scalar' type function+stops reducing nested vector types to scalar types.+-}+newtype T a = Cons {decons :: a}++liftM :: (Monad m) => (a -> m b) -> T a -> m (T b)+liftM f (Cons a) = Monad.liftM Cons $ f a++liftM2 :: (Monad m) => (a -> b -> m c) -> T a -> T b -> m (T c)+liftM2 f (Cons a) (Cons b) = Monad.liftM Cons $ f a b+++unliftM ::+   (Monad m) =>+   (T a -> m (T b)) ->+   a -> m b+unliftM f a =+   Monad.liftM decons $ f (Cons a)++unliftM2 ::+   (Monad m) =>+   (T a -> T b -> m (T c)) ->+   a -> b -> m c+unliftM2 f a b =+   Monad.liftM decons $ f (Cons a) (Cons b)++unliftM3 ::+   (Monad m) =>+   (T a -> T b -> T c -> m (T d)) ->+   a -> b -> c -> m d+unliftM3 f a b c =+   Monad.liftM decons $ f (Cons a) (Cons b) (Cons c)+++instance (Class.Zero a) => Class.Zero (T a) where+   zeroTuple = Cons Class.zeroTuple++instance (A.IntegerConstant a) => A.IntegerConstant (T a) where+   fromInteger' = Cons . A.fromInteger'++instance (A.RationalConstant a) => A.RationalConstant (T a) where+   fromRational' = Cons . A.fromRational'++instance (A.Additive a) => A.Additive (T a) where+   zero = Cons A.zero+   add = liftM2 A.add+   sub = liftM2 A.sub+   neg = liftM A.neg++instance (A.PseudoRing a) => A.PseudoRing (T a) where+   mul = liftM2 A.mul++instance (A.Field a) => A.Field (T a) where+   fdiv = liftM2 A.fdiv++type instance A.Scalar (T a) = T a++instance (A.PseudoRing a) => A.PseudoModule (T a) where+   scale = liftM2 A.mul+++instance (A.Real a) => A.Real (T a) where+   min = liftM2 A.min+   max = liftM2 A.max+   abs = liftM A.abs+   signum = liftM A.signum++instance (A.Fraction a) => A.Fraction (T a) where+   truncate = liftM A.truncate+   fraction = liftM A.fraction++instance (A.Algebraic a) => A.Algebraic (T a) where+   sqrt = liftM A.sqrt++instance (A.Transcendental a) => A.Transcendental (T a) where+   pi = fmap Cons A.pi+   sin = liftM A.sin+   cos = liftM A.cos+   exp = liftM A.exp+   log = liftM A.log+   pow = liftM2 A.pow