llvm 0.6.0.3 → 0.6.2.0

raw patch · 17 files changed

+188/−196 lines, 17 filesdep +type-levelPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: type-level

API changes (from Hackage documentation)

Files

• Data/TypeNumbers.hs +0/−56
• LLVM/Core/CodeGen.hs +8/−8
• LLVM/Core/Data.hs +6/−6
• LLVM/Core/Instructions.hs +18/−21
• LLVM/Core/Type.hs +37/−50
• LLVM/Core/Vector.hs +22/−21
• LLVM/ExecutionEngine.hs +4/−1
• LLVM/ExecutionEngine/Target.hs +57/−0
• LLVM/FFI/ExecutionEngine.hsc +0/−3
• LLVM/FFI/Target.hsc +1/−1
• LLVM/Util/Arithmetic.hs +9/−3
• LLVM/Util/Loop.hs +3/−3
• examples/Arith.hs +2/−2
• examples/DotProd.hs +11/−11
• examples/Makefile +1/−1
• examples/Vector.hs +4/−4
• llvm.cabal +5/−5

@@ -1,56 +0,0 @@--- |Type level decimal numbers.-module Data.TypeNumbers(-           IsTypeNumber, typeNumber,-	   D0(..),D1(..),D2(..),D3(..),D4(..),D5(..),D6(..),D7(..),D8(..),D9(..),-	   End(..)-	   ) where---- |A type level number, i.e., a sequence of type level digits.-class IsTypeNumber ds where-    typeNumber' :: (Num a) => ds -> a -> a---- |Get the numeric value of a type level number.--- This function does not evaluate its argument.-typeNumber :: (IsTypeNumber ds, Num a) => ds -> a-typeNumber ds = typeNumber' ds 0---- |Mark the end of a digit sequence.-data End = End-instance IsTypeNumber End where-     typeNumber' _ a = a---- |The 'D0' - 'D9' types represent type level digits that form--- a number by, e.g, @D1 (D0 (D5 End))@.--- On the value level a slightly more palatable form can be used,--- @D1$D0$D5$End@.-data D0 a = D0 a-data D1 a = D1 a-data D2 a = D2 a-data D3 a = D3 a-data D4 a = D4 a-data D5 a = D5 a-data D6 a = D6 a-data D7 a = D7 a-data D8 a = D8 a-data D9 a = D9 a--instance (IsTypeNumber ds) => IsTypeNumber (D0 ds) where-    typeNumber' ~(D0 ds) acc = typeNumber' ds (10*acc + 0)-instance (IsTypeNumber ds) => IsTypeNumber (D1 ds) where-    typeNumber' ~(D1 ds) acc = typeNumber' ds (10*acc + 1)-instance (IsTypeNumber ds) => IsTypeNumber (D2 ds) where-    typeNumber' ~(D2 ds) acc = typeNumber' ds (10*acc + 2)-instance (IsTypeNumber ds) => IsTypeNumber (D3 ds) where-    typeNumber' ~(D3 ds) acc = typeNumber' ds (10*acc + 3)-instance (IsTypeNumber ds) => IsTypeNumber (D4 ds) where-    typeNumber' ~(D4 ds) acc = typeNumber' ds (10*acc + 4)-instance (IsTypeNumber ds) => IsTypeNumber (D5 ds) where-    typeNumber' ~(D5 ds) acc = typeNumber' ds (10*acc + 5)-instance (IsTypeNumber ds) => IsTypeNumber (D6 ds) where-    typeNumber' ~(D6 ds) acc = typeNumber' ds (10*acc + 6)-instance (IsTypeNumber ds) => IsTypeNumber (D7 ds) where-    typeNumber' ~(D7 ds) acc = typeNumber' ds (10*acc + 7)-instance (IsTypeNumber ds) => IsTypeNumber (D8 ds) where-    typeNumber' ~(D8 ds) acc = typeNumber' ds (10*acc + 8)-instance (IsTypeNumber ds) => IsTypeNumber (D9 ds) where-    typeNumber' ~(D9 ds) acc = typeNumber' ds (10*acc + 9)

