llvm-extra 0.7.1 → 0.7.2

raw patch · 4 files changed

+62/−6 lines, 4 files

Files

• llvm-extra.cabal +2/−2
• src/LLVM/Extra/Multi/Value.hs +40/−0
• src/LLVM/Extra/Multi/Value/Memory.hs +19/−3
• src/PrepareIntrinsics.hs +1/−1

@@ -1,5 +1,5 @@ Name:           llvm-extra-Version:        0.7.1+Version:        0.7.2 License:        BSD3 License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -71,7 +71,7 @@   default:     True  Source-Repository this-  Tag:         0.7.1+  Tag:         0.7.2   Type:        darcs   Location:    http://code.haskell.org/~thielema/llvm-extra/ 

@@ -23,6 +23,7 @@  import qualified Data.Tuple.HT as TupleHT import qualified Data.Tuple as Tuple+import Data.Complex (Complex((:+))) import Data.Function (id, (.), ($), ) import Data.Tuple.HT (uncurry3, ) import Data.Bool (Bool, )@@ -318,7 +319,29 @@ unzip4 (Cons (a,b,c,d)) = (Cons a, Cons b, Cons c, Cons d)  +instance (C a) => C (Complex a) where+   type Repr f (Complex a) = Complex (Repr f a)+   cons (a:+b) = consComplex (cons a) (cons b)+   undef = consComplex undef undef+   zero = consComplex zero zero+   phis bb a =+      case deconsComplex a of+         (a0,a1) ->+            Monad.lift2 consComplex (phis bb a0) (phis bb a1)+   addPhis bb a b =+      case (deconsComplex a, deconsComplex b) of+         ((a0,a1), (b0,b1)) ->+            addPhis bb a0 b0 >>+            addPhis bb a1 b1 +consComplex :: T a -> T a -> T (Complex a)+consComplex (Cons a) (Cons b) = Cons (a:+b)++deconsComplex :: T (Complex a) -> (T a, T a)+deconsComplex (Cons (a:+b)) = (Cons a, Cons b)+++ class Compose multituple where    type Composed multituple    {- |@@ -452,6 +475,23 @@         (Decomposed f pa, Decomposed f pb, Decomposed f pc, Decomposed f pd) type instance PatternTuple (pa,pb,pc,pd) =         (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)+++instance (Compose a) => Compose (Complex a) where+   type Composed (Complex a) = Complex (Composed a)+   compose (a:+b) = consComplex (compose a) (compose b)++instance (Decompose pa) => Decompose (Complex pa) where+   decompose (pa:+pb) =+      Tuple.uncurry (:+) .+      TupleHT.mapPair (decompose pa, decompose pb) . deconsComplex++type instance Decomposed f (Complex pa) = Complex (Decomposed f pa)+type instance PatternTuple (Complex pa) = Complex (PatternTuple pa)++realPart, imagPart :: T (Complex a) -> T a+realPart (Cons (a:+_)) = Cons a+imagPart (Cons (_:+b)) = Cons b   

@@ -13,6 +13,7 @@ import Foreign.StablePtr (StablePtr, ) import Foreign.Ptr (Ptr, FunPtr, castPtr, ) +import Data.Complex (Complex, ) import Data.Word (Word8, Word16, Word32, Word64, ) import Data.Int (Int8, Int16, Int32, Int64, ) @@ -170,8 +171,23 @@ composeUnit _ = return (LLVM.value $ LLVM.constStruct ())  +instance (C a) => C (Complex a) where+   type Struct (Complex a) = LLVM.Struct (Struct a, (Struct a, ()))+   decompose c =+      liftA2 MultiValue.consComplex+         (decompose =<< LLVM.extractvalue c TypeNum.d0)+         (decompose =<< LLVM.extractvalue c TypeNum.d1)+   compose c =+      case MultiValue.deconsComplex c of+         (r,i) -> do+            sr <- compose r+            si <- compose i+            rr <- LLVM.insertvalue (LLVM.value LLVM.undef) sr TypeNum.d0+            LLVM.insertvalue rr si TypeNum.d1++ instance (C a, C b) => C (a,b) where-   type Struct (a,b) = (LLVM.Struct (Struct a, (Struct b, ())))+   type Struct (a,b) = LLVM.Struct (Struct a, (Struct b, ()))    decompose ab =       liftA2 MultiValue.zip          (decompose =<< LLVM.extractvalue ab TypeNum.d0)@@ -185,7 +201,7 @@             LLVM.insertvalue ra sb TypeNum.d1  instance (C a, C b, C c) => C (a,b,c) where-   type Struct (a,b,c) = (LLVM.Struct (Struct a, (Struct b, (Struct c, ()))))+   type Struct (a,b,c) = LLVM.Struct (Struct a, (Struct b, (Struct c, ())))    decompose abc =       liftA3 MultiValue.zip3          (decompose =<< LLVM.extractvalue abc TypeNum.d0)@@ -202,7 +218,7 @@             LLVM.insertvalue rb sc TypeNum.d2  instance (C a, C b, C c, C d) => C (a,b,c,d) where-   type Struct (a,b,c,d) = (LLVM.Struct (Struct a, (Struct b, (Struct c, (Struct d, ())))))+   type Struct (a,b,c,d) = LLVM.Struct (Struct a, (Struct b, (Struct c, (Struct d, ()))))    decompose abcd =       pure MultiValue.zip4          <*> (decompose =<< LLVM.extractvalue abcd TypeNum.d0)

@@ -319,7 +319,7 @@ main = do    parsed <-       Parsec.parseFromFile (T.whiteSpace lexer >> parser)-         "/usr/local/llvm-3.1/include/llvm/IntrinsicsX86.td"+         "/usr/local/llvm-3.8/include/llvm/IR/IntrinsicsX86.td"    case parsed of       Left msg -> IO.hPutStrLn IO.stderr $ show msg       Right intrinsics ->