{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
module LLVM.Extra.Iterator (
   T,
   -- * consumers
   mapM_,
   mapState_,
   mapStateM_,
   mapWhileState_,
   -- * producers
   empty,
   singleton,
   cons,
   iterate,
   countDown,
   arrayPtrs,
   storableArrayPtrs,
   -- * modifiers
   mapM,
   mapMaybe,
   catMaybes,
   takeWhileJust,
   takeWhile,
   cartesian,
   take,
   -- * application examples
   fixedLengthLoop,
   arrayLoop,
   arrayLoopWithExit,
   arrayLoop2,
   ) where

import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Maybe as Maybe

import qualified LLVM.Extra.Storable as Storable
import qualified LLVM.Extra.ArithmeticPrivate as A
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Control as C
import qualified LLVM.Core as LLVM
import LLVM.Core
   (CodeGenFunction, Value, value, valueOf,
    CmpRet, IsInteger, IsType, IsConst, IsPrimitive)

import Foreign.Ptr (Ptr, )

import qualified Control.Monad.Trans.State as MS
import qualified Control.Applicative as App
import qualified Control.Functor.HT as FuncHT
import Control.Monad (void, (<=<), )
import Control.Applicative (Applicative, liftA2, (<$>), (<$), )

import Data.Tuple.HT (mapFst, mapSnd, )

import Prelude2010 hiding (iterate, takeWhile, take, mapM, mapM_)
import Prelude ()


{- |
Simulates a non-strict list.
-}
data T r a =
   forall s. (Tuple.Phi s, Tuple.Undefined s) =>
   Cons s (forall z. (Tuple.Phi z) => s -> MaybeCont.T r z (a,s))

mapM_ :: (a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r ()
mapM_ :: forall a r.
(a -> CodeGenFunction r ()) -> T r a -> CodeGenFunction r ()
mapM_ a -> CodeGenFunction r ()
f (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) =
   CodeGenFunction r s -> CodeGenFunction r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CodeGenFunction r s -> CodeGenFunction r ())
-> CodeGenFunction r s -> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$
   s
-> (s -> CodeGenFunction r (Value Bool, s))
-> (s -> CodeGenFunction r s)
-> CodeGenFunction r s
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit s
s
      (\s
s0 ->
         T r (Value Bool, s) (a, s)
-> CodeGenFunction r (Value Bool, s)
-> ((a, s) -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value Bool, s)
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (s -> T r (Value Bool, s) (a, s)
forall z. Phi z => s -> T r z (a, s)
next s
s0)
            ((Value Bool, s) -> CodeGenFunction r (Value Bool, s)
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, s
s0))
            (\(a
a,s
s1) -> (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True, s
s1) (Value Bool, s)
-> CodeGenFunction r () -> CodeGenFunction r (Value Bool, s)
forall a b. a -> CodeGenFunction r b -> CodeGenFunction r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> CodeGenFunction r ()
f a
a))
      s -> CodeGenFunction r s
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return

mapState_ ::
   (Tuple.Phi t) =>
   (a -> t -> CodeGenFunction r t) ->
   T r a -> t -> CodeGenFunction r t
mapState_ :: forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
mapState_ a -> t -> CodeGenFunction r t
f (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) t
t =
   (s, t) -> t
