{-# 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 {isRight :: Value Bool, fromLeft :: a, fromRight :: b}


instance
   (Tuple.Undefined a, Tuple.Undefined b) =>
      Tuple.Undefined (T a b) where
   undef = Cons Tuple.undef Tuple.undef Tuple.undef

instance (Tuple.Phi a, Tuple.Phi b) => Tuple.Phi (T a b) where
   phi bb (Cons r a b) =
      liftM3 Cons (Tuple.phi bb r) (Tuple.phi bb a) (Tuple.phi bb b)
   addPhi bb (Cons r0 a0 b0) (Cons r1 a1 b1) =
      Tuple.addPhi bb r0 r1 >> Tuple.addPhi bb a0 a1 >> Tuple.addPhi bb b0 b1


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


mapLeft :: (a0 -> a1) -> T a0 b -> T a1 b
mapLeft f (Cons r a b) = Cons r (f a) b

mapRight :: (b0 -> b1) -> T a b0 -> T a b1
mapRight f (Cons r a b) = Cons r a (f b)


getIsLeft :: T a b -> CodeGenFunction r (Value Bool)
getIsLeft (Cons r _ _) = LLVM.inv r

left :: b -> a -> T a b
left undef a =
   Cons {isRight = valueOf False, fromLeft = a, fromRight = undef}

right :: a -> b -> T a b
right undef b =
   Cons {isRight = valueOf True, fromLeft = undef, fromRight = b}