knead 0.4 → 0.4.1
raw patch · 10 files changed
+312/−181 lines, 10 filesdep +prelude-compatdep +storable-enumdep +tagged
Dependencies added: prelude-compat, storable-enum, tagged
Files
- knead.cabal +6/−2
- src/Data/Array/Knead/Code.hs +3/−0
- src/Data/Array/Knead/Expression.hs +5/−0
- src/Data/Array/Knead/Parameter.hs +3/−0
- src/Data/Array/Knead/Parameterized/Private.hs +3/−1
- src/Data/Array/Knead/Parameterized/Render.hs +4/−0
- src/Data/Array/Knead/Shape.hs +50/−177
- src/Data/Array/Knead/Shape/Orphan.hs +233/−0
- src/Data/Array/Knead/Simple/Physical.hs +2/−1
- src/Data/Array/Knead/Simple/PhysicalPrivate.hs +3/−0
knead.cabal view
@@ -1,5 +1,5 @@ Name: knead-Version: 0.4+Version: 0.4.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -49,7 +49,7 @@ Build-Type: Simple Source-Repository this- Tag: 0.4+ Tag: 0.4.1 Type: darcs Location: http://hub.darcs.net/thielema/knead/ @@ -65,9 +65,12 @@ comfort-array >=0.3 && <0.5, storable-tuple >=0.0 && <0.1, storable-record >=0.0.3 && <0.1,+ storable-enum >=0.0 && <0.1, bool8 >=0.0 && <0.1, transformers >=0.3 && <0.6,+ tagged >=0.7 && <0.9, utility-ht >=0.0.1 && <0.1,+ prelude-compat >=0.0 && <0.0.1, base >=4 && <5 GHC-Options: -Wall@@ -76,6 +79,7 @@ Data.Array.Knead.Shape Data.Array.Knead.Shape.Cubic Data.Array.Knead.Shape.Cubic.Int+ Data.Array.Knead.Shape.Orphan Data.Array.Knead.Expression Data.Array.Knead.Expression.Vector Data.Array.Knead.Parameter
src/Data/Array/Knead/Code.hs view
@@ -16,6 +16,9 @@ import Data.Functor.Compose (Compose(Compose)) +import Prelude2010+import Prelude ()+ getElementPtr :: (Shape.C sh, Shape.Index sh ~ ix) =>
src/Data/Array/Knead/Expression.hs view
@@ -383,6 +383,11 @@ floatFromBool8 = liftM MultiValue.floatFromBool8 +minBound, maxBound :: (MultiValue.Bounded a) => Exp a+minBound = lift0 MultiValue.minBound+maxBound = lift0 MultiValue.maxBound++ cmp :: (MultiValue.Comparison a) => LLVM.CmpPredicate -> Exp a -> Exp a -> Exp Bool
src/Data/Array/Knead/Parameter.hs view
@@ -19,6 +19,9 @@ import Data.Tuple.HT (mapFst, ) import Data.Word (Word32, ) +import Prelude2010+import Prelude ()+ {- | This data type is for parameters of parameterized signal generators and causal processes.
src/Data/Array/Knead/Parameterized/Private.hs view
@@ -16,7 +16,9 @@ import Control.Applicative (Applicative (pure, (<*>)), ) -import Prelude hiding (id, map, zipWith, replicate, )+import Prelude2010 hiding (id, map, zipWith, replicate)+import Prelude ()+ -- in principle we could define Array in terms of Hull and Core.Array
src/Data/Array/Knead/Parameterized/Render.hs view
@@ -38,6 +38,10 @@ import Data.Tuple.HT (fst3, snd3, thd3, ) +import Prelude2010+import Prelude ()++ class C f where type Plain f
src/Data/Array/Knead/Shape.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-} module Data.Array.Knead.Shape ( C(..), Index, Size,@@ -15,6 +15,7 @@ Range(Range), range, rangeFrom, rangeTo, Shifted(Shifted), shifted, shiftedOffset, shiftedSize,+ Enumeration(Enumeration), EnumBounded(..), Scalar(..), Sequence(..),@@ -22,35 +23,44 @@ import qualified Data.Array.Knead.Expression as Expr import qualified Data.Array.Knead.Parameter as Param+import Data.Array.Knead.Shape.Orphan+ (zeroBased, zeroBasedSize,+ singletonRange, unzipRange, singletonShifted, unzipShifted) import Data.Array.Knead.Expression (Exp, ) import qualified Data.Array.Comfort.Shape as Shape import Data.Array.Comfort.Shape- (Index, ZeroBased(ZeroBased), Range(Range), Shifted(Shifted))+ (Index, ZeroBased, Range(Range), Shifted(Shifted),+ Enumeration(Enumeration)) import Data.Ix (Ix) import qualified LLVM.Extra.Multi.Value.Memory as MultiMem import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Multi.Iterator as IterMV import qualified LLVM.Extra.Iterator as Iter+import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Arithmetic as A import LLVM.Extra.Multi.Value (atom) import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM -import qualified Type.Data.Num.Decimal as TypeNum- import Foreign.Storable (Storable) import Foreign.Ptr (Ptr) +import qualified Data.Enum.Storable as Enum+import Data.Tagged (Tagged)+import Data.Tuple.HT (mapSnd) import Data.Word (Word8, Word16, Word32, Word64) import Data.Int (Int8, Int16, Int32, Int64) import qualified Control.Monad.HT as Monad import Control.Applicative ((<$>)) +import Prelude2010+import Prelude () + type Size = Word64 value :: (C sh, Expr.Value val) => sh -> val sh@@ -151,51 +161,6 @@ instance ToSize Int64 where toSize (MultiValue.Cons n) = LLVM.bitcast n -unzipZeroBased :: MultiValue.T (ZeroBased n) -> ZeroBased (MultiValue.T n)-unzipZeroBased (MultiValue.Cons (ZeroBased n)) = ZeroBased (MultiValue.Cons n)--zeroBasedSize :: (Expr.Value val) => val (ZeroBased n) -> val n-zeroBasedSize = Expr.lift1 $ Shape.zeroBasedSize . unzipZeroBased--zeroBased :: (Expr.Value val) => val n -> val (ZeroBased n)-zeroBased =- Expr.lift1 $ \(MultiValue.Cons n) -> MultiValue.Cons (ZeroBased n)--instance (MultiValue.C n) => MultiValue.C (ZeroBased n) where- type Repr f (ZeroBased n) = ZeroBased (MultiValue.Repr f n)- cons (ZeroBased n) = zeroBased (MultiValue.cons n)- undef = zeroBased MultiValue.undef- zero = zeroBased MultiValue.zero- phis bb = Monad.lift zeroBased . MultiValue.phis bb . zeroBasedSize- addPhis bb a b = MultiValue.addPhis bb (zeroBasedSize a) (zeroBasedSize b)--type instance- MultiValue.Decomposed f (ZeroBased pn) =- ZeroBased (MultiValue.Decomposed f pn)-type instance- MultiValue.PatternTuple (ZeroBased pn) =- ZeroBased (MultiValue.PatternTuple pn)--instance (MultiValue.Compose n) => MultiValue.Compose (ZeroBased n) where- type Composed (ZeroBased n) = ZeroBased (MultiValue.Composed n)- compose (ZeroBased n) = zeroBased (MultiValue.compose n)--instance (MultiValue.Decompose pn) => MultiValue.Decompose (ZeroBased pn) where- decompose (ZeroBased p) sh =- MultiValue.decompose p <$> unzipZeroBased sh--instance (Expr.Compose n) => Expr.Compose (ZeroBased n) where- type Composed (ZeroBased n) = ZeroBased (Expr.Composed n)- compose (ZeroBased n) = Expr.lift1 zeroBased (Expr.compose n)--instance (Expr.Decompose pn) => Expr.Decompose (ZeroBased pn) where- decompose (ZeroBased p) = ZeroBased . Expr.decompose p . zeroBasedSize--instance (MultiMem.C n) => MultiMem.C (ZeroBased n) where- type Struct (ZeroBased n) = MultiMem.Struct n- decompose = fmap zeroBased . MultiMem.decompose- compose = MultiMem.compose . zeroBasedSize- {- | Array dimensions and indexes cannot be negative, but computations in indices may temporarily yield negative values@@ -221,24 +186,13 @@ sequenceShapeFromIndex = return . zeroBased -singletonRange :: n -> Range n-singletonRange n = Range n n- rangeSize :: (ToSize n) => Range (MultiValue.T n) -> LLVM.CodeGenFunction r (LLVM.Value Size) rangeSize (Range from to) = toSize =<< MultiValue.inc =<< MultiValue.sub to from -unzipRange :: MultiValue.T (Range n) -> Range (MultiValue.T n)-unzipRange (MultiValue.Cons (Range from to)) =- Range (MultiValue.Cons from) (MultiValue.Cons to) -zipRange :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Range n)-zipRange (MultiValue.Cons from) (MultiValue.Cons to) =- MultiValue.Cons (Range from to)-- rangeFrom :: (Expr.Value val) => val (Range n) -> val n rangeFrom = Expr.lift1 $ Shape.rangeFrom . unzipRange @@ -251,47 +205,6 @@ \(MultiValue.Cons from) (MultiValue.Cons to) -> MultiValue.Cons (Range from to) --instance (MultiValue.C n) => MultiValue.C (Range n) where- type Repr f (Range n) = Range (MultiValue.Repr f n)- cons (Range from to) = zipRange (MultiValue.cons from) (MultiValue.cons to)- undef = MultiValue.compose $ singletonRange MultiValue.undef- zero = MultiValue.compose $ singletonRange MultiValue.zero- phis bb a =- case unzipRange a of- Range a0 a1 ->- Monad.lift2 zipRange (MultiValue.phis bb a0) (MultiValue.phis bb a1)- addPhis bb a b =- case (unzipRange a, unzipRange b) of- (Range a0 a1, Range b0 b1) ->- MultiValue.addPhis bb a0 b0 >>- MultiValue.addPhis bb a1 b1--type instance- MultiValue.Decomposed f (Range pn) =- Range (MultiValue.Decomposed f pn)-type instance- MultiValue.PatternTuple (Range pn) =- Range (MultiValue.PatternTuple pn)--instance (MultiValue.Compose n) => MultiValue.Compose (Range n) where- type Composed (Range n) = Range (MultiValue.Composed n)- compose (Range from to) =- zipRange (MultiValue.compose from) (MultiValue.compose to)--instance (MultiValue.Decompose pn) => MultiValue.Decompose (Range pn) where- decompose (Range pfrom pto) rng =- case unzipRange rng of- Range from to ->- Range- (MultiValue.decompose pfrom from)- (MultiValue.decompose pto to)--instance (MultiMem.C n) => MultiMem.C (Range n) where- type Struct (Range n) = PairStruct n- decompose = fmap (uncurry zipRange) . decomposeGen- compose x = case unzipRange x of Range n m -> composeGen n m- instance (Ix n, ToSize n, MultiValue.Comparison n) => C (Range n) where intersectCode = MultiValue.modifyF2 (singletonRange atom) (singletonRange atom) $@@ -310,19 +223,7 @@ Iter.iterate MultiValue.inc from -singletonShifted :: n -> Shifted n-singletonShifted n = Shifted n n --unzipShifted :: MultiValue.T (Shifted n) -> Shifted (MultiValue.T n)-unzipShifted (MultiValue.Cons (Shifted from to)) =- Shifted (MultiValue.Cons from) (MultiValue.Cons to)--zipShifted :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Shifted n)-zipShifted (MultiValue.Cons from) (MultiValue.Cons to) =- MultiValue.Cons (Shifted from to)-- shiftedOffset :: (Expr.Value val) => val (Shifted n) -> val n shiftedOffset = Expr.lift1 $ Shape.shiftedOffset . unzipShifted @@ -336,70 +237,6 @@ MultiValue.Cons (Shifted from to) -instance (MultiValue.C n) => MultiValue.C (Shifted n) where- type Repr f (Shifted n) = Shifted (MultiValue.Repr f n)- cons (Shifted start len) =- zipShifted (MultiValue.cons start) (MultiValue.cons len)- undef = MultiValue.compose $ singletonShifted MultiValue.undef- zero = MultiValue.compose $ singletonShifted MultiValue.zero- phis bb a =- case unzipShifted a of- Shifted a0 a1 ->- Monad.lift2 zipShifted- (MultiValue.phis bb a0) (MultiValue.phis bb a1)- addPhis bb a b =- case (unzipShifted a, unzipShifted b) of- (Shifted a0 a1, Shifted b0 b1) ->- MultiValue.addPhis bb a0 b0 >>- MultiValue.addPhis bb a1 b1--type instance- MultiValue.Decomposed f (Shifted pn) =- Shifted (MultiValue.Decomposed f pn)-type instance- MultiValue.PatternTuple (Shifted pn) =- Shifted (MultiValue.PatternTuple pn)--instance (MultiValue.Compose n) => MultiValue.Compose (Shifted n) where- type Composed (Shifted n) = Shifted (MultiValue.Composed n)- compose (Shifted start len) =- zipShifted (MultiValue.compose start) (MultiValue.compose len)--instance (MultiValue.Decompose pn) => MultiValue.Decompose (Shifted pn) where- decompose (Shifted pstart plen) rng =- case unzipShifted rng of- Shifted start len ->- Shifted- (MultiValue.decompose pstart start)- (MultiValue.decompose plen len)--instance (MultiMem.C n) => MultiMem.C (Shifted n) where- type Struct (Shifted n) = PairStruct n- decompose = fmap (uncurry zipShifted) . decomposeGen- compose x = case unzipShifted x of Shifted n m -> composeGen n m--type PairStruct n = LLVM.Struct (MultiMem.Struct n, (MultiMem.Struct n, ()))--decomposeGen ::- (MultiMem.C n) =>- LLVM.Value (PairStruct n) ->- LLVM.CodeGenFunction r (MultiValue.T n, MultiValue.T n)-decomposeGen nm =- Monad.lift2 (,)- (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d0)- (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d1)--composeGen ::- (MultiMem.C n) =>- MultiValue.T n -> MultiValue.T n ->- LLVM.CodeGenFunction r (LLVM.Value (PairStruct n))-composeGen n m = do- sn <- MultiMem.compose n- sm <- MultiMem.compose m- rn <- LLVM.insertvalue (LLVM.value LLVM.undef) sn TypeNum.d0- LLVM.insertvalue rn sm TypeNum.d1-- instance (Integral n, ToSize n, MultiValue.Comparison n) => C (Shifted n) where intersectCode = MultiValue.modifyF2 (singletonShifted atom) (singletonShifted atom) $@@ -420,6 +257,42 @@ Shifted from len -> IterMV.take len $ Iter.iterate MultiValue.inc from ++class (IterMV.Enum enum, MultiValue.Bounded enum) => EnumBounded enum where+ enumOffset :: MultiValue.T enum -> LLVM.CodeGenFunction r (LLVM.Value Size)++instance+ (ToSize w, MultiValue.Additive w,+ LLVM.IsInteger w, SoV.IntegerConstant w, Num w,+ MultiValue.Repr LLVM.Value w ~ LLVM.Value w,+ LLVM.CmpRet w, LLVM.CmpResult w ~ Bool,+ Enum e, Bounded e) =>+ EnumBounded (Enum.T w e) where+ enumOffset ix =+ toSize =<<+ MultiValue.sub+ (MultiValue.fromEnum ix)+ (MultiValue.fromEnum $ MultiValue.minBound `asTypeOf` ix)++instance+ (Enum enum, Bounded enum, EnumBounded enum) => C (Enumeration enum) where+ intersectCode _sha shb = return shb+ size = return . A.fromInteger' . toInteger . Shape.size . plainEnumeration+ sizeOffset sh = do+ sz <- size sh+ return (sz, enumOffset)+ iterator _ = IterMV.enumFromTo MultiValue.minBound MultiValue.maxBound++plainEnumeration :: val (Enumeration enum) -> Enumeration enum+plainEnumeration _ = Enumeration+++instance (C sh) => C (Tagged tag sh) where+ intersectCode = MultiValue.liftTaggedM2 intersectCode+ size = size . MultiValue.untag+ sizeOffset =+ fmap (mapSnd (. MultiValue.untag)) . sizeOffset . MultiValue.untag+ iterator = fmap MultiValue.tag . iterator . MultiValue.untag instance (C n, C m) => C (n,m) where
+ src/Data/Array/Knead/Shape/Orphan.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Array.Knead.Shape.Orphan where++import qualified Data.Array.Knead.Expression as Expr++import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Shape+ (ZeroBased(ZeroBased), Range(Range), Shifted(Shifted),+ Enumeration(Enumeration))++import qualified LLVM.Extra.Multi.Value.Memory as MultiMem+import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Monad.HT as Monad+import Control.Applicative ((<$>))++import Prelude2010+import Prelude ()++++unzipZeroBased :: MultiValue.T (ZeroBased n) -> ZeroBased (MultiValue.T n)+unzipZeroBased (MultiValue.Cons (ZeroBased n)) = ZeroBased (MultiValue.Cons n)++zeroBasedSize :: (Expr.Value val) => val (ZeroBased n) -> val n+zeroBasedSize = Expr.lift1 $ Shape.zeroBasedSize . unzipZeroBased++zeroBased :: (Expr.Value val) => val n -> val (ZeroBased n)+zeroBased = Expr.lift1 $ \(MultiValue.Cons n) -> MultiValue.Cons (ZeroBased n)++instance (MultiValue.C n) => MultiValue.C (ZeroBased n) where+ type Repr f (ZeroBased n) = ZeroBased (MultiValue.Repr f n)+ cons (ZeroBased n) = zeroBased (MultiValue.cons n)+ undef = zeroBased MultiValue.undef+ zero = zeroBased MultiValue.zero+ phis bb = Monad.lift zeroBased . MultiValue.phis bb . zeroBasedSize+ addPhis bb a b = MultiValue.addPhis bb (zeroBasedSize a) (zeroBasedSize b)++type instance+ MultiValue.Decomposed f (ZeroBased pn) =+ ZeroBased (MultiValue.Decomposed f pn)+type instance+ MultiValue.PatternTuple (ZeroBased pn) =+ ZeroBased (MultiValue.PatternTuple pn)++instance (MultiValue.Compose n) => MultiValue.Compose (ZeroBased n) where+ type Composed (ZeroBased n) = ZeroBased (MultiValue.Composed n)+ compose (ZeroBased n) = zeroBased (MultiValue.compose n)++instance (MultiValue.Decompose pn) => MultiValue.Decompose (ZeroBased pn) where+ decompose (ZeroBased p) sh =+ MultiValue.decompose p <$> unzipZeroBased sh++instance (Expr.Compose n) => Expr.Compose (ZeroBased n) where+ type Composed (ZeroBased n) = ZeroBased (Expr.Composed n)+ compose (ZeroBased n) = Expr.lift1 zeroBased (Expr.compose n)++instance (Expr.Decompose pn) => Expr.Decompose (ZeroBased pn) where+ decompose (ZeroBased p) = ZeroBased . Expr.decompose p . zeroBasedSize++instance (MultiMem.C n) => MultiMem.C (ZeroBased n) where+ type Struct (ZeroBased n) = MultiMem.Struct n+ decompose = fmap zeroBased . MultiMem.decompose+ compose = MultiMem.compose . zeroBasedSize++++singletonRange :: n -> Range n+singletonRange n = Range n n++unzipRange :: MultiValue.T (Range n) -> Range (MultiValue.T n)+unzipRange (MultiValue.Cons (Range from to)) =+ Range (MultiValue.Cons from) (MultiValue.Cons to)++zipRange :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Range n)+zipRange (MultiValue.Cons from) (MultiValue.Cons to) =+ MultiValue.Cons (Range from to)++instance (MultiValue.C n) => MultiValue.C (Range n) where+ type Repr f (Range n) = Range (MultiValue.Repr f n)+ cons (Range from to) = zipRange (MultiValue.cons from) (MultiValue.cons to)+ undef = MultiValue.compose $ singletonRange MultiValue.undef+ zero = MultiValue.compose $ singletonRange MultiValue.zero+ phis bb a =+ case unzipRange a of+ Range a0 a1 ->+ Monad.lift2 zipRange (MultiValue.phis bb a0) (MultiValue.phis bb a1)+ addPhis bb a b =+ case (unzipRange a, unzipRange b) of+ (Range a0 a1, Range b0 b1) ->+ MultiValue.addPhis bb a0 b0 >>+ MultiValue.addPhis bb a1 b1++type instance+ MultiValue.Decomposed f (Range pn) = Range (MultiValue.Decomposed f pn)+type instance+ MultiValue.PatternTuple (Range pn) = Range (MultiValue.PatternTuple pn)++instance (MultiValue.Compose n) => MultiValue.Compose (Range n) where+ type Composed (Range n) = Range (MultiValue.Composed n)+ compose (Range from to) =+ zipRange (MultiValue.compose from) (MultiValue.compose to)++instance (MultiValue.Decompose pn) => MultiValue.Decompose (Range pn) where+ decompose (Range pfrom pto) rng =+ case unzipRange rng of+ Range from to ->+ Range+ (MultiValue.decompose pfrom from)+ (MultiValue.decompose pto to)++instance (MultiMem.C n) => MultiMem.C (Range n) where+ type Struct (Range n) = PairStruct n+ decompose = fmap (uncurry zipRange) . decomposeGen+ compose x = case unzipRange x of Range n m -> composeGen n m++++singletonShifted :: n -> Shifted n+singletonShifted n = Shifted n n++unzipShifted :: MultiValue.T (Shifted n) -> Shifted (MultiValue.T n)+unzipShifted (MultiValue.Cons (Shifted from to)) =+ Shifted (MultiValue.Cons from) (MultiValue.Cons to)++zipShifted :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Shifted n)+zipShifted (MultiValue.Cons from) (MultiValue.Cons to) =+ MultiValue.Cons (Shifted from to)++instance (MultiValue.C n) => MultiValue.C (Shifted n) where+ type Repr f (Shifted n) = Shifted (MultiValue.Repr f n)+ cons (Shifted start len) =+ zipShifted (MultiValue.cons start) (MultiValue.cons len)+ undef = MultiValue.compose $ singletonShifted MultiValue.undef+ zero = MultiValue.compose $ singletonShifted MultiValue.zero+ phis bb a =+ case unzipShifted a of+ Shifted a0 a1 ->+ Monad.lift2 zipShifted+ (MultiValue.phis bb a0) (MultiValue.phis bb a1)+ addPhis bb a b =+ case (unzipShifted a, unzipShifted b) of+ (Shifted a0 a1, Shifted b0 b1) ->+ MultiValue.addPhis bb a0 b0 >>+ MultiValue.addPhis bb a1 b1++type instance+ MultiValue.Decomposed f (Shifted pn) =+ Shifted (MultiValue.Decomposed f pn)+type instance+ MultiValue.PatternTuple (Shifted pn) =+ Shifted (MultiValue.PatternTuple pn)++instance (MultiValue.Compose n) => MultiValue.Compose (Shifted n) where+ type Composed (Shifted n) = Shifted (MultiValue.Composed n)+ compose (Shifted start len) =+ zipShifted (MultiValue.compose start) (MultiValue.compose len)++instance (MultiValue.Decompose pn) => MultiValue.Decompose (Shifted pn) where+ decompose (Shifted pstart plen) rng =+ case unzipShifted rng of+ Shifted start len ->+ Shifted+ (MultiValue.decompose pstart start)+ (MultiValue.decompose plen len)++instance (MultiMem.C n) => MultiMem.C (Shifted n) where+ type Struct (Shifted n) = PairStruct n+ decompose = fmap (uncurry zipShifted) . decomposeGen+ compose x = case unzipShifted x of Shifted n m -> composeGen n m++++type PairStruct n = LLVM.Struct (MultiMem.Struct n, (MultiMem.Struct n, ()))++decomposeGen ::+ (MultiMem.C n) =>+ LLVM.Value (PairStruct n) ->+ LLVM.CodeGenFunction r (MultiValue.T n, MultiValue.T n)+decomposeGen nm =+ Monad.lift2 (,)+ (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d0)+ (MultiMem.decompose =<< LLVM.extractvalue nm TypeNum.d1)++composeGen ::+ (MultiMem.C n) =>+ MultiValue.T n -> MultiValue.T n ->+ LLVM.CodeGenFunction r (LLVM.Value (PairStruct n))+composeGen n m = do+ sn <- MultiMem.compose n+ sm <- MultiMem.compose m+ rn <- LLVM.insertvalue (LLVM.value LLVM.undef) sn TypeNum.d0+ LLVM.insertvalue rn sm TypeNum.d1++++instance (Enum enum, Bounded enum) => MultiValue.C (Enumeration enum) where+ type Repr f (Enumeration enum) = ()+ cons = MultiValue.consUnit+ undef = MultiValue.undefUnit+ zero = MultiValue.zeroUnit+ phis = MultiValue.phisUnit+ addPhis = MultiValue.addPhisUnit++type instance MultiValue.Decomposed f (Enumeration enum) = Enumeration enum+type instance MultiValue.PatternTuple (Enumeration enum) = Enumeration enum++instance+ (Enum enum, Bounded enum) => MultiValue.Compose (Enumeration enum) where+ type Composed (Enumeration enum) = Enumeration enum+ compose = MultiValue.cons++instance MultiValue.Decompose (Enumeration enum) where+ decompose Enumeration _ = Enumeration+++instance (Enum enum, Bounded enum) => Expr.Compose (Enumeration enum) where+ type Composed (Enumeration enum) = Enumeration enum+ compose = Expr.cons++instance Expr.Decompose (Enumeration enum) where+ decompose Enumeration _ = Enumeration++instance (Enum enum, Bounded enum) => MultiMem.C (Enumeration enum) where+ type Struct (Enumeration enum) = LLVM.Struct ()+ load = MultiMem.loadUnit+ store = MultiMem.storeUnit+ decompose = MultiMem.decomposeUnit+ compose = MultiMem.composeUnit
src/Data/Array/Knead/Simple/Physical.hs view
@@ -45,7 +45,8 @@ import Control.Monad.HT (void, (<=<), ) import Control.Applicative (liftA2, (<$>), ) -import Prelude hiding (scanl1, )+import Prelude2010 hiding (scanl1)+import Prelude () shape :: Array sh a -> sh
src/Data/Array/Knead/Simple/PhysicalPrivate.hs view
@@ -23,6 +23,9 @@ import Data.Tuple.HT (mapSnd, ) +import Prelude2010+import Prelude ()+ writeArray ::