forall a b. (a, b) -> b
snd ((s, t) -> t) -> CodeGenFunction r (s, t) -> CodeGenFunction r t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   (s, t)
-> ((s, t) -> CodeGenFunction r (Value Bool, (s, t)))
-> ((s, t) -> CodeGenFunction r (s, t))
-> CodeGenFunction r (s, t)
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit (s
s,t
t)
      (\(s
s0,t
t0) ->
         T r (Value Bool, (s, t)) (a, s)
-> CodeGenFunction r (Value Bool, (s, t))
-> ((a, s) -> CodeGenFunction r (Value Bool, (s, t)))
-> CodeGenFunction r (Value Bool, (s, t))
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (s -> T r (Value Bool, (s, t)) (a, s)
forall z. Phi z => s -> T r z (a, s)
next s
s0)
            ((Value Bool, (s, t)) -> CodeGenFunction r (Value Bool, (s, t))
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, (s
s0,t
t0)))
            (\(a
a,s
s1) -> (\t
t1 -> (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True, (s
s1,t
t1))) (t -> (Value Bool, (s, t)))
-> CodeGenFunction r t -> CodeGenFunction r (Value Bool, (s, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> t -> CodeGenFunction r t
f a
a t
t0))
      (s, t) -> CodeGenFunction r (s, t)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return

mapStateM_ ::
   (Tuple.Phi t) =>
   (a -> MS.StateT t (CodeGenFunction r) ()) ->
   T r a -> MS.StateT t (CodeGenFunction r) ()
mapStateM_ :: forall t a r.
Phi t =>
(a -> StateT t (CodeGenFunction r) ())
-> T r a -> StateT t (CodeGenFunction r) ()
mapStateM_ a -> StateT t (CodeGenFunction r) ()
f T r a
xs =
   (t -> CodeGenFunction r ((), t)) -> StateT t (CodeGenFunction r) ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT ((t -> CodeGenFunction r ((), t))
 -> StateT t (CodeGenFunction r) ())
-> (t -> CodeGenFunction r ((), t))
-> StateT t (CodeGenFunction r) ()
forall a b. (a -> b) -> a -> b
$ \t
t ->
      (,) () (t -> ((), t)) -> CodeGenFunction r t -> CodeGenFunction r ((), t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
mapState_ (\a
a t
t0 -> ((), t) -> t
forall a b. (a, b) -> b
snd (((), t) -> t) -> CodeGenFunction r ((), t) -> CodeGenFunction r t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT t (CodeGenFunction r) () -> t -> CodeGenFunction r ((), t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT (a -> StateT t (CodeGenFunction r) ()
f a
a) t
t0) T r a
xs t
t


mapWhileState_ ::
   (Tuple.Phi t) =>
   (a -> t -> CodeGenFunction r (Value Bool, t)) ->
   T r a -> t -> CodeGenFunction r t
mapWhileState_ :: forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r (Value Bool, t))
-> T r a -> t -> CodeGenFunction r t
mapWhileState_ a -> t -> CodeGenFunction r (Value Bool, t)
f (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) t
t =
   (s, t) -> t
forall a b. (a, b) -> b
snd ((s, t) -> t) -> CodeGenFunction r (s, t) -> CodeGenFunction r t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   (s, t)
-> ((s, t) -> CodeGenFunction r (Value Bool, (s, t)))
-> ((s, t) -> CodeGenFunction r (s, t))
-> CodeGenFunction r (s, t)
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit (s
s,t
t)
      (\(s
s0,t
t0) ->
         T r (Value Bool, (s, t)) (a, s)
-> CodeGenFunction r (Value Bool, (s, t))
-> ((a, s) -> CodeGenFunction r (Value Bool, (s, t)))
-> CodeGenFunction r (Value Bool, (s, t))
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (s -> T r (Value Bool, (s, t)) (a, s)
forall z. Phi z => s -> T r z (a, s)
next s
s0)
            ((Value Bool, (s, t)) -> CodeGenFunction r (Value Bool, (s, t))
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, (s
s0,t
t0)))
            (\(a
a,s
s1) -> (\(Value Bool
b,t
t1) -> (Value Bool
b, (s
s1,t
t1))) ((Value Bool, t) -> (Value Bool, (s, t)))
-> CodeGenFunction r (Value Bool, t)
-> CodeGenFunction r (Value Bool, (s, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> t -> CodeGenFunction r (Value Bool, t)
f a
a t
t0))
      (s, t) -> CodeGenFunction r (s, t)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return


empty :: T r a
empty :: forall r a. T r a
empty = () -> (forall z. Phi z => () -> T r z (a, ())) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons () (\() -> T r z (a, ())
forall r z a. T r z a
MaybeCont.nothing)

singleton :: a -> T r a
singleton :: forall a r. a -> T r a
singleton a
a =
   Value Bool
-> (forall z. Phi z => Value Bool -> T r z (a, Value Bool))
-> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons
      (Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
True)
      (\Value Bool
running -> Value Bool -> T r z ()
forall z r. Phi z => Value Bool -> T r z ()
MaybeCont.guard Value Bool
running T r z () -> T r z (a, Value Bool) -> T r z (a, Value Bool)
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, Value Bool) -> T r z (a, Value Bool)
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Bool -> Value Bool
forall a. IsConst a => a -> Value a
valueOf Bool
False))

cons :: (Tuple.Phi a, Tuple.Undefined a) => a -> T r a -> T r a
cons :: forall a r. (Phi a, Undefined a) => a -> T r a -> T r a
cons a
a0 (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) =
   T s -> (forall z. Phi z => T s -> T r z (a, T s)) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons T s
forall a. Undefined a => T a
Maybe.nothing
      (((a, s) -> (a, T s)) -> T r z (a, s) -> T r z (a, T s)
forall a b. (a -> b) -> T r z a -> T r z b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> T s) -> (a, s) -> (a, T s)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd s -> T s
forall a. a -> T a
Maybe.just) (T r z (a, s) -> T r z (a, T s))
-> (T s -> T r z (a, s)) -> T s -> T r z (a, T s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       CodeGenFunction r (T (a, s)) -> T r z (a, s)
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (a, s)) -> T r z (a, s))
-> (T s -> CodeGenFunction r (T (a, s))) -> T s -> T r z (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       (\T s
ms -> T s
-> CodeGenFunction r (T (a, s))
-> (s -> CodeGenFunction r (T (a, s)))
-> CodeGenFunction r (T (a, s))
forall b a r.
Phi b =>
T a
-> CodeGenFunction r b
-> (a -> CodeGenFunction r b)
-> CodeGenFunction r b
Maybe.run T s
ms
         (T (a, s) -> CodeGenFunction r (T (a, s))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (a, s) -> CodeGenFunction r (T (a, s)))
-> T (a, s) -> CodeGenFunction r (T (a, s))
forall a b. (a -> b) -> a -> b
$ (a, s) -> T (a, s)
forall a. a -> T a
Maybe.just (a
a0,s
s))
         (T r (T (a, s)) (a, s) -> CodeGenFunction r (T (a, s))
forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
MaybeCont.toMaybe (T r (T (a, s)) (a, s) -> CodeGenFunction r (T (a, s)))
-> (s -> T r (T (a, s)) (a, s))
-> s
-> CodeGenFunction r (T (a, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> T r (T (a, s)) (a, s)
forall z. Phi z => s -> T r z (a, s)
next)))


instance Functor (T r) where
   fmap :: forall a b. (a -> b) -> T r a -> T r b
fmap a -> b
f (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) = s -> (forall z. Phi z => s -> T r z (b, s)) -> T r b
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons s
s (\s
s0 -> (a -> b) -> (a, s) -> (b, s)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst a -> b
f ((a, s) -> (b, s)) -> T r z (a, s) -> T r z (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> T r z (a, s)
forall z. Phi z => s -> T r z (a, s)
next s
s0)

{- |
@ZipList@ semantics
-}
instance Applicative (T r) where
   pure :: forall a. a -> T r a
pure a
a = () -> (forall z. Phi z => () -> T r z (a, ())) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons () (\() -> (a, ()) -> T r z (a, ())
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,()))
   Cons s
fs forall z. Phi z => s -> T r z (a -> b, s)
fnext <*> :: forall a b. T r (a -> b) -> T r a -> T r b
<*> Cons s
as forall z. Phi z => s -> T r z (a, s)
anext =
      (s, s) -> (forall z. Phi z => (s, s) -> T r z (b, (s, s))) -> T r b
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons (s
fs,s
as)
         (\(s
fs0,s
as0) -> do
            (a -> b
f,s
fs1) <- s -> T r z (a -> b, s)
forall z. Phi z => s -> T r z (a -> b, s)
fnext s
fs0
            (a
a,s
as1) <- s -> T r z (a, s)
forall z. Phi z => s -> T r z (a, s)
anext s
as0
            (b, (s, s)) -> T r z (b, (s, s))
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, (s
fs1,s
as1)))


