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

import LLVM.Extra.Control (ifThenElse, )

import qualified LLVM.Core as LLVM
import LLVM.Core (Value, valueOf, CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )

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 (Phi a, Phi b) => Phi (T a b) where
   phis bb (Cons r a b) = liftM3 Cons (phis bb r) (phis bb a) (phis bb b)
   addPhis bb (Cons r0 a0 b0) (Cons r1 a1 b1) =
      addPhis bb r0 r1 >> addPhis bb a0 a1 >> addPhis bb b0 b1


{- |
counterpart to 'either'
-}
run ::
   (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}