{-# LANGUAGE TypeFamilies #-}
{- |
Loops over Storable arrays.
-}
module LLVM.Extra.Storable.Array where

import qualified LLVM.Extra.Storable.Private as Storable
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Maybe as Maybe
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Control as C
import LLVM.Core
   (CodeGenFunction, Value, CmpRet, IsInteger, IsConst, IsPrimitive)

import Foreign.Ptr (Ptr)

import Control.Monad (liftM2)

import Data.Tuple.HT (mapSnd)


arrayLoop ::
   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
    Storable.C a, Value (Ptr a) ~ ptrA) =>
   Value i -> ptrA -> s ->
   (ptrA -> s -> CodeGenFunction r s) ->
   CodeGenFunction r s
arrayLoop len ptr start body =
   fmap snd $
   C.fixedLengthLoop len (ptr, start) $ \(p,s) ->
      liftM2 (,) (Storable.incrementPtr p) (body p s)

arrayLoop2 ::
   (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
    Storable.C a, Value (Ptr a) ~ ptrA,
    Storable.C b, Value (Ptr b) ~ ptrB) =>
   Value i -> ptrA -> ptrB -> s ->
   (ptrA -> ptrB -> s -> CodeGenFunction r s) ->
   CodeGenFunction r s
arrayLoop2 len ptrA ptrB start body =
   fmap snd $
   arrayLoop len ptrA (ptrB,start) $ \pa (pb,s) ->
      liftM2 (,) (Storable.incrementPtr pb) (body pa pb s)


arrayLoopMaybeCont ::
   (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
    Storable.C a, Value (Ptr a) ~ ptrA,
    Maybe.T (ptrA, s) ~ z) =>
   Value i ->
   ptrA -> s ->
   (ptrA -> s -> MaybeCont.T r z s) ->
   CodeGenFunction r (Value i, Maybe.T s)
arrayLoopMaybeCont len ptr start body =
   fmap (mapSnd (fmap snd)) $
   MaybeCont.fixedLengthLoop len (ptr,start) $ \(ptr0,s0) ->
      liftM2 (,)
         (MaybeCont.lift $ Storable.incrementPtr ptr0)
         (body ptr0 s0)

arrayLoopMaybeCont2 ::
   (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
    Storable.C a, Value (Ptr a) ~ ptrA,
    Storable.C b, Value (Ptr b) ~ ptrB,
    Maybe.T (ptrA, (ptrB, s)) ~ z) =>
   Value i ->
   ptrA -> ptrB -> s ->
   (ptrA -> ptrB -> s -> MaybeCont.T r z s) ->
   CodeGenFunction r (Value i, Maybe.T s)
arrayLoopMaybeCont2 len ptrA ptrB start body =
   fmap (mapSnd (fmap snd)) $
   arrayLoopMaybeCont len ptrA (ptrB,start) $ \ptrAi (ptrB0,s0) ->
      liftM2 (,)
         (MaybeCont.lift $ Storable.incrementPtr ptrB0)
         (body ptrAi ptrB0 s0)