{-
On the one hand,
I did not want to name it @map@ because it differs from @fmap@.
On the other hand, @mapM@ does not fit very well
because the result is not in the CodeGenFunction monad.
-}
mapM :: (a -> CodeGenFunction r b) -> T r a -> T r b
mapM :: forall a r b. (a -> CodeGenFunction r b) -> T r a -> T r b
mapM a -> CodeGenFunction r b
f (Cons s
s forall z. Phi z => s -> T r z (a, s)
next) = s -> (forall z. Phi z => s -> T r z (b, s)) -> T r b
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons s
s (CodeGenFunction r (b, s) -> T r z (b, s)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (b, s) -> T r z (b, s))
-> ((a, s) -> CodeGenFunction r (b, s)) -> (a, s) -> T r z (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CodeGenFunction r b) -> (a, s) -> CodeGenFunction r (b, s)
forall (f :: * -> *) a c b.
Functor f =>
(a -> f c) -> (a, b) -> f (c, b)
FuncHT.mapFst a -> CodeGenFunction r b
f ((a, s) -> T r z (b, s))
-> (s -> T r z (a, s)) -> s -> T r z (b, s)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> T r z (a, s)
forall z. Phi z => s -> T r z (a, s)
next)

mapMaybe ::
   (Tuple.Phi b, Tuple.Undefined b) =>
   (a -> CodeGenFunction r (Maybe.T b)) -> T r a -> T r b
