packages feed

llvm-extra-0.4.2: src/LLVM/Extra/MaybePrivate.hs

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

import LLVM.Extra.Control (ifThenElse, )

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

import Control.Monad (liftM2, )


{- |
If @isJust = False@, then @fromJust@ is an @undefTuple@.
-}
data T a = Cons {isJust :: Value Bool, fromJust :: a}


instance Functor T where
   fmap f (Cons b a) = Cons b (f a)

instance (Phi a) => Phi (T a) where
   phis bb (Cons b a) = liftM2 Cons (phis bb b) (phis bb a)
   addPhis bb (Cons b0 a0) (Cons b1 a1) =
      addPhis bb b0 b1 >> addPhis bb a0 a1


{- |
counterpart to 'maybe'
-}
run ::
   (Phi b) =>
   T a ->
   CodeGenFunction r b ->
   (a -> CodeGenFunction r b) ->
   CodeGenFunction r b
run (Cons b a) n j =
   ifThenElse b (j a) n


{- |
counterpart to Data.Maybe.HT.toMaybe
-}
fromBool :: Value Bool -> a -> T a
fromBool = Cons

toBool :: T a -> (Value Bool, a)
toBool (Cons b a) = (b,a)

just :: a -> T a
just = Cons (valueOf True)

nothing :: a -> T a
nothing undef = Cons (valueOf False) undef