@@ -28,7 +28,7 @@ import Control.Monad(liftM, when) import Data.Int import Data.Word-import Data.TypeNumbers+import Data.TypeLevel hiding (Bool, Eq, (+)) import LLVM.Core.CodeGenMonad import qualified LLVM.FFI.Core as FFI import qualified LLVM.Core.Util as U@@ -214,9 +214,9 @@ instance FunctionArgs (IO Float)        (FA Float)        (FA Float)        where apArgs _ _ g = g instance FunctionArgs (IO Double)       (FA Double)       (FA Double)       where apArgs _ _ g = g instance FunctionArgs (IO FP128)        (FA FP128)        (FA FP128)        where apArgs _ _ g = g-instance (IsTypeNumber n) => +instance (Pos n) =>           FunctionArgs (IO (IntN n))     (FA (IntN n))     (FA (IntN n))     where apArgs _ _ g = g-instance (IsTypeNumber n) =>+instance (Pos n) =>          FunctionArgs (IO (WordN n))    (FA (WordN n))    (FA (WordN n))    where apArgs _ _ g = g instance FunctionArgs (IO Bool)         (FA Bool)         (FA Bool)         where apArgs _ _ g = g instance FunctionArgs (IO Int8)         (FA Int8)         (FA Int8)         where apArgs _ _ g = g@@ -228,7 +228,7 @@ instance FunctionArgs (IO Word32)       (FA Word32)       (FA Word32)       where apArgs _ _ g = g instance FunctionArgs (IO Word64)       (FA Word64)       (FA Word64)       where apArgs _ _ g = g instance FunctionArgs (IO ())           (FA ())           (FA ())           where apArgs _ _ g = g-instance (IsTypeNumber n, IsPrimitive a) =>+instance (Pos n, IsPrimitive a) =>          FunctionArgs (IO (Vector n a)) (FA (Vector n a)) (FA (Vector n a)) where apArgs _ _ g = g instance (IsType a) =>           FunctionArgs (IO (Ptr a))      (FA (Ptr a))      (FA (Ptr a))      where apArgs _ _ g = g@@ -381,11 +381,11 @@ --------------------------------------  -- |Make a constant vector.  Replicates or truncates the list to get length /n/.-constVector :: forall a n . (IsTypeNumber n) => [ConstValue a] -> ConstValue (Vector n a)+constVector :: forall a n . (Pos n) => [ConstValue a] -> ConstValue (Vector n a) constVector xs =-    ConstValue $ U.constVector (typeNumber (undefined :: n)) [ v | ConstValue v <- xs ]+    ConstValue $ U.constVector (toNum (undefined :: n)) [ v | ConstValue v <- xs ]  -- |Make a constant array.  Replicates or truncates the list to get length /n/.-constArray :: forall a n . (IsSized a, IsTypeNumber n) => [ConstValue a] -> ConstValue (Array n a)+constArray :: forall a n s . (IsSized a s, Nat n) => [ConstValue a] -> ConstValue (Array n a) constArray xs =-    ConstValue $ U.constArray (typeRef (undefined :: Array n a)) (typeNumber (undefined :: n)) [ v | ConstValue v <- xs ]+    ConstValue $ U.constArray (typeRef (undefined :: Array n a)) (toNum (undefined :: n)) [ v | ConstValue v <- xs ]