mapMaybe :: forall b a r.
(Phi b, Undefined b) =>
(a -> CodeGenFunction r (T b)) -> T r a -> T r b
mapMaybe a -> CodeGenFunction r (T b)
f = T r (T b) -> T r b
forall a r. (Phi a, Undefined a) => T r (T a) -> T r a
catMaybes (T r (T b) -> T r b) -> (T r a -> T r (T b)) -> T r a -> T r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CodeGenFunction r (T b)) -> T r a -> T r (T b)
forall a r b. (a -> CodeGenFunction r b) -> T r a -> T r b
mapM a -> CodeGenFunction r (T b)
f

catMaybes :: (Tuple.Phi a, Tuple.Undefined a) => T r (Maybe.T a) -> T r a
catMaybes :: forall a r. (Phi a, Undefined a) => T r (T a) -> T r a
catMaybes (Cons s
s forall z. Phi z => s -> T r z (T a, s)
next) =
   s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons s
s
      (\s
s0 ->
         CodeGenFunction r (T (a, s)) -> T r z (a, s)
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (a, s)) -> T r z (a, s))
-> CodeGenFunction r (T (a, s)) -> T r z (a, s)
forall a b. (a -> b) -> a -> b
$
         ((T a, s) -> T (a, s))
-> CodeGenFunction r (T a, s) -> CodeGenFunction r (T (a, 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 a
ma,s
s2) -> (a -> (a, s)) -> T a -> T (a, s)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> s -> (a, s)) -> s -> a -> (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) s
s2) T a
ma) (CodeGenFunction r (T a, s) -> CodeGenFunction r (T (a, s)))
-> CodeGenFunction r (T a, s) -> CodeGenFunction r (T (a, s))
forall a b. (a -> b) -> a -> b
$
         s
-> (s -> CodeGenFunction r (Value Bool, (T a, s)))
-> ((T a, s) -> CodeGenFunction r s)
-> CodeGenFunction r (T a, s)
forall a r b.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool, b))
-> (b -> CodeGenFunction r a)
-> CodeGenFunction r b
C.loopWithExit s
s0
            (\s
s1 ->
               T r (Value Bool, (T a, s)) (T a, s)
-> CodeGenFunction r (Value Bool, (T a, s))
-> ((T a, s) -> CodeGenFunction r (Value Bool, (T a, s)))
-> CodeGenFunction r (Value Bool, (T a, s))
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (s -> T r (Value Bool, (T a, s)) (T a, s)
forall z. Phi z => s -> T r z (T a, s)
next s
s1)
                  ((Value Bool, (T a, s)) -> CodeGenFunction r (Value Bool, (T a, s))
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, (T a
forall a. Undefined a => T a
Maybe.nothing, s
s1)))
                  (\(T a
ma,s
s2) ->
                     T a
-> CodeGenFunction r (Value Bool, (T a, s))
-> (a -> CodeGenFunction r (Value Bool, (T a, s)))
-> CodeGenFunction r (Value Bool, (T a, s))
forall b a r.
Phi b =>
T a
-> CodeGenFunction r b
-> (a -> CodeGenFunction r b)
-> CodeGenFunction r b
Maybe.run T a
ma
                        ((Value Bool, (T a, s)) -> CodeGenFunction r (Value Bool, (T a, s))
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, (T a
forall a. Undefined a => T a
Maybe.nothing, s
s2)))
                        (\a
a -> (Value Bool, (T a, s)) -> CodeGenFunction r (Value Bool, (T a, s))
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 -> T a
forall a. a -> T a
Maybe.just a
a, s
s2)))))
            (s -> CodeGenFunction r s
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> CodeGenFunction r s)
-> ((T a, s) -> s) -> (T a, s) -> CodeGenFunction r s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a, s) -> s
forall a b. (a, b) -> b
snd))

