{-# LANGUAGE TypeFamilies #-}
{- |
Maybe transformer datatype implemented in continuation passing style.
-}
module LLVM.Extra.MaybeContinuation where

import qualified LLVM.Extra.Maybe as Maybe
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Control as C
import LLVM.Extra.Control (ifThenElse, )

import qualified LLVM.Core as LLVM
import LLVM.Core
   (CodeGenFunction, Value, value, valueOf,
    IsConst, IsType, IsPrimitive, IsInteger, CmpRet)

import qualified Control.Monad as M
import qualified Control.Applicative as App
import Control.Monad.IO.Class (MonadIO(liftIO), )
import Control.Monad.HT ((<=<), )

import Data.Tuple.HT (mapSnd, )

import Prelude hiding (map, )


{- |
Isomorphic to @ReaderT (CodeGenFunction r z) (ContT z (CodeGenFunction r)) a@,
where the reader provides the block for 'Nothing'
and the continuation part manages the 'Just'.
-}
newtype T r z a =
   Cons {forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
resolve ::
      CodeGenFunction r z ->
      (a -> CodeGenFunction r z) ->
      CodeGenFunction r z
   }


map :: (a -> CodeGenFunction r b) -> T r z a -> T r z b
map :: forall a r b z. (a -> CodeGenFunction r b) -> T r z a -> T r z b
map a -> CodeGenFunction r b
f (Cons CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
m) = (CodeGenFunction r z
 -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z b)
-> (CodeGenFunction r z
    -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n b -> CodeGenFunction r z
j ->
   CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
m CodeGenFunction r z
n (b -> CodeGenFunction r z
j (b -> CodeGenFunction r z)
-> (a -> CodeGenFunction r b) -> a -> CodeGenFunction r z
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> CodeGenFunction r b
f)

instance Functor (T r z) where
   fmap :: forall a b. (a -> b) -> T r z a -> T r z b
fmap a -> b
f (Cons CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
m) = (CodeGenFunction r z
 -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z b)
-> (CodeGenFunction r z
    -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n b -> CodeGenFunction r z
j -> CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
m CodeGenFunction r z
n (b -> CodeGenFunction r z
j (b -> CodeGenFunction r z) -> (a -> b) -> a -> CodeGenFunction r z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance App.Applicative (T r z) where
   pure :: forall a. a -> T r z a
pure a
a = CodeGenFunction r a -> T r z a
forall r a z. CodeGenFunction r a -> T r z a
lift (a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
   <*> :: forall a b. T r z (a -> b) -> T r z a -> T r z b
(<*>) = T r z (a -> b) -> T r z a -> T r z b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
M.ap

instance Monad (T r z) where
   return :: forall a. a -> T r z a
return = a -> T r z a
forall a. a -> T r z a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   >>= :: forall a b. T r z a -> (a -> T r z b) -> T r z b
(>>=) = T r z a -> (a -> T r z b) -> T r z b
forall r z a b. T r z a -> (a -> T r z b) -> T r z b
bind

instance MonadIO (T r z) where
   liftIO :: forall a. IO a -> T r z a
liftIO = CodeGenFunction r a -> T r z a
forall r a z. CodeGenFunction r a -> T r z a
lift (CodeGenFunction r a -> T r z a)
-> (IO a -> CodeGenFunction r a) -> IO a -> T r z a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> CodeGenFunction r a
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{- |
counterpart to Data.Maybe.HT.toMaybe
-}
withBool ::
   (Tuple.Phi z) =>
   Value Bool -> CodeGenFunction r a -> T r z a
withBool :: forall z r a. Phi z => Value Bool -> CodeGenFunction r a -> T r z a
withBool Value Bool
b CodeGenFunction r a
a =
   Value Bool -> T r z ()
forall z r. Phi z => Value Bool -> T r z ()
guard Value Bool
b T r z () -> T r z a -> T r z a
forall a b. T r z a -> T r z b -> T r z b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CodeGenFunction r a -> T r z a
forall r a z. CodeGenFunction r a -> T r z a
lift CodeGenFunction r a
a
{-
withBool b a = Cons $ \n j ->
   ifThenElse b (j =<< a) n
-}

fromBool ::
   (Tuple.Phi z) =>
   CodeGenFunction r (Value Bool, a) ->
   T r z a
fromBool :: forall z r a. Phi z => CodeGenFunction r (Value Bool, a) -> T r z a
fromBool CodeGenFunction r (Value Bool, a)
m = do
   (Value Bool
b,a
a) <- CodeGenFunction r (Value Bool, a) -> T r z (Value Bool, a)
forall r a z. CodeGenFunction r a -> T r z a
lift CodeGenFunction r (Value Bool, a)
m
   Value Bool -> T r z ()
forall z r. Phi z => Value Bool -> T r z ()
guard Value Bool
b
   a -> T r z a
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

toBool ::
   (Tuple.Undefined a) =>
   T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
toBool :: forall a r.
Undefined a =>
T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
toBool (Cons CodeGenFunction r (Value Bool, a)
-> (a -> CodeGenFunction r (Value Bool, a))
-> CodeGenFunction r (Value Bool, a)
m) =
   CodeGenFunction r (Value Bool, a)
-> (a -> CodeGenFunction r (Value Bool, a))
-> CodeGenFunction r (Value Bool, a)
m ((Value Bool, a) -> CodeGenFunction r (Value Bool, a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
False, a
forall a. Undefined a => a
Tuple.undef)) ((Value Bool, a) -> CodeGenFunction r (Value Bool, a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value Bool, a) -> CodeGenFunction r (Value Bool, a))
-> (a -> (Value Bool, a)) -> a -> CodeGenFunction r (Value Bool, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True))


fromPlainMaybe :: (Tuple.Phi z) => Maybe.T a -> T r z a
fromPlainMaybe :: forall z a r. Phi z => T a -> T r z a
fromPlainMaybe (Maybe.Cons Value Bool
b a
a) = Value Bool -> T r z ()
forall z r. Phi z => Value Bool -> T r z ()
guard Value Bool
b T r z () -> T r z a -> T r z a
forall a b. T r z a -> T r z b -> T r z b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> T r z a
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

fromMaybe :: (Tuple.Phi z) => CodeGenFunction r (Maybe.T a) -> T r z a
fromMaybe :: forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
fromMaybe CodeGenFunction r (T a)
m = CodeGenFunction r (T a) -> T r z (T a)
forall r a z. CodeGenFunction r a -> T r z a
lift CodeGenFunction r (T a)
m T r z (T a) -> (T a -> T r z a) -> T r z a
forall a b. T r z a -> (a -> T r z b) -> T r z b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= T a -> T r z a
forall z a r. Phi z => T a -> T r z a
fromPlainMaybe

toMaybe ::
   (Tuple.Undefined a) =>
   T r (Maybe.T a) a -> CodeGenFunction r (Maybe.T a)
toMaybe :: forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
toMaybe (Cons CodeGenFunction r (T a)
-> (a -> CodeGenFunction r (T a)) -> CodeGenFunction r (T a)
m) =
   CodeGenFunction r (T a)
-> (a -> CodeGenFunction r (T a)) -> CodeGenFunction r (T a)
m (T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return T a
forall a. Undefined a => T a
Maybe.nothing) (T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> CodeGenFunction r (T a))
-> (a -> T a) -> a -> CodeGenFunction r (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> T a
Maybe.just)


isJust ::
   T r (Value Bool) a -> CodeGenFunction r (Value Bool)
isJust :: forall r a. T r (Value Bool) a -> CodeGenFunction r (Value Bool)
isJust (Cons CodeGenFunction r (Value Bool)
-> (a -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (Value Bool)
m) =
   CodeGenFunction r (Value Bool)
-> (a -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (Value Bool)
m (Value Bool -> CodeGenFunction r (Value Bool)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
False)) (CodeGenFunction r (Value Bool)
-> a -> CodeGenFunction r (Value Bool)
forall a b. a -> b -> a
const (CodeGenFunction r (Value Bool)
 -> a -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (Value Bool)
-> a
-> CodeGenFunction r (Value Bool)
forall a b. (a -> b) -> a -> b
$ Value Bool -> CodeGenFunction r (Value Bool)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True))

lift :: CodeGenFunction r a -> T r z a
lift :: forall r a z. CodeGenFunction r a -> T r z a
lift CodeGenFunction r a
a = (CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z a)
-> (CodeGenFunction r z
    -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall a b. (a -> b) -> a -> b
$ \ CodeGenFunction r z
_n a -> CodeGenFunction r z
j -> a -> CodeGenFunction r z
j (a -> CodeGenFunction r z)
-> CodeGenFunction r a -> CodeGenFunction r z
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CodeGenFunction r a
a

guard ::
   (Tuple.Phi z) =>
   Value Bool -> T r z ()
guard :: forall z r. Phi z => Value Bool -> T r z ()
guard Value Bool
b = (CodeGenFunction r z
 -> (() -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z ()
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (() -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z ())
-> (CodeGenFunction r z
    -> (() -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z ()
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n () -> CodeGenFunction r z
j ->
   Value Bool
-> CodeGenFunction r z
-> CodeGenFunction r z
-> CodeGenFunction r z
forall a r.
Phi a =>
Value Bool
-> CodeGenFunction r a
-> CodeGenFunction r a
-> CodeGenFunction r a
ifThenElse Value Bool
b (() -> CodeGenFunction r z
j ()) CodeGenFunction r z
n

just :: a -> T r z a
just :: forall a r z. a -> T r z a
just a
a = (CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z a)
-> (CodeGenFunction r z
    -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall a b. (a -> b) -> a -> b
$ \ CodeGenFunction r z
_n a -> CodeGenFunction r z
j -> a -> CodeGenFunction r z
j a
a

nothing :: T r z a
nothing :: forall r z a. T r z a
nothing = (CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z a)
-> (CodeGenFunction r z
    -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n a -> CodeGenFunction r z
_j -> CodeGenFunction r z
n

bind ::
   T r z a ->
   (a -> T r z b) ->
   T r z b
bind :: forall r z a b. T r z a -> (a -> T r z b) -> T r z b
bind (Cons CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
ma) a -> T r z b
mb = (CodeGenFunction r z
 -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z b)
-> (CodeGenFunction r z
    -> (b -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z b
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n b -> CodeGenFunction r z
j ->
   CodeGenFunction r z
-> (a -> CodeGenFunction r z) -> CodeGenFunction r z
ma CodeGenFunction r z
n (\a
a -> T r z b
-> CodeGenFunction r z
-> (b -> CodeGenFunction r z)
-> CodeGenFunction r z
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
resolve (a -> T r z b
mb a
a) CodeGenFunction r z
n b -> CodeGenFunction r z
j)

{- |
Run an exception handler if the Maybe-action fails.
The exception is propagated.
That is, the handler is intended for a cleanup procedure.
-}
onFail :: CodeGenFunction r () -> T r z a -> T r z a
onFail :: forall r z a. CodeGenFunction r () -> T r z a -> T r z a
onFail CodeGenFunction r ()
handler T r z a
m = (CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall r z a.
(CodeGenFunction r z
 -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
Cons ((CodeGenFunction r z
  -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
 -> T r z a)
-> (CodeGenFunction r z
    -> (a -> CodeGenFunction r z) -> CodeGenFunction r z)
-> T r z a
forall a b. (a -> b) -> a -> b
$ \CodeGenFunction r z
n a -> CodeGenFunction r z
j -> T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
resolve T r z a
m (CodeGenFunction r ()
handler CodeGenFunction r () -> CodeGenFunction r z -> CodeGenFunction r z
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CodeGenFunction r z
n) a -> CodeGenFunction r z
j

{- |
Run the first action and if that fails run the second action.
If both actions fail, then the composed action fails, too.
-}
alternative ::
   (Tuple.Phi z, Tuple.Undefined a) =>
   T r (Maybe.T a) a -> T r (Maybe.T a) a -> T r z a
alternative :: forall z a r.
(Phi z, Undefined a) =>
T r (T a) a -> T r (T a) a -> T r z a
alternative T r (T a) a
x T r (T a) a
y =
   CodeGenFunction r (T a) -> T r z a
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
fromMaybe (CodeGenFunction r (T a) -> T r z a)
-> CodeGenFunction r (T a) -> T r z a
forall a b. (a -> b) -> a -> b
$ T r (T a) a
-> CodeGenFunction r (T a)
-> (a -> CodeGenFunction r (T a))
-> CodeGenFunction r (T a)
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
resolve T r (T a) a
x (T r (T a) a -> CodeGenFunction r (T a)
forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
toMaybe T r (T a) a
y) (T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> CodeGenFunction r (T a))
-> (a -> T a) -> a -> CodeGenFunction r (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> T a
Maybe.just)


fixedLengthLoop ::
   (Tuple.Phi s, Tuple.Undefined s,
    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i -> s ->
   (s -> T r (Maybe.T s) s) ->
   CodeGenFunction r (Value i, Maybe.T s)
fixedLengthLoop :: forall s i r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> s -> (s -> T r (T s) s) -> CodeGenFunction r (Value i, T s)
fixedLengthLoop Value i
len s
start s -> T r (T s) s
loopBody = do
   (T s
vars, Value i
i) <-
      (s, Value i)
-> ((s, Value i) -> CodeGenFunction r (Value Bool, (T s, Value i)))
-> ((T s, Value i) -> CodeGenFunction r (s, Value i))
-> CodeGenFunction r (T s, Value i)
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit (s
start, Value i
len)
         (\(s
s0, Value i
i) -> do
            Value Bool
counterRunning <- CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (CmpResult (Value i))
forall r.
CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (CmpResult (Value i))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpGT Value i
i (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero)
            (Value Bool
running, T s
ms1) <-
               Value Bool
-> (Value Bool, T s)
-> CodeGenFunction r (Value Bool, T s)
-> CodeGenFunction r (Value Bool, T s)
forall a r.
Phi a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
C.ifThen Value Bool
counterRunning (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
False, s -> T s
forall a. a -> T a
Maybe.just s
s0) (CodeGenFunction r (Value Bool, T s)
 -> CodeGenFunction r (Value Bool, T s))
-> CodeGenFunction r (Value Bool, T s)
-> CodeGenFunction r (Value Bool, T s)
forall a b. (a -> b) -> a -> b
$
               (T s -> (Value Bool, T s))
-> CodeGenFunction r (T s) -> CodeGenFunction r (Value Bool, T s)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\T s
m -> (T s -> Value Bool
forall a. T a -> Value Bool
Maybe.isJust T s
m, T s
m)) (CodeGenFunction r (T s) -> CodeGenFunction r (Value Bool, T s))
-> CodeGenFunction r (T s) -> CodeGenFunction r (Value Bool, T s)
forall a b. (a -> b) -> a -> b
$ T r (T s) s -> CodeGenFunction r (T s)
forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
toMaybe (T r (T s) s -> CodeGenFunction r (T s))
-> T r (T s) s -> CodeGenFunction r (T s)
forall a b. (a -> b) -> a -> b
$ s -> T r (T s) s
loopBody s
s0
            (Value Bool, (T s, Value i))
-> CodeGenFunction r (Value Bool, (T s, Value i))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Bool
running, (T s
ms1, Value i
i)))
         (\(T s
ms, Value i
i) ->
            (Value i -> (s, Value i))
-> CodeGenFunction r (Value i) -> CodeGenFunction r (s, Value i)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) (T s -> s
forall a. T a -> a
Maybe.fromJust T s
ms)) (CodeGenFunction r (Value i) -> CodeGenFunction r (s, Value i))
-> CodeGenFunction r (Value i) -> CodeGenFunction r (s, Value i)
forall a b. (a -> b) -> a -> b
$ Value i -> CodeGenFunction r (Value i)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.dec Value i
i)
   Value i
pos <- Value i -> Value i -> CodeGenFunction r (Value i)
forall r. Value i -> Value i -> CodeGenFunction r (Value i)
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub Value i
len Value i
i
   (Value i, T s) -> CodeGenFunction r (Value i, T s)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value i
pos, T s
vars)


{- |
If the returned position is smaller than the array size,
then returned final state is 'Maybe.nothing'.
-}
arrayLoop ::
   (Tuple.Phi s, Tuple.Undefined s, IsType a,
    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i ->
   Value (LLVM.Ptr a) -> s ->
   (Value (LLVM.Ptr a) -> s -> T r (Maybe.T (Value (LLVM.Ptr a), s)) s) ->
   CodeGenFunction r (Value i, Maybe.T s)
arrayLoop :: forall s a i r.
(Phi s, Undefined s, IsType a, Num i, IsConst i, IsInteger i,
 CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> T r (T (Value (Ptr a), s)) s)
-> CodeGenFunction r (Value i, T s)
arrayLoop Value i
len Value (Ptr a)
ptr s
start Value (Ptr a) -> s -> T r (T (Value (Ptr a), s)) s
loopBody =
   ((Value i, T (Value (Ptr a), s)) -> (Value i, T s))
-> CodeGenFunction r (Value i, T (Value (Ptr a), s))
-> CodeGenFunction r (Value i, T s)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T (Value (Ptr a), s) -> T s)
-> (Value i, T (Value (Ptr a), s)) -> (Value i, T s)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (((Value (Ptr a), s) -> s) -> T (Value (Ptr a), s) -> T s
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value (Ptr a), s) -> s
forall a b. (a, b) -> b
snd)) (CodeGenFunction r (Value i, T (Value (Ptr a), s))
 -> CodeGenFunction r (Value i, T s))
-> CodeGenFunction r (Value i, T (Value (Ptr a), s))
-> CodeGenFunction r (Value i, T s)
forall a b. (a -> b) -> a -> b
$
   Value i
-> (Value (Ptr a), s)
-> ((Value (Ptr a), s)
    -> T r (T (Value (Ptr a), s)) (Value (Ptr a), s))
-> CodeGenFunction r (Value i, T (Value (Ptr a), s))
forall s i r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> s -> (s -> T r (T s) s) -> CodeGenFunction r (Value i, T s)
fixedLengthLoop Value i
len (Value (Ptr a)
ptr,s
start) (((Value (Ptr a), s)
  -> T r (T (Value (Ptr a), s)) (Value (Ptr a), s))
 -> CodeGenFunction r (Value i, T (Value (Ptr a), s)))
-> ((Value (Ptr a), s)
    -> T r (T (Value (Ptr a), s)) (Value (Ptr a), s))
-> CodeGenFunction r (Value i, T (Value (Ptr a), s))
forall a b. (a -> b) -> a -> b
$ \(Value (Ptr a)
ptr0,s
s0) -> do
      s
s1 <- Value (Ptr a) -> s -> T r (T (Value (Ptr a), s)) s
loopBody Value (Ptr a)
ptr0 s
s0
      Value (Ptr a)
ptr1 <- CodeGenFunction r (Value (Ptr a))
-> T r (T (Value (Ptr a), s)) (Value (Ptr a))
forall r a z. CodeGenFunction r a -> T r z a
lift (CodeGenFunction r (Value (Ptr a))
 -> T r (T (Value (Ptr a), s)) (Value (Ptr a)))
-> CodeGenFunction r (Value (Ptr a))
-> T r (T (Value (Ptr a), s)) (Value (Ptr a))
forall a b. (a -> b) -> a -> b
$ Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
A.advanceArrayElementPtr Value (Ptr a)
ptr0
      (Value (Ptr a), s) -> T r (T (Value (Ptr a), s)) (Value (Ptr a), s)
forall a. a -> T r (T (Value (Ptr a), s)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Ptr a)
ptr1,s
s1)


arrayLoop2 ::
   (Tuple.Phi s, Tuple.Undefined s, IsType a, IsType b,
    Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i ->
   Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->
   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> s ->
      T r (Maybe.T (Value (LLVM.Ptr a), (Value (LLVM.Ptr b), s))) s) ->
   CodeGenFunction r (Value i, Maybe.T s)
arrayLoop2 :: forall s a b i r.
(Phi s, Undefined s, IsType a, IsType b, Num i, IsConst i,
 IsInteger i, CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> Value (Ptr b)
-> s
-> (Value (Ptr a)
    -> Value (Ptr b)
    -> s
    -> T r (T (Value (Ptr a), (Value (Ptr b), s))) s)
-> CodeGenFunction r (Value i, T s)
arrayLoop2 Value i
len Value (Ptr a)
ptrA Value (Ptr b)
ptrB s
start Value (Ptr a)
-> Value (Ptr b)
-> s
-> T r (T (Value (Ptr a), (Value (Ptr b), s))) s
loopBody =
   ((Value i, T (Value (Ptr b), s)) -> (Value i, T s))
-> CodeGenFunction r (Value i, T (Value (Ptr b), s))
-> CodeGenFunction r (Value i, T s)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T (Value (Ptr b), s) -> T s)
-> (Value i, T (Value (Ptr b), s)) -> (Value i, T s)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (((Value (Ptr b), s) -> s) -> T (Value (Ptr b), s) -> T s
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value (Ptr b), s) -> s
forall a b. (a, b) -> b
snd)) (CodeGenFunction r (Value i, T (Value (Ptr b), s))
 -> CodeGenFunction r (Value i, T s))
-> CodeGenFunction r (Value i, T (Value (Ptr b), s))
-> CodeGenFunction r (Value i, T s)
forall a b. (a -> b) -> a -> b
$
   Value i
-> Value (Ptr a)
-> (Value (Ptr b), s)
-> (Value (Ptr a)
    -> (Value (Ptr b), s)
    -> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b), s))
-> CodeGenFunction r (Value i, T (Value (Ptr b), s))
forall s a i r.
(Phi s, Undefined s, IsType a, Num i, IsConst i, IsInteger i,
 CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> T r (T (Value (Ptr a), s)) s)
-> CodeGenFunction r (Value i, T s)
arrayLoop Value i
len Value (Ptr a)
ptrA (Value (Ptr b)
ptrB,s
start) ((Value (Ptr a)
  -> (Value (Ptr b), s)
  -> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b), s))
 -> CodeGenFunction r (Value i, T (Value (Ptr b), s)))
-> (Value (Ptr a)
    -> (Value (Ptr b), s)
    -> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b), s))
-> CodeGenFunction r (Value i, T (Value (Ptr b), s))
forall a b. (a -> b) -> a -> b
$ \Value (Ptr a)
ptrAi (Value (Ptr b)
ptrB0,s
s0) -> do
      s
s1 <- Value (Ptr a)
-> Value (Ptr b)
-> s
-> T r (T (Value (Ptr a), (Value (Ptr b), s))) s
loopBody Value (Ptr a)
ptrAi Value (Ptr b)
ptrB0 s
s0
      Value (Ptr b)
ptrB1 <- CodeGenFunction r (Value (Ptr b))
-> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b))
forall r a z. CodeGenFunction r a -> T r z a
lift (CodeGenFunction r (Value (Ptr b))
 -> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b)))
-> CodeGenFunction r (Value (Ptr b))
-> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b))
forall a b. (a -> b) -> a -> b
$ Value (Ptr b) -> CodeGenFunction r (Value (Ptr b))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
A.advanceArrayElementPtr Value (Ptr b)
ptrB0
      (Value (Ptr b), s)
-> T r (T (Value (Ptr a), (Value (Ptr b), s))) (Value (Ptr b), s)
forall a. a -> T r (T (Value (Ptr a), (Value (Ptr b), s))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Ptr b)
ptrB1,s
s1)


{-
In case of early exit we would not have a final state.
However, the loop could be in the T monad
and we could just propagate a Nothing.

whileLoop ::
   Tuple.Phi a =>
   a ->
   (a -> T r z a) ->
   CodeGenFunction r a
whileLoop start check body = do
   top <- getCurrentBasicBlock
   loop <- newBasicBlock
   cont <- newBasicBlock
   exit <- newBasicBlock
   br loop

   defineBasicBlock loop
   state <- phi top start
   b <- check state
   condBr b cont exit
   defineBasicBlock cont
   res <- body state
   cont' <- getCurrentBasicBlock
   addPhi cont' state res
   br loop

   defineBasicBlock exit
   return state
-}