@@ -1,7 +1,7 @@ module LLVM.Core.Data(IntN(..), WordN(..), FP128(..),        		      Array(..), Vector(..), Ptr) where import Foreign.Ptr(Ptr)-import Data.TypeNumbers+import Data.TypeLevel  -- TODO: -- Make instances IntN, WordN to actually do the right thing.@@ -9,13 +9,13 @@ -- Make Array functions.  -- |Variable sized signed integer.--- The /n/ parameter should belong to @IsTypeNumber@.-newtype (IsTypeNumber n) => IntN n = IntN Integer+-- The /n/ parameter should belong to @PosI@.+newtype (Pos n) => IntN n = IntN Integer     deriving (Show)  -- |Variable sized unsigned integer.--- The /n/ parameter should belong to @IsTypeNumber@.-newtype (IsTypeNumber n) => WordN n = WordN Integer+-- The /n/ parameter should belong to @PosI@.+newtype (Pos n) => WordN n = WordN Integer     deriving (Show)  -- |128 bit floating point.@@ -23,7 +23,7 @@     deriving (Show)  -- |Fixed sized arrays, the array size is encoded in the /n/ parameter.-newtype (IsTypeNumber n) => Array n a = Array [a]+newtype (Nat n) => Array n a = Array [a]     deriving (Show)  -- |Fixed sized vector, the array size is encoded in the /n/ parameter.

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, ScopedTypeVariables, OverlappingInstances, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, ScopedTypeVariables, OverlappingInstances, FlexibleContexts, TypeOperators #-} module LLVM.Core.Instructions(     -- * Terminator instructions     ret,@@ -53,7 +53,7 @@ import Data.Int import Data.Word import Foreign.C(CInt)---import Data.TypeNumbers+import Data.TypeLevel((:<:), (:>:), (:==:)) import qualified LLVM.FFI.Core as FFI import LLVM.Core.Data import LLVM.Core.Type@@ -268,29 +268,29 @@  -- XXX should allows constants --- XXX size a > size b not enforced -- | Truncate a value to a shorter bit width.-trunc :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)+trunc :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb)+      => Value a -> CodeGenFunction r (Value b) trunc = convert FFI.buildTrunc --- XXX size a < size b not enforced -- | Zero extend a value to a wider width.-zext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)+zext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb)+     => Value a -> CodeGenFunction r (Value b) zext = convert FFI.buildZExt --- XXX size a < size b not enforced -- | Sign extend a value to wider width.-sext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)+sext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb)+     => Value a -> CodeGenFunction r (Value b) sext = convert FFI.buildSExt --- XXX size a > size b not enforced -- | Truncate a floating point value.-fptrunc :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)+fptrunc :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb)+        => Value a -> CodeGenFunction r (Value b) fptrunc = convert FFI.buildFPTrunc --- XXX size a < size b not enforced -- | Extend a floating point value.-fpext :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)+fpext :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb)+      => Value a -> CodeGenFunction r (Value b) fpext = convert FFI.buildFPExt  -- XXX The fp<->i conversion can handle vectors.@@ -318,9 +318,9 @@ inttoptr :: (IsInteger a, IsType b) => Value (Ptr a) -> CodeGenFunction r (Value (Ptr b)) inttoptr = convert FFI.buildIntToPtr --- XXX a and b must use the same space, and there are also pointer restrictions -- | Convert between to values of the same size by just copying the bit pattern.-bitcast :: (IsFirstClass a, IsFirstClass b) => Value a -> CodeGenFunction r (Value b)+bitcast :: (IsFirstClass a, IsFirstClass b, IsSized a sa, IsSized b sb, sa :==: sb)+        => Value a -> CodeGenFunction r (Value b) bitcast = convert FFI.buildBitCast  type FFIConvert = FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef -> U.CString -> IO FFI.ValueRef@@ -399,13 +399,11 @@ instance CmpRet Int64 Bool instance CmpRet (Vector n a) (Vector n Bool) --- XXX Vector -- | Compare integers. icmp :: (IsInteger c, CmpOp a b c d, CmpRet c d) =>         IntPredicate -> a -> b -> CodeGenFunction r (Value d) icmp p = cmpop (flip FFI.buildICmp (fromIntPredicate p)) --- XXX Vector -- | Compare floating point values. fcmp :: (IsFloating c, CmpOp a b c d, CmpRet c d) =>         FPPredicate -> a -> b -> CodeGenFunction r (Value d)@@ -413,7 +411,6 @@  -------------------------------------- --- XXX can handle vectors, needs bool vector args -- XXX could do const song and dance -- | Select between two values depending on a boolean. select :: (IsFirstClass a, CmpRet a b) => Value b -> Value a -> Value a -> CodeGenFunction r (Value a)@@ -497,7 +494,7 @@  -- XXX What's the type returned by malloc -- | Allocate heap memory.-malloc :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))+malloc :: forall a r s . (IsSized a s) => CodeGenFunction r (Value (Ptr a)) malloc =     liftM Value $     withCurrentBuilder $ \ bldPtr ->@@ -505,7 +502,7 @@  -- XXX What's the type returned by arrayMalloc? -- | Allocate heap (array) memory.-arrayMalloc :: forall a r s . (IsSized a, AllocArg s) =>+arrayMalloc :: forall a n r s . (IsSized a n, AllocArg s) =>                s -> CodeGenFunction r (Value (Ptr a)) -- XXX arrayMalloc s =     liftM Value $@@ -515,7 +512,7 @@  -- XXX What's the type returned by malloc -- | Allocate stack memory.-alloca :: forall a r . (IsSized a) => CodeGenFunction r (Value (Ptr a))+alloca :: forall a r s . (IsSized a s) => CodeGenFunction r (Value (Ptr a)) alloca =     liftM Value $     withCurrentBuilder $ \ bldPtr ->@@ -523,7 +520,7 @@  -- XXX What's the type returned by arrayAlloca? -- | Allocate stack (array) memory.-arrayAlloca :: forall a r s . (IsSized a, AllocArg s) =>+arrayAlloca :: forall a n r s . (IsSized a n, AllocArg s) =>                s -> CodeGenFunction r (Value (Ptr a)) arrayAlloca s =     liftM Value $

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, FlexibleInstances, IncoherentInstances #-}+{-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, IncoherentInstances #-} -- |The LLVM type system is captured with a number of Haskell type classes. -- In general, an LLVM type @T@ is represented as @Value T@, where @T@ is some Haskell type. -- The various types @T@ are classified by various type classes, e.g., 'IsFirstClass' for@@ -27,27 +27,14 @@ import Data.List(intercalate) import Data.Int import Data.Word-import Data.TypeNumbers+import Data.TypeLevel hiding (Bool, Eq) import LLVM.Core.Util(functionType) import LLVM.Core.Data import qualified LLVM.FFI.Core as FFI --- XXX--- IsSized should have two parameters, the second being the size and computed from the first- -- Usage: vector precondition--- XXX This could defined inductively, but this is good enough for LLVM-class (IsTypeNumber n) => IsPowerOf2 n-instance IsPowerOf2 (D1 End)-instance IsPowerOf2 (D2 End)-instance IsPowerOf2 (D4 End)-instance IsPowerOf2 (D8 End)-instance IsPowerOf2 (D1 (D6 End))-instance IsPowerOf2 (D3 (D2 End))-instance IsPowerOf2 (D6 (D4 End))-instance IsPowerOf2 (D1 (D2 (D8 End)))-instance IsPowerOf2 (D2 (D5 (D6 End)))-instance IsPowerOf2 (D5 (D1 (D2 End)))+class (Pos n) => IsPowerOf2 n+instance (LogBaseF D2 n l True, Pos n) => IsPowerOf2 n  -- TODO: -- Move IntN, WordN to a special module that implements those types@@ -141,7 +128,7 @@ --  Context for Array being a type --  thus, allocation instructions -- |Types with a fixed size.-class (IsType a) => IsSized a+class (IsType a, Pos s) => IsSized a s | a -> s  -- |Function type. class (IsType a) => IsFunction a where@@ -159,11 +146,11 @@ instance IsType ()     where typeDesc _ = TDVoid  -- Variable size integer types-instance (IsTypeNumber n) => IsType (IntN n)-    where typeDesc _ = TDInt True  (typeNumber (undefined :: n))+instance (Pos n) => IsType (IntN n)+    where typeDesc _ = TDInt True  (toNum (undefined :: n)) -instance (IsTypeNumber n) => IsType (WordN n)-    where typeDesc _ = TDInt False (typeNumber (undefined :: n))+instance (Pos n) => IsType (WordN n)+    where typeDesc _ = TDInt False (toNum (undefined :: n))  -- Fixed size integer types. instance IsType Bool   where typeDesc _ = TDInt False  1@@ -177,11 +164,11 @@ instance IsType Int64  where typeDesc _ = TDInt True  64  -- Sequence types-instance (IsTypeNumber n, IsSized a) => IsType (Array n a)-    where typeDesc _ = TDArray (typeNumber (undefined :: n))+instance (Nat n, IsSized a s) => IsType (Array n a)+    where typeDesc _ = TDArray (toNum (undefined :: n))     	  	               (typeDesc (undefined :: a)) instance (IsPowerOf2 n, IsPrimitive a) => IsType (Vector n a)-    where typeDesc _ = TDVector (typeNumber (undefined :: n))+    where typeDesc _ = TDVector (toNum (undefined :: n))     	  	       		(typeDesc (undefined :: a))  -- Pointer type.@@ -200,8 +187,8 @@ instance IsArithmetic Float instance IsArithmetic Double instance IsArithmetic FP128-instance (IsTypeNumber n) => IsArithmetic (IntN n)-instance (IsTypeNumber n) => IsArithmetic (WordN n)+instance (Pos n) => IsArithmetic (IntN n)+instance (Pos n) => IsArithmetic (WordN n) instance IsArithmetic Bool instance IsArithmetic Int8 instance IsArithmetic Int16@@ -218,8 +205,8 @@ instance IsFloating FP128 instance (IsPowerOf2 n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a) -instance (IsTypeNumber n) => IsInteger (IntN n)-instance (IsTypeNumber n) => IsInteger (WordN n)+instance (Pos n) => IsInteger (IntN n)+instance (Pos n) => IsInteger (WordN n) instance IsInteger Bool instance IsInteger Int8 instance IsInteger Int16@@ -234,8 +221,8 @@ instance IsFirstClass Float instance IsFirstClass Double instance IsFirstClass FP128-instance (IsTypeNumber n) => IsFirstClass (IntN n)-instance (IsTypeNumber n) => IsFirstClass (WordN n)+instance (Pos n) => IsFirstClass (IntN n)+instance (Pos n) => IsFirstClass (WordN n) instance IsFirstClass Bool instance IsFirstClass Int8 instance IsFirstClass Int16@@ -249,29 +236,29 @@ instance (IsType a) => IsFirstClass (Ptr a) instance IsFirstClass () -- XXX This isn't right, but () can be returned -instance IsSized Float-instance IsSized Double-instance IsSized FP128-instance (IsTypeNumber n) => IsSized (IntN n)-instance (IsTypeNumber n) => IsSized (WordN n)-instance IsSized Bool-instance IsSized Int8-instance IsSized Int16-instance IsSized Int32-instance IsSized Int64-instance IsSized Word8-instance IsSized Word16-instance IsSized Word32-instance IsSized Word64-instance (IsTypeNumber n, IsSized a) => IsSized (Array n a)-instance (IsPowerOf2 n, IsPrimitive a) => IsSized (Vector n a)-instance (IsType a) => IsSized (Ptr a)+instance IsSized Float D32+instance IsSized Double D64+instance IsSized FP128 D128+instance (Pos n) => IsSized (IntN n) n+instance (Pos n) => IsSized (WordN n) n+instance IsSized Bool D1+instance IsSized Int8 D8+instance IsSized Int16 D16+instance IsSized Int32 D32+instance IsSized Int64 D64+instance IsSized Word8 D8+instance IsSized Word16 D16+instance IsSized Word32 D32+instance IsSized Word64 D64+instance (Nat n, IsSized a s, Mul n s ns, Pos ns) => IsSized (Array n a) ns+instance (IsPowerOf2 n, IsPrimitive a, IsSized a s, Mul n s ns, Pos ns) => IsSized (Vector n a) ns+instance (IsType a, Pos s) => IsSized (Ptr a) s  -- XXX  instance IsPrimitive Float instance IsPrimitive Double instance IsPrimitive FP128-instance (IsTypeNumber n) => IsPrimitive (IntN n)-instance (IsTypeNumber n) => IsPrimitive (WordN n)+instance (Pos n) => IsPrimitive (IntN n)+instance (Pos n) => IsPrimitive (WordN n) instance IsPrimitive Bool instance IsPrimitive Int8 instance IsPrimitive Int16