takeWhileJust :: T r (Maybe.T a) -> T r a
takeWhileJust :: forall r a. T r (T a) -> T r a
takeWhileJust (Cons s
s forall z. Phi z => s -> T r z (T a, s)
next) =
   s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons s
s ((T a -> T r z a) -> (T a, s) -> T r z (a, s)
forall (f :: * -> *) a c b.
Functor f =>
(a -> f c) -> (a, b) -> f (c, b)
FuncHT.mapFst T a -> T r z a
forall z a r. Phi z => T a -> T r z a
MaybeCont.fromPlainMaybe ((T a, s) -> T r z (a, s))
-> (s -> T r z (T a, s)) -> s -> T r z (a, s)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> T r z (T a, s)
forall z. Phi z => s -> T r z (T a, s)
next)

takeWhile :: (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a
takeWhile :: forall a r. (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a
takeWhile a -> CodeGenFunction r (Value Bool)
p = T r (T a) -> T r a
forall r a. T r (T a) -> T r a
takeWhileJust (T r (T a) -> T r a) -> (T r a -> T r (T a)) -> T r a -> T r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CodeGenFunction r (T a)) -> T r a -> T r (T a)
forall a r b. (a -> CodeGenFunction r b) -> T r a -> T r b
mapM (\a
a -> (Value Bool -> a -> T a) -> a -> Value Bool -> T a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Bool -> a -> T a
forall a. Value Bool -> a -> T a
Maybe.fromBool a
a (Value Bool -> T a)
-> CodeGenFunction r (Value Bool) -> CodeGenFunction r (T a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> CodeGenFunction r (Value Bool)
p a
a)

{- |
Attention:
This always performs one function call more than necessary.
I.e. if 'f' reads from or writes to memory
make sure that accessing one more pointer is legal.
-}
iterate ::
   (Tuple.Phi a, Tuple.Undefined a) => (a -> CodeGenFunction r a) -> a -> T r a
iterate :: forall a r.
(Phi a, Undefined a) =>
(a -> CodeGenFunction r a) -> a -> T r a
iterate a -> CodeGenFunction r a
f a
a = a -> (forall z. Phi z => a -> T r z (a, a)) -> T r a
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons a
a (\a
a0 -> CodeGenFunction r (a, a) -> T r z (a, a)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (a, a) -> T r z (a, a))
-> CodeGenFunction r (a, a) -> T r z (a, a)
forall a b. (a -> b) -> a -> b
$ (a -> (a, a)) -> CodeGenFunction r a -> CodeGenFunction r (a, a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) a
a0) (CodeGenFunction r a -> CodeGenFunction r (a, a))
-> CodeGenFunction r a -> CodeGenFunction r (a, a)
forall a b. (a -> b) -> a -> b
$ a -> CodeGenFunction r a
f a
a0)


cartesianAux ::
   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined a, Tuple.Undefined b) =>
   T r a -> T r b -> T r (Maybe.T (a,b))
cartesianAux :: forall a b r.
(Phi a, Phi b, Undefined a, Undefined b) =>
T r a -> T r b -> T r (T (a, b))
cartesianAux (Cons s
sa forall z. Phi z => s -> T r z (a, s)
nextA) (Cons s
sb forall z. Phi z => s -> T r z (b, s)
nextB) =
   (T a, s, s)
-> (forall z.
    Phi z =>
    (T a, s, s) -> T r z (T (a, b), (T a, s, s)))
