module LLVM.Extra.TuplePrivate where

import qualified LLVM.Core as LLVM

import qualified Data.FixedLength as FixedLength
import Data.Complex (Complex)

import qualified Type.Data.Num.Unary as Unary

import qualified Control.Applicative.HT as App
import Control.Applicative (Applicative, liftA2, pure)

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import Data.Orphans ()



-- * class for phi operating on value tuples

class Phi a where
   phi :: LLVM.BasicBlock -> a -> LLVM.CodeGenFunction r a
   addPhi :: LLVM.BasicBlock -> a -> a -> LLVM.CodeGenFunction r ()

instance Phi () where
   phi :: forall r. BasicBlock -> () -> CodeGenFunction r ()
phi BasicBlock
_ ()
_ = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   addPhi :: forall r. BasicBlock -> () -> () -> CodeGenFunction r ()
addPhi BasicBlock
_ ()
_ ()
_ = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance (LLVM.IsFirstClass a) => Phi (LLVM.Value a) where
   phi :: forall r. BasicBlock -> Value a -> CodeGenFunction r (Value a)
phi BasicBlock
bb Value a
a = [(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
forall a r.
IsFirstClass a =>
[(Value a, BasicBlock)] -> CodeGenFunction r (Value a)
LLVM.phi [(Value a
a, BasicBlock
bb)]
   addPhi :: forall r. BasicBlock -> Value a -> Value a -> CodeGenFunction r ()
addPhi BasicBlock
bb Value a
a Value a
a' = Value a -> [(Value a, BasicBlock)] -> CodeGenFunction r ()
forall a r.
IsFirstClass a =>
Value a -> [(Value a, BasicBlock)] -> CodeGenFunction r ()
LLVM.addPhiInputs Value a
a [(Value a
a', BasicBlock
bb)]

instance (Phi a, Phi b) => Phi (a, b) where
   phi :: forall r. BasicBlock -> (a, b) -> CodeGenFunction r (a, b)
phi BasicBlock
bb = (a -> CodeGenFunction r a, b -> CodeGenFunction r b)
-> (a, b) -> CodeGenFunction r (a, b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c, b -> f d) -> (a, b) -> f (c, d)
App.mapPair (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb, BasicBlock -> b -> CodeGenFunction r b
forall r. BasicBlock -> b -> CodeGenFunction r b
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb)
   addPhi :: forall r. BasicBlock -> (a, b) -> (a, b) -> CodeGenFunction r ()
addPhi BasicBlock
bb (a
a0,b
b0) (a
a1,b
b1) = do
      BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb a
a0 a
a1
      BasicBlock -> b -> b -> CodeGenFunction r ()
forall r. BasicBlock -> b -> b -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb b
b0 b
b1

instance (Phi a, Phi b, Phi c) => Phi (a, b, c) where
   phi :: forall r. BasicBlock -> (a, b, c) -> CodeGenFunction r (a, b, c)
phi BasicBlock
bb = (a -> CodeGenFunction r a, b -> CodeGenFunction r b,
 c -> CodeGenFunction r c)
-> (a, b, c) -> CodeGenFunction r (a, b, c)
forall (m :: * -> *) a d b e c f.
Applicative m =>
(a -> m d, b -> m e, c -> m f) -> (a, b, c) -> m (d, e, f)
App.mapTriple (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb, BasicBlock -> b -> CodeGenFunction r b
forall r. BasicBlock -> b -> CodeGenFunction r b
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb, BasicBlock -> c -> CodeGenFunction r c
forall r. BasicBlock -> c -> CodeGenFunction r c
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb)
   addPhi :: forall r.
BasicBlock -> (a, b, c) -> (a, b, c) -> CodeGenFunction r ()
addPhi BasicBlock
bb (a
a0,b
b0,c
c0) (a
a1,b
b1,c
c1) = do
      BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb a
a0 a
a1
      BasicBlock -> b -> b -> CodeGenFunction r ()
forall r. BasicBlock -> b -> b -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb b
b0 b
b1
      BasicBlock -> c -> c -> CodeGenFunction r ()
forall r. BasicBlock -> c -> c -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb c
c0 c
c1

instance (Phi a, Phi b, Phi c, Phi d) => Phi (a, b, c, d) where
   phi :: forall r.
BasicBlock -> (a, b, c, d) -> CodeGenFunction r (a, b, c, d)
phi BasicBlock
bb (a
a,b
b,c
c,d
d) =
      (a -> b -> c -> d -> (a, b, c, d))
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
-> CodeGenFunction r d
-> CodeGenFunction r (a, b, c, d)
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 (,,,) (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb a
a) (BasicBlock -> b -> CodeGenFunction r b
forall r. BasicBlock -> b -> CodeGenFunction r b
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb b
b) (BasicBlock -> c -> CodeGenFunction r c
forall r. BasicBlock -> c -> CodeGenFunction r c
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb c
c) (BasicBlock -> d -> CodeGenFunction r d
forall r. BasicBlock -> d -> CodeGenFunction r d
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb d
d)
   addPhi :: forall r.
BasicBlock -> (a, b, c, d) -> (a, b, c, d) -> CodeGenFunction r ()
addPhi BasicBlock
bb (a
a0,b
b0,c
c0,d
d0) (a
a1,b
b1,c
c1,d
d1) = do
      BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb a
a0 a
a1
      BasicBlock -> b -> b -> CodeGenFunction r ()
forall r. BasicBlock -> b -> b -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb b
b0 b
b1
      BasicBlock -> c -> c -> CodeGenFunction r ()
forall r. BasicBlock -> c -> c -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb c
c0 c
c1
      BasicBlock -> d -> d -> CodeGenFunction r ()
forall r. BasicBlock -> d -> d -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb d
d0 d
d1

instance (Phi a) => Phi (Complex a) where
   phi :: forall r. BasicBlock -> Complex a -> CodeGenFunction r (Complex a)
phi = BasicBlock -> Complex a -> CodeGenFunction r (Complex a)
forall a (f :: * -> *) r.
(Phi a, Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
phiTraversable
   addPhi :: forall r.
BasicBlock -> Complex a -> Complex a -> CodeGenFunction r ()
addPhi = BasicBlock -> Complex a -> Complex a -> CodeGenFunction r ()
forall a (f :: * -> *) r.
(Phi a, Foldable f, Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
addPhiFoldable

instance (Unary.Natural n, Phi a) => Phi (FixedLength.T n a) where
   phi :: forall r. BasicBlock -> T n a -> CodeGenFunction r (T n a)
phi = BasicBlock -> T n a -> CodeGenFunction r (T n a)
forall a (f :: * -> *) r.
(Phi a, Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
phiTraversable
   addPhi :: forall r. BasicBlock -> T n a -> T n a -> CodeGenFunction r ()
addPhi = BasicBlock -> T n a -> T n a -> CodeGenFunction r ()
forall a (f :: * -> *) r.
(Phi a, Foldable f, Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
addPhiFoldable

phiTraversable ::
   (Phi a, Trav.Traversable f) =>
   LLVM.BasicBlock -> f a -> LLVM.CodeGenFunction r (f a)
phiTraversable :: forall a (f :: * -> *) r.
(Phi a, Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
phiTraversable BasicBlock
bb f a
x = (a -> CodeGenFunction r a) -> f a -> CodeGenFunction r (f a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Trav.mapM (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
phi BasicBlock
bb) f a
x

addPhiFoldable ::
   (Phi a, Fold.Foldable f, Applicative f) =>
   LLVM.BasicBlock -> f a -> f a -> LLVM.CodeGenFunction r ()
addPhiFoldable :: forall a (f :: * -> *) r.
(Phi a, Foldable f, Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
addPhiFoldable BasicBlock
bb f a
x f a
y = f (CodeGenFunction r ()) -> CodeGenFunction r ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
Fold.sequence_ ((a -> a -> CodeGenFunction r ())
-> f a -> f a -> f (CodeGenFunction r ())
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
addPhi BasicBlock
bb) f a
x f a
y)


-- * class for tuples of undefined values

class Undefined a where
   undef :: a

instance Undefined () where
   undef :: ()
undef = ()

instance (LLVM.IsFirstClass a) => Undefined (LLVM.Value a) where
   undef :: Value a
undef = ConstValue a -> Value a
forall a. ConstValue a -> Value a
LLVM.value ConstValue a
forall a. IsType a => ConstValue a
LLVM.undef

instance (LLVM.IsFirstClass a) => Undefined (LLVM.ConstValue a) where
   undef :: ConstValue a
undef = ConstValue a
forall a. IsType a => ConstValue a
LLVM.undef

instance (Undefined a, Undefined b) => Undefined (a, b) where
   undef :: (a, b)
undef = (a
forall a. Undefined a => a
undef, b
forall a. Undefined a => a
undef)

instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where
   undef :: (a, b, c)
undef = (a
forall a. Undefined a => a
undef, b
forall a. Undefined a => a
undef, c
forall a. Undefined a => a
undef)

instance
   (Undefined a, Undefined b, Undefined c, Undefined d) =>
      Undefined (a, b, c, d) where
   undef :: (a, b, c, d)
undef = (a
forall a. Undefined a => a
undef, b
forall a. Undefined a => a
undef, c
forall a. Undefined a => a
undef, d
forall a. Undefined a => a
undef)

instance (Undefined a) => Undefined (Complex a) where
   undef :: Complex a
undef = Complex a
forall a (f :: * -> *). (Undefined a, Applicative f) => f a
undefPointed

instance (Unary.Natural n, Undefined a) => Undefined (FixedLength.T n a) where
   undef :: T n a
undef = T n a
forall a (f :: * -> *). (Undefined a, Applicative f) => f a
undefPointed

undefPointed :: (Undefined a, Applicative f) => f a
undefPointed :: forall a (f :: * -> *). (Undefined a, Applicative f) => f a
undefPointed = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Undefined a => a
undef


-- * class for tuples of zero values

class Zero a where
   zero :: a

instance Zero () where
   zero :: ()
zero = ()

instance (LLVM.IsFirstClass a) => Zero (LLVM.Value a) where
   zero :: Value a
zero = ConstValue a -> Value a
forall a. ConstValue a -> Value a
LLVM.value ConstValue a
forall a. IsType a => ConstValue a
LLVM.zero

instance (LLVM.IsFirstClass a) => Zero (LLVM.ConstValue a) where
   zero :: ConstValue a
zero = ConstValue a
forall a. IsType a => ConstValue a
LLVM.zero

instance (Zero a, Zero b) => Zero (a, b) where
   zero :: (a, b)
zero = (a
forall a. Zero a => a
zero, b
forall a. Zero a => a
zero)

instance (Zero a, Zero b, Zero c) => Zero (a, b, c) where
   zero :: (a, b, c)
zero = (a
forall a. Zero a => a
zero, b
forall a. Zero a => a
zero, c
forall a. Zero a => a
zero)

instance (Zero a, Zero b, Zero c, Zero d) => Zero (a, b, c, d) where
   zero :: (a, b, c, d)
zero = (a
forall a. Zero a => a
zero, b
forall a. Zero a => a
zero, c
forall a. Zero a => a
zero, d
forall a. Zero a => a
zero)

instance (Zero a) => Zero (Complex a) where
   zero :: Complex a
zero = Complex a
forall a (f :: * -> *). (Zero a, Applicative f) => f a
zeroPointed

instance (Unary.Natural n, Zero a) => Zero (FixedLength.T n a) where
   zero :: T n a
zero = T n a
forall a (f :: * -> *). (Zero a, Applicative f) => f a
zeroPointed

zeroPointed :: (Zero a, Applicative f) => f a
zeroPointed :: forall a (f :: * -> *). (Zero a, Applicative f) => f a
zeroPointed = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Zero a => a
zero