{-# LANGUAGE TypeFamilies #-}
{- |
LLVM counterpart to 'Maybe' datatype.
-}
module LLVM.Extra.Maybe (
   Maybe.T(..),
   Maybe.run,
   Maybe.for,
   Maybe.select,
   Maybe.alternative,
   Maybe.fromBool,
   Maybe.toBool,
   Maybe.getIsNothing,
   Maybe.just,
   nothing,
   Maybe.sequence,
   Maybe.traverse,
   Maybe.lift2,
   Maybe.liftM2,

   loopWithExit,
   ) where

import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.MaybePrivate as Maybe
import qualified LLVM.Extra.Control as C

import LLVM.Core (CodeGenFunction, )


nothing :: (Tuple.Undefined a) => Maybe.T a
nothing :: forall a. Undefined a => T a
nothing = a -> T a
forall a. a -> T a
Maybe.nothing a
forall a. Undefined a => a
Tuple.undef


loopWithExit ::
   Tuple.Phi a =>
   a ->
   (a -> CodeGenFunction r (Maybe.T c, b)) ->
   ((c,b) -> CodeGenFunction r a) ->
   CodeGenFunction r b
loopWithExit :: forall a r c b.
Phi a =>
a
-> (a -> CodeGenFunction r (T c, b))
-> ((c, b) -> CodeGenFunction r a)
-> CodeGenFunction r b
loopWithExit a
start a -> CodeGenFunction r (T c, b)
check (c, b) -> CodeGenFunction r a
body =
   ((c, b) -> b) -> CodeGenFunction r (c, b) -> CodeGenFunction r b
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, b) -> b
forall a b. (a, b) -> b
snd (CodeGenFunction r (c, b) -> CodeGenFunction r b)
-> CodeGenFunction r (c, b) -> CodeGenFunction r b
forall a b. (a -> b) -> a -> b
$
   a
-> (a -> CodeGenFunction r (Value Bool, (c, b)))
-> ((c, b) -> CodeGenFunction r a)
-> CodeGenFunction r (c, b)
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit a
start
      (\a
a -> do
         (T c
mc,b
b) <- a -> CodeGenFunction r (T c, b)
check a
a
         let (Value Bool
j,c
c) = T c -> (Value Bool, c)
forall a. T a -> (Value Bool, a)
Maybe.toBool T c
mc
         (Value Bool, (c, b)) -> CodeGenFunction r (Value Bool, (c, b))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Bool
j, (c
c,b
b)))
      (c, b) -> CodeGenFunction r a
body