-> T r (T (a, b))
forall r a s.
(Phi s, Undefined s) =>
s -> (forall z. Phi z => s -> T r z (a, s)) -> T r a
Cons (T a
forall a. Undefined a => T a
Maybe.nothing,s
sa,s
sb)
      (\(T a
ma0,s
sa0,s
sb0) -> do
         (a
a1,s
sa1) <-
            T r (T (a, s)) (a, s) -> T r (T (a, s)) (a, s) -> T r z (a, s)
forall z a r.
(Phi z, Undefined a) =>
T r (T a) a -> T r (T a) a -> T r z a
MaybeCont.alternative
               (CodeGenFunction r (T (a, s)) -> T r (T (a, s)) (a, s)
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (a, s)) -> T r (T (a, s)) (a, s))
-> CodeGenFunction r (T (a, s)) -> T r (T (a, s)) (a, s)
forall a b. (a -> b) -> a -> b
$ T (a, s) -> CodeGenFunction r (T (a, s))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (a, s) -> CodeGenFunction r (T (a, s)))
-> T (a, s) -> CodeGenFunction r (T (a, s))
forall a b. (a -> b) -> a -> b
$ (a -> (a, s)) -> T a -> T (a, s)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> s -> (a, s)) -> s -> a -> (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) s
sa0) T a
ma0)
               (s -> T r (T (a, s)) (a, s)
forall z. Phi z => s -> T r z (a, s)
nextA s
sa0)
         CodeGenFunction r (T (a, b), (T a, s, s))
-> T r z (T (a, b), (T a, s, s))
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T (a, b), (T a, s, s))
 -> T r z (T (a, b), (T a, s, s)))
-> CodeGenFunction r (T (a, b), (T a, s, s))
-> T r z (T (a, b), (T a, s, s))
forall a b. (a -> b) -> a -> b
$
            T r (T (a, b), (T a, s, s)) (b, s)
-> CodeGenFunction r (T (a, b), (T a, s, s))
-> ((b, s) -> CodeGenFunction r (T (a, b), (T a, s, s)))
-> CodeGenFunction r (T (a, b), (T a, s, s))
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (s -> T r (T (a, b), (T a, s, s)) (b, s)
forall z. Phi z => s -> T r z (b, s)
nextB s
sb0)
               ((T (a, b), (T a, s, s))
-> CodeGenFunction r (T (a, b), (T a, s, s))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (a, b)
forall a. Undefined a => T a
Maybe.nothing,(T a
forall a. Undefined a => T a
Maybe.nothing,s
sa1,s
sb)))
               (\(b
b1,s
sb1) ->
                  (T (a, b), (T a, s, s))
-> CodeGenFunction r (T (a, b), (T a, s, s))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> T (a, b)
forall a. a -> T a
Maybe.just (a
a1,b
b1), (a -> T a
forall a. a -> T a
Maybe.just a
a1, s
sa1, s
sb1))))

cartesian ::
   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined a, Tuple.Undefined b) =>
   T r a -> T r b -> T r (a,b)
cartesian :: forall a b r.
(Phi a, Phi b, Undefined a, Undefined b) =>
T r a -> T r b -> T r (a, b)
cartesian T r a
as T r b
bs = T r (T (a, b)) -> T r (a, b)
forall a r. (Phi a, Undefined a) => T r (T a) -> T r a
catMaybes (T r (T (a, b)) -> T r (a, b)) -> T r (T (a, b)) -> T r (a, b)
forall a b. (a -> b) -> a -> b
$ T r a -> T r b -> T r (T (a, b))
forall a b r.
(Phi a, Phi b, Undefined a, Undefined b) =>
T r a -> T r b -> T r (T (a, b))
cartesianAux T r a
as T r b
bs

