module LLVM.Extra.Array (
   size,
   assemble,
   extractAll,
   map,
   ) where

import qualified LLVM.Extra.Class as Class

import qualified LLVM.Core as LLVM
import LLVM.Core (Value, Array, CodeGenFunction, )

import qualified Types.Data.Num as TypeNum
import Control.Monad.HT ((<=<), )
import Control.Monad (foldM, )
import qualified Data.List as List

import Data.Word (Word32, )

import Prelude hiding
          (Real, truncate, floor, round,
           map, zipWith, iterate, replicate, reverse, concat, sum, )


-- * target independent functions

size ::
   (TypeNum.NaturalT n) =>
   Value (Array n a) -> Int
size =
   let sz :: (TypeNum.NaturalT n) => n -> Value (Array n a) -> Int
       sz n _ = TypeNum.fromIntegerT n
   in  sz undefined

{- |
construct an array out of single elements

You must assert that the length of the list matches the array size.

This can be considered the inverse of 'extractAll'.
-}
assemble ::
   (TypeNum.NaturalT n, LLVM.IsFirstClass a, LLVM.IsSized a) =>
   [Value a] -> CodeGenFunction r (Value (Array n a))
assemble =
   foldM (\v (k,x) -> LLVM.insertvalue v x (k::Word32)) Class.undefTuple .
   List.zip [0..]

{- |
provide the elements of an array as a list of individual virtual registers

This can be considered the inverse of 'assemble'.
-}
extractAll ::
   (TypeNum.NaturalT n, LLVM.IsFirstClass a, LLVM.IsSized a) =>
   Value (Array n a) -> LLVM.CodeGenFunction r [Value a]
extractAll x =
   mapM
      (LLVM.extractvalue x)
      (take (size x) [(0::Word32)..])

{- |
The loop is unrolled,
since 'LLVM.insertvalue' and 'LLVM.extractvalue' expect constant indices.
-}
map ::
   (TypeNum.NaturalT n,
    LLVM.IsFirstClass a, LLVM.IsSized a,
    LLVM.IsFirstClass b, LLVM.IsSized b) =>
   (Value a -> CodeGenFunction r (Value b)) ->
   (Value (Array n a) -> CodeGenFunction r (Value (Array n b)))
map f =
   assemble <=< mapM f <=< extractAll