@@ -2,11 +2,12 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, ScopedTypeVariables #-} module LLVM.Core.Vector(MkVector(..)) where import Data.Function-import Data.TypeNumbers+import Data.TypeLevel hiding (Eq, (+), (==), (-), (*), succ, pred, div, mod, divMod, logBase) import LLVM.Core.Type import LLVM.Core.Data import LLVM.Core.CodeGen(IsConst(..), ConstValue(..)) import LLVM.FFI.Core(constVector)+import LLVM.ExecutionEngine.Target import Foreign.Ptr(Ptr, castPtr) import Foreign.Storable(Storable(..)) import Foreign.Marshal.Array(peekArray, pokeArray, withArrayLen)@@ -18,29 +19,29 @@     fromVector :: Vector n a -> va  {--instance (IsPrimitive a) => MkVector (Value a) (D1 End) (Value a) where+instance (IsPrimitive a) => MkVector (Value a) D1 (Value a) where     toVector a = Vector [a] -} -instance (IsPrimitive a) => MkVector (a, a) (D2 End) a where+instance (IsPrimitive a) => MkVector (a, a) D2 a where     toVector (a1, a2) = Vector [a1, a2]     fromVector (Vector [a1, a2]) = (a1, a2)     fromVector _ = error "fromVector: impossible" -instance (IsPrimitive a) => MkVector (a, a, a, a) (D4 End) a where+instance (IsPrimitive a) => MkVector (a, a, a, a) D4 a where     toVector (a1, a2, a3, a4) = Vector [a1, a2, a3, a4]     fromVector (Vector [a1, a2, a3, a4]) = (a1, a2, a3, a4)     fromVector _ = error "fromVector: impossible" -instance (IsPrimitive a) => MkVector (a, a, a, a, a, a, a, a) (D8 End) a where+instance (IsPrimitive a) => MkVector (a, a, a, a, a, a, a, a) D8 a where     toVector (a1, a2, a3, a4, a5, a6, a7, a8) = Vector [a1, a2, a3, a4, a5, a6, a7, a8]     fromVector (Vector [a1, a2, a3, a4, a5, a6, a7, a8]) = (a1, a2, a3, a4, a5, a6, a7, a8)     fromVector _ = error "fromVector: impossible" -instance (Storable a, IsTypeNumber n) => Storable (Vector n a) where-    sizeOf _ = sizeOf (undefined :: a) * typeNumber (undefined :: n)-    alignment _ = alignment (undefined :: a) * typeNumber (undefined :: n)-    peek p = fmap Vector $ peekArray (typeNumber (undefined :: n)) (castPtr p :: Ptr a)+instance (Storable a, IsPowerOf2 n, IsPrimitive a) => Storable (Vector n a) where+    sizeOf a = storeSizeOfType ourTargetData (typeRef a)+    alignment a = aBIAlignmentOfType ourTargetData (typeRef a)+    peek p = fmap Vector $ peekArray (toNum (undefined :: n)) (castPtr p :: Ptr a)     poke p (Vector vs) = pokeArray (castPtr p :: Ptr a) vs  instance (IsPowerOf2 n, IsPrimitive a, IsConst a) => IsConst (Vector n a) where@@ -66,25 +67,25 @@ instance (Ord a) => Ord (Vector n a) where     compare = compare `on` unVector -instance (Num a, IsTypeNumber n) => Num (Vector n a) where+instance (Num a, Pos n) => Num (Vector n a) where     (+) = binop (+)     (-) = binop (-)     (*) = binop (*)     negate = unop negate     abs = unop abs     signum = unop signum-    fromInteger = Vector . replicate (typeNumber (undefined :: n)) . fromInteger+    fromInteger = Vector . replicate (toNum (undefined :: n)) . fromInteger -instance (Enum a, IsTypeNumber n) => Enum (Vector n a) where+instance (Enum a, Pos n) => Enum (Vector n a) where     succ = unop succ     pred = unop pred     fromEnum = error "Vector fromEnum"-    toEnum = Vector . map toEnum . replicate (typeNumber (undefined :: n))+    toEnum = Vector . map toEnum . replicate (toNum (undefined :: n)) -instance (Real a, IsTypeNumber n) => Real (Vector n a) where+instance (Real a, Pos n) => Real (Vector n a) where     toRational = error "Vector toRational" -instance (Integral a, IsTypeNumber n) => Integral (Vector n a) where+instance (Integral a, Pos n) => Integral (Vector n a) where     quot = binop quot     rem  = binop rem     div  = binop div@@ -93,15 +94,15 @@     divMod  (Vector xs) (Vector ys) = (Vector qs, Vector rs) where (qs, rs) = unzip $ zipWith divMod  xs ys     toInteger = error "Vector toInteger" -instance (Fractional a, IsTypeNumber n) => Fractional (Vector n a) where+instance (Fractional a, Pos n) => Fractional (Vector n a) where     (/) = binop (/)-    fromRational = Vector . replicate (typeNumber (undefined :: n)) . fromRational+    fromRational = Vector . replicate (toNum (undefined :: n)) . fromRational -instance (RealFrac a, IsTypeNumber n) => RealFrac (Vector n a) where+instance (RealFrac a, Pos n) => RealFrac (Vector n a) where     properFraction = error "Vector properFraction" -instance (Floating a, IsTypeNumber n) => Floating (Vector n a) where-    pi = Vector $ replicate (typeNumber (undefined :: n)) pi+instance (Floating a, Pos n) => Floating (Vector n a) where+    pi = Vector $ replicate (toNum (undefined :: n)) pi     sqrt = unop sqrt     log = unop log     logBase = binop logBase@@ -120,7 +121,7 @@     acosh = unop acosh     atanh = unop atanh -instance (RealFloat a, IsTypeNumber n) => RealFloat (Vector n a) where+instance (RealFloat a, Pos n) => RealFloat (Vector n a) where     floatRadix = floatRadix . head . unVector     floatDigits = floatDigits . head . unVector     floatRange = floatRange . head . unVector