countDown ::
   (Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i -> T r (Value i)
countDown :: forall i r.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r (Value i)
countDown Value i
len =
   (Value i -> CodeGenFunction r (Value Bool))
-> T r (Value i) -> T r (Value i)
forall a r. (a -> CodeGenFunction r (Value Bool)) -> T r a -> T r a
takeWhile (CmpPredicate
-> Value i -> Value i -> CodeGenFunction r (Value Bool)
forall a b r.
(CmpRet a, CmpResult a ~ b) =>
CmpPredicate -> Value a -> Value a -> CodeGenFunction r (Value b)
A.cmp CmpPredicate
LLVM.CmpLT (ConstValue i -> Value i
forall a. ConstValue a -> Value a
value ConstValue i
forall a. IsType a => ConstValue a
LLVM.zero)) (T r (Value i) -> T r (Value i)) -> T r (Value i) -> T r (Value i)
forall a b. (a -> b) -> a -> b
$ (Value i -> CodeGenFunction r (Value i))
-> Value i -> T r (Value i)
forall a r.
(Phi a, Undefined a) =>
(a -> CodeGenFunction r a) -> a -> T r a
iterate 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
len

take ::
   (Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i -> T r a -> T r a
take :: forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
take Value i
len T r a
xs = (a -> Value i -> a) -> T r a -> T r (Value i) -> T r a
forall a b c. (a -> b -> c) -> T r a -> T r b -> T r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> Value i -> a
forall a b. a -> b -> a
const T r a
xs (Value i -> T r (Value i)
forall i r.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r (Value i)
countDown Value i
len)

arrayPtrs :: (IsType a) => Value (LLVM.Ptr a) -> T r (Value (LLVM.Ptr a))
arrayPtrs :: forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
arrayPtrs = (Value (Ptr a) -> CodeGenFunction r (Value (Ptr a)))
-> Value (Ptr a) -> T r (Value (Ptr a))
forall a r.
(Phi a, Undefined a) =>
(a -> CodeGenFunction r a) -> a -> T r a
iterate Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
forall a r.
IsType a =>
Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
A.advanceArrayElementPtr

storableArrayPtrs :: (Storable.C a) => Value (Ptr a) -> T r (Value (Ptr a))
storableArrayPtrs :: forall a r. C a => Value (Ptr a) -> T r (Value (Ptr a))
storableArrayPtrs = (Value (Ptr a) -> CodeGenFunction r (Value (Ptr a)))
-> Value (Ptr a) -> T r (Value (Ptr a))
forall a r.
(Phi a, Undefined a) =>
(a -> CodeGenFunction r a) -> a -> T r a
iterate Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
forall a ptr r.
(Storable a, Value (Ptr a) ~ ptr) =>
ptr -> CodeGenFunction r ptr
Storable.incrementPtr


-- * examples

fixedLengthLoop ::
   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i -> s ->
   (s -> CodeGenFunction r s) ->
   CodeGenFunction r s
fixedLengthLoop :: forall s i r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> s -> (s -> CodeGenFunction r s) -> CodeGenFunction r s
fixedLengthLoop Value i
len s
start s -> CodeGenFunction r s
loopBody =
   (Value i -> s -> CodeGenFunction r s)
-> T r (Value i) -> s -> CodeGenFunction r s
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
mapState_ ((s -> CodeGenFunction r s) -> Value i -> s -> CodeGenFunction r s
forall a b. a -> b -> a
const s -> CodeGenFunction r s
loopBody) (Value i -> T r (Value i)
forall i r.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r (Value i)
countDown Value i
len) s
start

arrayLoop ::
   (Tuple.Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
   Value i -> Value (LLVM.Ptr b) -> a ->
   (Value (LLVM.Ptr b) -> a -> CodeGenFunction r a) ->
   CodeGenFunction r a
arrayLoop :: forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
arrayLoop Value i
len Value (Ptr b)
ptr a
start Value (Ptr b) -> a -> CodeGenFunction r a
loopBody =
   (Value (Ptr b) -> a -> CodeGenFunction r a)
-> T r (Value (Ptr b)) -> a -> CodeGenFunction r a
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
mapState_ Value (Ptr b) -> a -> CodeGenFunction r a
loopBody (Value i -> T r (Value (Ptr b)) -> T r (Value (Ptr b))
forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
take Value i
len (T r (Value (Ptr b)) -> T r (Value (Ptr b)))
-> T r (Value (Ptr b)) -> T r (Value (Ptr b))
forall a b. (a -> b) -> a -> b
$ Value (Ptr b) -> T r (Value (Ptr b))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
arrayPtrs Value (Ptr b)
ptr) a
start

arrayLoopWithExit ::
   (Tuple.Phi 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 -> CodeGenFunction r (Value Bool, s)) ->
   CodeGenFunction r (Value i, s)
arrayLoopWithExit :: forall s a i r.
(Phi s, IsType a, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s))
-> CodeGenFunction r (Value i, s)
arrayLoopWithExit Value i
len Value (Ptr a)
ptr0 s
start Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)
loopBody = do
   (Value i
i, s
end) <-
      ((Value i, Value (Ptr a))
 -> (Value i, s) -> CodeGenFunction r (Value Bool, (Value i, s)))
-> T r (Value i, Value (Ptr a))
-> (Value i, s)
-> CodeGenFunction r (Value i, s)
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r (Value Bool, t))
-> T r a -> t -> CodeGenFunction r t
mapWhileState_
         (\(Value i
i,Value (Ptr a)
ptr) (Value i
_i,s
s) -> (s -> (Value i, s))
-> (Value Bool, s) -> (Value Bool, (Value i, s))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) Value i
i) ((Value Bool, s) -> (Value Bool, (Value i, s)))
-> CodeGenFunction r (Value Bool, s)
-> CodeGenFunction r (Value Bool, (Value i, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (Ptr a) -> s -> CodeGenFunction r (Value Bool, s)
loopBody Value (Ptr a)
ptr s
s)
         ((Value i -> Value (Ptr a) -> (Value i, Value (Ptr a)))
-> T r (Value i)
-> T r (Value (Ptr a))
-> T r (Value i, Value (Ptr a))
forall a b c. (a -> b -> c) -> T r a -> T r b -> T r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Value i -> T r (Value i)
forall i r.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r (Value i)
countDown Value i
len) (Value (Ptr a) -> T r (Value (Ptr a))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
arrayPtrs Value (Ptr a)
ptr0))
         (Value i
len,s
start)
   Value i
