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 as MultiValue
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple
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 (Tuple.Undefined n) => Tuple.Undefined (ZeroBased n) where
undef = ZeroBased Tuple.undef
instance (Tuple.Phi n) => Tuple.Phi (ZeroBased n) where
phi bb = fmap ZeroBased . Tuple.phi bb . Shape.zeroBasedSize
addPhi bb (Shape.ZeroBased a) (Shape.ZeroBased b) = Tuple.addPhi bb a b
instance (Tuple.Value n) => Tuple.Value (ZeroBased n) where
type ValueOf (ZeroBased n) = ZeroBased (Tuple.ValueOf n)
valueOf (ZeroBased n) = ZeroBased $ Tuple.valueOf n
instance (MultiValue.C n) => MultiValue.C (ZeroBased n) where
cons (ZeroBased n) = zeroBased (MultiValue.cons n)
undef = zeroBased MultiValue.undef
zero = zeroBased MultiValue.zero
phi bb = Monad.lift zeroBased . MultiValue.phi bb . zeroBasedSize
addPhi bb a b = MultiValue.addPhi 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 (Memory.C n) => Memory.C (ZeroBased n) where
type Struct (ZeroBased n) = Memory.Struct n
compose = Memory.compose . Shape.zeroBasedSize
decompose = fmap ZeroBased . Memory.decompose
instance (Marshal.C n) => Marshal.C (ZeroBased n) where
pack = Marshal.pack . Shape.zeroBasedSize
unpack = Shape.ZeroBased . Marshal.unpack
instance (Marshal.MV n) => Marshal.MV (ZeroBased n) where
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 (Tuple.Undefined n) => Tuple.Undefined (Range n) where
undef = Range Tuple.undef Tuple.undef
instance (Tuple.Value n) => Tuple.Value (Range n) where
type ValueOf (Range n) = Range (Tuple.ValueOf n)
valueOf (Range from to) = Range (Tuple.valueOf from) (Tuple.valueOf to)
instance (MultiValue.C n) => MultiValue.C (Range n) where
cons (Range from to) = zipRange (MultiValue.cons from) (MultiValue.cons to)
undef = MultiValue.compose $ singletonRange MultiValue.undef
zero = MultiValue.compose $ singletonRange MultiValue.zero
phi bb a =
case unzipRange a of
Range a0 a1 ->
Monad.lift2 zipRange (MultiValue.phi bb a0) (MultiValue.phi bb a1)
addPhi bb a b =
case (unzipRange a, unzipRange b) of
(Range a0 a1, Range b0 b1) ->
MultiValue.addPhi bb a0 b0 >>
MultiValue.addPhi 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)
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 (Tuple.Undefined n) => Tuple.Undefined (Shifted n) where
undef = Shifted Tuple.undef Tuple.undef
instance (Tuple.Value n) => Tuple.Value (Shifted n) where
type ValueOf (Shifted n) = Shifted (Tuple.ValueOf n)
valueOf (Shifted start len) =
Shifted (Tuple.valueOf start) (Tuple.valueOf len)
instance (MultiValue.C n) => MultiValue.C (Shifted n) where
cons (Shifted start len) =
zipShifted (MultiValue.cons start) (MultiValue.cons len)
undef = MultiValue.compose $ singletonShifted MultiValue.undef
zero = MultiValue.compose $ singletonShifted MultiValue.zero
phi bb a =
case unzipShifted a of
Shifted a0 a1 ->
Monad.lift2 zipShifted
(MultiValue.phi bb a0) (MultiValue.phi bb a1)
addPhi bb a b =
case (unzipShifted a, unzipShifted b) of
(Shifted a0 a1, Shifted b0 b1) ->
MultiValue.addPhi bb a0 b0 >>
MultiValue.addPhi 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 (Enum enum, Bounded enum) => Tuple.Value (Enumeration enum) where
type ValueOf (Enumeration enum) = ()
valueOf Enumeration = ()
instance (Enum enum, Bounded enum) => MultiValue.C (Enumeration enum) where
cons = MultiValue.consUnit
undef = MultiValue.undefUnit
zero = MultiValue.zeroUnit
phi = MultiValue.phiUnit
addPhi = MultiValue.addPhiUnit
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