@@ -21,7 +21,9 @@     unsafePurify,     -- * Simplified interface.     simpleFunction,-    unsafeGenerateFunction+    unsafeGenerateFunction,+    -- * Target information+    module LLVM.ExecutionEngine.Target     ) where import System.IO.Unsafe (unsafePerformIO) @@ -29,6 +31,7 @@ import LLVM.FFI.Core(ValueRef) import LLVM.Core.CodeGen(Value(..)) import LLVM.Core+import LLVM.ExecutionEngine.Target --import LLVM.Core.Util(runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager)  -- |Class of LLVM function types that can be translated to the corresponding

@@ -0,0 +1,57 @@+module LLVM.ExecutionEngine.Target(TargetData(..), ourTargetData, targetDataFromString) where+--import Data.Word+import Foreign.C.String+import System.IO.Unsafe(unsafePerformIO)++--import LLVM.Core+import LLVM.ExecutionEngine.Engine(runEngineAccess, getExecutionEngineTargetData)++import qualified LLVM.FFI.Core as FFI+import qualified LLVM.FFI.Target as FFI++type Type = FFI.TypeRef++data TargetData = TargetData {+    aBIAlignmentOfType         :: Type -> Int,+    aBISizeOfType              :: Type -> Int,+    littleEndian               :: Bool,+    callFrameAlignmentOfType   :: Type -> Int,+--  elementAtOffset            :: Type -> Word64 -> Int,+    intPtrType                 :: Type,+--  offsetOfElements           :: Int -> Word64,+    pointerSize                :: Int,+--  preferredAlignmentOfGlobal :: Value a -> Int,+    preferredAlignmentOfType   :: Type -> Int,+    sizeOfTypeInBits           :: Type -> Int,+    storeSizeOfType            :: Type -> Int+    }++un :: IO a -> a+un = unsafePerformIO++-- Gets the target data for the JIT target.+-- This is really constant, so unsafePerformIO is safe.+ourEngineTargetDataRef :: FFI.TargetDataRef+ourEngineTargetDataRef = un $+    runEngineAccess getExecutionEngineTargetData++-- Normally the TargetDataRef never changes, so the operation+-- are really pure functions.+makeTargetData :: FFI.TargetDataRef -> TargetData+makeTargetData r = TargetData {+    aBIAlignmentOfType       = fromIntegral . un . FFI.aBIAlignmentOfType r,+    aBISizeOfType            = fromIntegral . un . FFI.aBISizeOfType r,+    littleEndian             = un (FFI.byteOrder r) /= 0,+    callFrameAlignmentOfType = fromIntegral . un . FFI.callFrameAlignmentOfType r,+    intPtrType               = un $ FFI.intPtrType r,+    pointerSize              = fromIntegral $ un $ FFI.pointerSize r,+    preferredAlignmentOfType = fromIntegral . un . FFI.preferredAlignmentOfType r,+    sizeOfTypeInBits         = fromIntegral . un . FFI.sizeOfTypeInBits r,+    storeSizeOfType          = fromIntegral . un . FFI.storeSizeOfType r+    }++ourTargetData :: TargetData+ourTargetData = makeTargetData ourEngineTargetDataRef++targetDataFromString :: String -> TargetData+targetDataFromString s = makeTargetData $ un $ withCString s FFI.createTargetData

