llvm-tf 3.0.3.1 → 3.0.3.1.1
raw patch · 5 files changed
+41/−155 lines, 5 filesdep +fixed-lengthdep ~non-emptydep ~processdep ~transformers
Dependencies added: fixed-length
Dependency ranges changed: non-empty, process, transformers
Files
- llvm-tf.cabal +9/−7
- src/LLVM/Core/CodeGen.hs +1/−1
- src/LLVM/Core/Data.hs +2/−1
- src/LLVM/Core/UnaryVector.hs +16/−133
- src/LLVM/Core/Vector.hs +13/−13
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name: llvm-tf-Version: 3.0.3.1+Version: 3.0.3.1.1 License: BSD3 License-File: LICENSE Synopsis: Bindings to the LLVM compiler toolkit using type families.@@ -20,8 +20,8 @@ That is, a bump from 3.0.0 to 3.0.1 may contain substantial API changes, a bump from 3.0.0.0 to 3.0.0.1 may contain API extensions, and a bump from 3.0.0.0.0 to 3.0.0.0.1 may contain API-preserving bugfixes.-Author: Henning Thieleman, Bryan O'Sullivan, Lennart Augustsson-Maintainer: Henning Thieleman <llvm@henning-thielemann.de>+Author: Henning Thielemann, Bryan O'Sullivan, Lennart Augustsson+Maintainer: Henning Thielemann <llvm@henning-thielemann.de> Stability: experimental Category: Compilers/Interpreters, Code Generation Tested-With: GHC == 7.4.2@@ -37,12 +37,13 @@ Location: http://code.haskell.org/~thielema/llvm-tf/ Source-Repository this- Tag: 3.0.3.1+ Tag: 3.0.3.1.1 Type: darcs Location: http://code.haskell.org/~thielema/llvm-tf/ Flag developer Description: developer mode - warnings let compilation fail+ Manual: True Default: False Flag buildExamples@@ -54,10 +55,11 @@ Build-Depends: llvm-ffi == 3.0.*, tfp >=1.0 && <1.1,- transformers >=0.3 && <0.5,- process >=1.1 && <1.3,+ transformers >=0.3 && <0.6,+ process >=1.1 && <1.5, storable-record >=0.0.2 && <0.1,- non-empty >=0.2 && <0.3,+ fixed-length >=0.2 && <0.3,+ non-empty >=0.2 && <0.4, utility-ht >=0.0.10 && <0.1, containers >=0.4 && <0.6, base >=3 && <5
src/LLVM/Core/CodeGen.hs view
@@ -564,7 +564,7 @@ DecProof.UnaryNat -> map (unConstValue . f) $ Fold.toList- (UnaryVector.Cons xs :: UnaryVector.T u b))+ (UnaryVector.fromFixedList xs :: UnaryVector.T u b)) {- | Make a constant vector.
src/LLVM/Core/Data.hs view
@@ -52,7 +52,8 @@ showParen (p>10) $ showString "Vector " . showList (Fold.toList- (UnaryVector.Cons xs :: UnaryVector.T (Dec.ToUnary n) a))+ (UnaryVector.fromFixedList xs+ :: UnaryVector.T (Dec.ToUnary n) a)) -- |Label type, produced by a basic block. data Label
src/LLVM/Core/UnaryVector.hs view
@@ -1,159 +1,42 @@ {-# LANGUAGE TypeFamilies #-} module LLVM.Core.UnaryVector (- T(Cons), vector, cyclicVector, empty, cons, withEmpty, withHead, with, head,- FixedList, Length, With,+ T, vector, cyclicVector,+ FixedLength.fromFixedList, FixedLength.toFixedList, FixedLength.head,+ FixedList, Length,+ FixedLength.Curried, FixedLength.uncurry, ) where import qualified Type.Data.Num.Unary as Unary -import Control.Applicative (Applicative, pure, liftA2, (<*>))+import qualified Data.FixedLength as FixedLength+import Data.FixedLength (T, List, Length, end, (!:)) -import qualified Data.Traversable as Trav import qualified Data.NonEmpty as NonEmpty-import qualified Data.Empty as Empty-import Data.Traversable (Traversable, foldMapDefault)-import Data.Foldable (Foldable, foldMap) -import Prelude hiding (replicate, map, head, unzip, zipWith)+import Prelude hiding (head) -newtype T n a = Cons (FixedList n a)--type family FixedList n :: * -> *-type instance FixedList Unary.Zero = Empty.T-type instance FixedList (Unary.Succ n) = NonEmpty.T (FixedList n)--type family Length (f :: * -> *)-type instance Length Empty.T = Unary.Zero-type instance Length (NonEmpty.T f) = Unary.Succ (Length f)+type FixedList n = List n -vector ::- (Unary.Natural n, n ~ Length (FixedList n)) =>- FixedList n a -> T n a-vector = Cons+vector :: (Unary.Natural n, n ~ Length (List n)) => List n a -> T n a+vector = FixedLength.fromFixedList -cyclicVector ::- (Unary.Natural n) =>- NonEmpty.T [] a -> T n a+cyclicVector :: (Unary.Natural n) => NonEmpty.T [] a -> T n a cyclicVector xt@(NonEmpty.Cons x xs) = runOp0 $ Unary.switchNat- (Op0 empty)- (Op0 $ cons x $ cyclicVectorAppend xt xs)+ (Op0 end)+ (Op0 $ x !: cyclicVectorAppend xt xs) -cyclicVectorAppend ::- (Unary.Natural n) =>- NonEmpty.T [] a -> [a] -> T n a+cyclicVectorAppend :: (Unary.Natural n) => NonEmpty.T [] a -> [a] -> T n a cyclicVectorAppend ys xt = runOp0 $ Unary.switchNat- (Op0 empty)+ (Op0 end) (Op0 $ case xt of [] -> cyclicVector ys- x:xs -> cons x $ cyclicVectorAppend ys xs)--empty :: T Unary.Zero a-empty = Cons Empty.Cons--cons :: a -> T n a -> T (Unary.Succ n) a-cons x (Cons xs) = Cons $ NonEmpty.Cons x xs---withEmpty :: b -> T Unary.Zero a -> b-withEmpty x (Cons Empty.Cons) = x--withHead ::- (a -> T n a -> b) ->- T (Unary.Succ n) a -> b-withHead f (Cons (NonEmpty.Cons x xs)) = f x (Cons xs)---newtype Head a n = Head {runHead :: T n a -> a}--head :: (Unary.Positive n) => T n a -> a-head =- runHead $- Unary.switchPos- (Head $ \(Cons (NonEmpty.Cons a _)) -> a)---newtype- WithVector a b n =- WithVector {- runWithVector :: WithRec a b n -> T n a -> b- }--type family WithRec a b n-type instance WithRec a b Unary.Zero = b-type instance WithRec a b (Unary.Succ n) = a -> WithRec a b n--type With n a b = WithRec a b n--with :: (Unary.Natural n) => With n a b -> T n a -> b-with =- runWithVector $- Unary.switchNat- (WithVector withEmpty)- (WithVector $ \f v -> withHead (\x -> with (f x)) v)-+ x:xs -> x !: cyclicVectorAppend ys xs) newtype Op0 a n = Op0 {runOp0 :: T n a}--replicate :: (Unary.Natural n) => a -> T n a-replicate a =- runOp0 $- Unary.switchNat- (Op0 empty)- (Op0 $ cons a $ replicate a)---newtype Op1 a b n = Op1 {runOp1 :: T n a -> T n b}--map ::- (Unary.Natural n) =>- (a -> b) -> T n a -> T n b-map f =- runOp1 $- Unary.switchNat- (Op1 $ withEmpty empty)- (Op1 $ withHead $ \a -> cons (f a) . map f)---newtype Op2 a b c n = Op2 {runOp2 :: T n a -> T n b -> T n c}--zipWith ::- (Unary.Natural n) =>- (a -> b -> c) ->- T n a -> T n b -> T n c-zipWith f =- runOp2 $- Unary.switchNat- (Op2 $ const $ withEmpty empty)- (Op2 $ \at bt ->- withHead (\a as ->- withHead (\b bs -> cons (f a b) $ zipWith f as bs) bt) at)---newtype- Sequence f a n =- Sequence {runSequence :: T n (f a) -> f (T n a)}---instance (Unary.Natural n) => Functor (T n) where- fmap = map--instance (Unary.Natural n) => Applicative (T n) where- pure = replicate- f <*> a = zipWith ($) f a--instance (Unary.Natural n) => Foldable (T n) where- foldMap = foldMapDefault--instance (Unary.Natural n) => Traversable (T n) where- sequenceA =- runSequence $- Unary.switchNat- (Sequence $ withEmpty $ pure empty)- (Sequence $ withHead $ \x xs -> liftA2 cons x $ Trav.sequenceA xs)
src/LLVM/Core/Vector.hs view
@@ -35,7 +35,7 @@ import System.IO.Unsafe (unsafePerformIO) -import Prelude hiding (replicate, map, head, unzip, zipWith)+import Prelude hiding (replicate, map, head, unzip, zipWith, uncurry) -- XXX Should these really be here?@@ -48,19 +48,19 @@ instance (IsPrimitive a) => MkVector D2 a where type Tuple D2 a = (a,a) toVector (a1, a2) = vector (a1 !: a2 !: Empty.Cons)- fromVector = with $ \a1 a2 -> (a1, a2)+ fromVector = uncurry $ \a1 a2 -> (a1, a2) instance (IsPrimitive a) => MkVector D4 a where type Tuple D4 a = (a,a,a,a) toVector (a1, a2, a3, a4) = vector (a1 !: a2 !: a3 !: a4 !: Empty.Cons)- fromVector = with $ \a1 a2 a3 a4 -> (a1, a2, a3, a4)+ fromVector = uncurry $ \a1 a2 a3 a4 -> (a1, a2, a3, a4) instance (IsPrimitive a) => MkVector D8 a where type Tuple D8 a = (a,a,a,a,a,a,a,a) toVector (a1, a2, a3, a4, a5, a6, a7, a8) = vector (a1 !: a2 !: a3 !: a4 !: a5 !: a6 !: a7 !: a8 !: Empty.Cons) fromVector =- with $ \a1 a2 a3 a4 a5 a6 a7 a8 ->+ uncurry $ \a1 a2 a3 a4 a5 a6 a7 a8 -> (a1, a2, a3, a4, a5, a6, a7, a8) @@ -73,22 +73,22 @@ unaryFromDecimalVector :: Vector n a -> UnaryVector.T (Dec.ToUnary n) a-unaryFromDecimalVector (Vector xs) = UnaryVector.Cons xs+unaryFromDecimalVector (Vector xs) = UnaryVector.fromFixedList xs decimalFromUnaryVector :: UnaryVector.T (Dec.ToUnary n) a -> Vector n a-decimalFromUnaryVector (UnaryVector.Cons xs) = Vector xs+decimalFromUnaryVector = Vector . UnaryVector.toFixedList -type With n a b = UnaryVector.With (Dec.ToUnary n) a b+type Curried n a b = UnaryVector.Curried (Dec.ToUnary n) a b -with ::+uncurry :: (Dec.Natural n) =>- With n a b -> Vector n a -> b-with f =+ Curried n a b -> Vector n a -> b+uncurry f = withNatDict1 $ \dict v -> case dict of DecProof.UnaryNat ->- UnaryVector.with f $ unaryFromDecimalVector v+ UnaryVector.uncurry f $ unaryFromDecimalVector v withNatDict ::@@ -144,8 +144,8 @@ {- | Make a constant vector. Replicates or truncates the list to get length /n/.-This behaviour is consistent with that of 'LLVM.Core.CodeGen.constCyclicVector'.-May be abused for constructing vectors from lists with statically unknown size.+This behaviour is consistent uncurry that of 'LLVM.Core.CodeGen.constCyclicVector'.+May be abused for constructing vectors from lists uncurry statically unknown size. -} cyclicVector :: (Dec.Positive n) => NonEmpty.T [] a -> Vector n a cyclicVector xs =