pos <- Value i -> Value i -> CodeGenFunction r (Value i)
forall a r.
IsArithmetic a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.sub Value i
len Value i
i
   (Value i, s) -> CodeGenFunction r (Value i, s)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value i
pos, s
end)

arrayLoop2 ::
   (Tuple.Phi 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 -> CodeGenFunction r s) ->
   CodeGenFunction r s
arrayLoop2 :: forall s a b i r.
(Phi 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 -> CodeGenFunction r s)
-> CodeGenFunction r s
arrayLoop2 Value i
len Value (Ptr a)
ptrA Value (Ptr b)
ptrB s
start Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s
loopBody =
   ((Value (Ptr a), Value (Ptr b)) -> s -> CodeGenFunction r s)
-> T r (Value (Ptr a), Value (Ptr b)) -> s -> CodeGenFunction r s
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r t)
-> T r a -> t -> CodeGenFunction r t
mapState_ ((Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s)
-> (Value (Ptr a), Value (Ptr b)) -> s -> CodeGenFunction r s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value (Ptr a) -> Value (Ptr b) -> s -> CodeGenFunction r s
loopBody)
      (Value i
-> T r (Value (Ptr a), Value (Ptr b))
-> T r (Value (Ptr a), Value (Ptr b))
forall i r a.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r a -> T r a
take Value i
len (T r (Value (Ptr a), Value (Ptr b))
 -> T r (Value (Ptr a), Value (Ptr b)))
-> T r (Value (Ptr a), Value (Ptr b))
-> T r (Value (Ptr a), Value (Ptr b))
forall a b. (a -> b) -> a -> b
$ (Value (Ptr a) -> Value (Ptr b) -> (Value (Ptr a), Value (Ptr b)))
-> T r (Value (Ptr a))
-> T r (Value (Ptr b))
-> T r (Value (Ptr a), Value (Ptr b))
forall a b c. (a -> b -> c) -> T r a -> T r b -> T r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Value (Ptr a) -> T r (Value (Ptr a))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
arrayPtrs Value (Ptr a)
ptrA) (Value (Ptr b) -> T r (Value (Ptr b))
forall a r. IsType a => Value (Ptr a) -> T r (Value (Ptr a))
arrayPtrs Value (Ptr b)
ptrB)) s
start