@@ -38,9 +38,6 @@ import Foreign.C.String (CString) import Foreign.C.Types (CDouble, CInt, CUInt, CULLong) import Foreign.Ptr (Ptr, FunPtr)-#if HAS_GETPOINTERTOGLOBAL-import Foreign.Ptr (FunPtr)-#endif  import LLVM.FFI.Core (ModuleRef, ModuleProviderRef, TypeRef, ValueRef) import LLVM.FFI.Target(TargetDataRef)

@@ -8,7 +8,7 @@ import LLVM.FFI.Core  -- enum { LLVMBigEndian, LLVMLittleEndian };-type ByteOrdering = CInt;+type ByteOrdering = CInt  data TargetData type TargetDataRef = Ptr TargetData

@@ -2,7 +2,7 @@ {-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, FlexibleContexts, UndecidableInstances, TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies, OverlappingInstances #-} module LLVM.Util.Arithmetic(     TValue,-    Cmp,+    Cmp(..),     (%==), (%/=), (%<), (%<=), (%>), (%>=),     (%&&), (%||),     (?), (??),@@ -12,7 +12,7 @@     recursiveFunction,     CallIntrinsic,     ) where-import Data.TypeNumbers+import Data.TypeLevel hiding (Bool, Eq, (+),(-),(*)) import Data.Word import Data.Int import LLVM.Core@@ -36,6 +36,7 @@ instance Cmp Float Bool where cmp = fcmp . adjFloat instance Cmp Double Bool where cmp = fcmp . adjFloat instance Cmp FP128 Bool where cmp = fcmp . adjFloat+{- instance (IsPowerOf2 n) => Cmp (Vector n Bool) (Vector n Bool) where cmp = icmp instance (IsPowerOf2 n) => Cmp (Vector n Word8) (Vector n Bool) where cmp = icmp instance (IsPowerOf2 n) => Cmp (Vector n Word16) (Vector n Bool) where cmp = icmp@@ -48,6 +49,11 @@ instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where cmp = fcmp . adjFloat instance (IsPowerOf2 n) => Cmp (Vector n Double) (Vector n Bool) where cmp = fcmp . adjFloat instance (IsPowerOf2 n) => Cmp (Vector n FP128) (Vector n Bool) where cmp = fcmp . adjFloat+-}+instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where+    cmp op = mapVector2 (fcmp (adjFloat op))+instance (IsPowerOf2 n) => Cmp (Vector n Word32) (Vector n Bool) where+    cmp op = mapVector2 (cmp op)  adjSigned :: IntPredicate -> IntPredicate adjSigned IntUGT = IntSGT@@ -303,7 +309,7 @@ callIntrinsic2 s x y = do x' <- x; y' <- y; callIntrinsic2' s x' y'  #if defined(__MACOS__)-instance CallIntrinsic (Vector (D4 End) Float) where+instance CallIntrinsic (Vector D4 Float) where     callIntrinsic1' s x | hasVFun   = do op <- externFunction ("v" ++ s ++ "f")     		      	  	         r <- call op x 					 addAttributes r 0 [ReadNoneAttribute]

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeOperators, FlexibleContexts #-} module LLVM.Util.Loop(Phi, forLoop, mapVector, mapVector2) where-import Data.TypeNumbers+import Data.TypeLevel hiding (Bool) import LLVM.Core  class Phi a where@@ -92,7 +92,7 @@              (Value a -> CodeGenFunction r (Value b)) ->              Value (Vector n a) -> CodeGenFunction r (Value (Vector n b)) mapVector f v =-    forLoop (valueOf 0) (valueOf (typeNumber (undefined :: n))) (value undef) $ \ i w -> do+    forLoop (valueOf 0) (valueOf (toNum (undefined :: n))) (value undef) $ \ i w -> do         x <- extractelement v i         y <- f x         insertelement w y i@@ -102,7 +102,7 @@              (Value a -> Value b -> CodeGenFunction r (Value c)) ->              Value (Vector n a) -> Value (Vector n b) -> CodeGenFunction r (Value (Vector n c)) mapVector2 f v1 v2 =-    forLoop (valueOf 0) (valueOf (typeNumber (undefined :: n))) (value undef) $ \ i w -> do+    forLoop (valueOf 0) (valueOf (toNum (undefined :: n))) (value undef) $ \ i w -> do         x <- extractelement v1 i         y <- extractelement v2 i         z <- f x y

@@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Arith where import Data.Int-import Data.TypeNumbers+import Data.TypeLevel(D4) import LLVM.Core import LLVM.ExecutionEngine import LLVM.Util.Arithmetic@@ -28,7 +28,7 @@ mFib :: CodeGenModule (Function (Int32 -> IO Int32)) mFib = recursiveFunction $ \ rfib n -> n %< 2 ? (1, rfib (n-1) + rfib (n-2)) -type V = Vector (D4 End) Float+type V = Vector D4 Float  mVFun :: CodeGenModule (Function (Ptr V -> Ptr V -> IO ())) mVFun = do

@@ -1,13 +1,13 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} module DotProd where import Data.Word-import Data.TypeNumbers+import Data.TypeLevel.Num(D2, D4, D8, toNum) import LLVM.Core import LLVM.ExecutionEngine import LLVM.Util.Loop import LLVM.Util.Foreign -mDotProd :: forall n a . (IsPowerOf2 n, IsTypeNumber n,+mDotProd :: forall n a . (IsPowerOf2 n, 	                  IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a, 	                  FunctionRet a 	                 ) =>@@ -23,14 +23,14 @@         ab <- mul a b                    -- multiply them         add s ab                         -- accumulate sum -    r <- forLoop (valueOf (0::Word32)) (valueOf (typeNumber (undefined :: n)))-                 (valueOf 0) $ \ i r -> do-        ri <- extractelement s i-        add r ri+    r <- forLoop (valueOf (0::Word32)) (valueOf (toNum (undefined :: n)))+              (valueOf 0) $ \ i r -> do+              ri <- extractelement s i+              add r ri     ret (r :: Value a)  type R = Float-type T = Vector (D4 End) R+type T = Vector D4 R  main :: IO () main = do@@ -61,22 +61,22 @@     vectorize :: a -> [a] -> [Vector n a]  {--instance (IsPrimitive a) => Vectorize (D1 End) a where+instance (IsPrimitive a) => Vectorize D1 a where     vectorize _ [] = []     vectorize x (x1:xs) = toVector x1 : vectorize x xs -} -instance (IsPrimitive a) => Vectorize (D2 End) a where+instance (IsPrimitive a) => Vectorize D2 a where     vectorize _ [] = []     vectorize x (x1:x2:xs) = toVector (x1, x2) : vectorize x xs     vectorize x xs = vectorize x $ xs ++ [x] -instance (IsPrimitive a) => Vectorize (D4 End) a where+instance (IsPrimitive a) => Vectorize D4 a where     vectorize _ [] = []     vectorize x (x1:x2:x3:x4:xs) = toVector (x1, x2, x3, x4) : vectorize x xs     vectorize x xs = vectorize x $ xs ++ [x] -instance (IsPrimitive a) => Vectorize (D8 End) a where+instance (IsPrimitive a) => Vectorize D8 a where     vectorize _ [] = []     vectorize x (x1:x2:x3:x4:x5:x6:x7:x8:xs) = toVector (x1, x2, x3, x4, x5, x6, x7, x8) : vectorize x xs     vectorize x xs = vectorize x $ xs ++ [x]

@@ -1,7 +1,7 @@ ghc := ghc ghcflags := -Wall -optl -w # -DHAS_GETPOINTERTOGLOBAL=1-examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith+examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align  all: $(examples) 

@@ -1,8 +1,8 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, TypeOperators #-} module Vector where import System.Process(system) import Control.Monad-import Data.TypeNumbers+import Data.TypeLevel.Num(D16, toNum) import Data.Word  import LLVM.Core@@ -15,7 +15,7 @@ type T = Float  -- Number of vector elements.-type N = D1 (D6 End)+type N = D16  cgvec :: CodeGenModule (Function (T -> IO T)) cgvec = do@@ -32,7 +32,7 @@     f <- createNamedFunction ExternalLinkage "vectest" $ \ x -> do          let v = value (zero :: ConstValue (Vector N T))-	    n = typeNumber (undefined :: N) :: Word32+	    n = toNum (undefined :: N) :: Word32          -- Fill the vector with x, x+1, x+2, ...         (_, v1) <- forLoop (valueOf 0) (valueOf n) (x, v) $ \ i (x1, v1) -> do

@@ -1,5 +1,5 @@ name: llvm-version: 0.6.0.3+version: 0.6.2.0 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit@@ -52,13 +52,13 @@ library   if flag(bytestring-in-base)     -- bytestring was in base-2.0 and 2.1.1-    build-depends: base >= 2.0 && < 2.2+    build-depends: base >= 2.0 && < 2.2, type-level     cpp-options:   -DBYTESTRING_IN_BASE   else-    build-depends: base < 2.0 || >= 2.2, bytestring >= 0.9, mtl, directory, process+    build-depends: base < 2.0 || >= 2.2, bytestring >= 0.9, mtl, directory, process, type-level    ghc-options: -Wall-  --cpp-options: -DHAS_GETPOINTERTOGLOBAL=1+  cpp-options: -DHAS_GETPOINTERTOGLOBAL=1    if os(darwin)     ld-options: -w /System/Library/Frameworks/vecLib.framework/Versions/A/vecLib@@ -66,7 +66,6 @@     exposed-modules:-      Data.TypeNumbers       LLVM.Core       LLVM.ExecutionEngine       LLVM.FFI.Analysis@@ -90,3 +89,4 @@       LLVM.Core.Util       LLVM.Core.Vector       LLVM.ExecutionEngine.Engine+      LLVM.ExecutionEngine.Target