{-# LANGUAGE TypeFamilies #-}
module LLVM.Extra.EitherPrivate where

import qualified LLVM.Extra.TuplePrivate as Tuple
import LLVM.Extra.Control (ifThenElse, )

import qualified LLVM.Core as LLVM
import LLVM.Core (Value, valueOf, CodeGenFunction, )

import Control.Monad (liftM3, )


{- |
If @isRight@, then @fromLeft@ is an @undefTuple@.
If @not isRight@, then @fromRight@ is an @undefTuple@.
I would prefer a union type,
but it was temporarily removed in LLVM-2.8 and did not return since then.
-}
data T a b = Cons {forall a b. T a b -> Value Bool
isRight :: Value Bool, forall a b. T a b -> a
fromLeft :: a, forall a b. T a b -> b
fromRight :: b}


instance
   (Tuple.Undefined a, Tuple.Undefined b) =>
      Tuple.Undefined (T a b) where
   undef :: T a b
undef = Value Bool -> a -> b -> T a b
forall a b. Value Bool -> a -> b -> T a b
Cons Value Bool
forall a. Undefined a => a
Tuple.undef a
forall a. Undefined a => a
Tuple.undef b
forall a. Undefined a => a
Tuple.undef

instance (Tuple.Phi a, Tuple.Phi b) => Tuple.Phi (T a b) where
   phi :: forall r. BasicBlock -> T a b -> CodeGenFunction r (T a b)
phi BasicBlock
bb (Cons Value Bool
r a
a b
b) =
      (Value Bool -> a -> b -> T a b)
-> CodeGenFunction r (Value Bool)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r (T a b)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Value Bool -> a -> b -> T a b
forall a b. Value Bool -> a -> b -> T a b
Cons (BasicBlock -> Value Bool -> CodeGenFunction r (Value Bool)
forall r.
BasicBlock -> Value Bool -> CodeGenFunction r (Value Bool)
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
bb Value Bool
r) (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.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
Tuple.phi BasicBlock
bb b
b)
   addPhi :: forall r. BasicBlock -> T a b -> T a b -> CodeGenFunction r ()
addPhi BasicBlock
bb (Cons Value Bool
r0 a
a0 b
b0) (Cons Value Bool
r1 a
a1 b
b1) =
      BasicBlock -> Value Bool -> Value Bool -> CodeGenFunction r ()
forall r.
BasicBlock -> Value Bool -> Value Bool -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb Value Bool
r0 Value Bool
r1 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb a
a0 a
a1 CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BasicBlock -> b -> b -> CodeGenFunction r ()
forall r. BasicBlock -> b -> b -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb b
b0 b
b1


{- |
counterpart to 'either'
-}
run ::
   (Tuple.Phi c) =>
   T a b ->
   (a -> CodeGenFunction r c) ->
   (b -> CodeGenFunction r c) ->
   CodeGenFunction r c
run :: forall c a b r.
Phi c =>
T a b
-> (a -> CodeGenFunction r c)
-> (b -> CodeGenFunction r c)
-> CodeGenFunction r c
run (Cons Value Bool
r a
a b
b) a -> CodeGenFunction r c
fa b -> CodeGenFunction r c
fb =
   Value Bool
-> CodeGenFunction r c
-> CodeGenFunction r c
-> CodeGenFunction r c
forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
ifThenElse Value Bool
r (b -> CodeGenFunction r c
fb b
b) (a -> CodeGenFunction r c
fa a
a)


mapLeft :: (a0 -> a1) -> T a0 b -> T a1 b
mapLeft :: forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapLeft a0 -> a1
f (Cons Value Bool
r a0
a b
b) = Value Bool -> a1 -> b -> T a1 b
forall a b. Value Bool -> a -> b -> T a b
Cons Value Bool
r (a0 -> a1
f a0
a) b
b

mapRight :: (b0 -> b1) -> T a b0 -> T a b1
mapRight :: forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapRight b0 -> b1
f (Cons Value Bool
r a
a b0
b) = Value Bool -> a -> b1 -> T a b1
forall a b. Value Bool -> a -> b -> T a b
Cons Value Bool
r a
a (b0 -> b1
f b0
b)


getIsLeft :: T a b -> CodeGenFunction r (Value Bool)
getIsLeft :: forall a b r. T a b -> CodeGenFunction r (Value Bool)
getIsLeft (Cons Value Bool
r a
_ b
_) = Value Bool -> CodeGenFunction r (Value Bool)
forall (value :: * -> *) a r.
(ValueCons value, IsInteger a) =>
value a -> CodeGenFunction r (value a)
LLVM.inv Value Bool
r

left :: b -> a -> T a b
left :: forall b a. b -> a -> T a b
left b
undef a
a =
   Cons {isRight :: Value Bool
isRight = Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
False, fromLeft :: a
fromLeft = a
a, fromRight :: b
fromRight = b
undef}

right :: a -> b -> T a b
right :: forall a b. a -> b -> T a b
right a
undef b
b =
   Cons {isRight :: Value Bool
isRight = Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True, fromLeft :: a
fromLeft = a
undef, fromRight :: b
fromRight = b
b}