{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module LLVM.Extra.Multi.Value.Array where

import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value.Private as MultiValue
import LLVM.Extra.Multi.Value.Private (Repr)

import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum
import qualified Type.Data.Num.Decimal.Number as Dec
import Type.Base.Proxy (Proxy(Proxy))

import Control.Applicative (Applicative(pure, (<*>)))

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import Data.Functor.Identity (Identity(Identity, runIdentity))
import Data.Functor ((<$>))

import Prelude2010
import Prelude ()



newtype Array n a = Array [a]
   deriving (Array n a -> Array n a -> Bool
(Array n a -> Array n a -> Bool)
-> (Array n a -> Array n a -> Bool) -> Eq (Array n a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n a. Eq a => Array n a -> Array n a -> Bool
$c== :: forall n a. Eq a => Array n a -> Array n a -> Bool
== :: Array n a -> Array n a -> Bool
$c/= :: forall n a. Eq a => Array n a -> Array n a -> Bool
/= :: Array n a -> Array n a -> Bool
Eq, Int -> Array n a -> ShowS
[Array n a] -> ShowS
Array n a -> String
(Int -> Array n a -> ShowS)
-> (Array n a -> String)
-> ([Array n a] -> ShowS)
-> Show (Array n a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n a. Show a => Int -> Array n a -> ShowS
forall n a. Show a => [Array n a] -> ShowS
forall n a. Show a => Array n a -> String
$cshowsPrec :: forall n a. Show a => Int -> Array n a -> ShowS
showsPrec :: Int -> Array n a -> ShowS
$cshow :: forall n a. Show a => Array n a -> String
show :: Array n a -> String
$cshowList :: forall n a. Show a => [Array n a] -> ShowS
showList :: [Array n a] -> ShowS
Show)

instance (Dec.Integer n) => Functor (Array n) where
   fmap :: forall a b. (a -> b) -> Array n a -> Array n b
fmap a -> b
f (Array [a]
xs) = [b] -> Array n b
forall n a. [a] -> Array n a
Array ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)

instance (Dec.Integer n) => Applicative (Array n) where
   pure :: forall a. a -> Array n a
pure a
x =
      Identity (Array n a) -> Array n a
forall a. Identity a -> a
runIdentity (Identity (Array n a) -> Array n a)
-> Identity (Array n a) -> Array n a
forall a b. (a -> b) -> a -> b
$ (Proxy n -> Identity (Array n a)) -> Identity (Array n a)
forall n (gen :: * -> *) a.
(Proxy n -> gen (Array n a)) -> gen (Array n a)
withArraySize ((Proxy n -> Identity (Array n a)) -> Identity (Array n a))
-> (Proxy n -> Identity (Array n a)) -> Identity (Array n a)
forall a b. (a -> b) -> a -> b
$
         \Proxy n
n -> Array n a -> Identity (Array n a)
forall a. a -> Identity a
Identity (Array n a -> Identity (Array n a))
-> Array n a -> Identity (Array n a)
forall a b. (a -> b) -> a -> b
$ [a] -> Array n a
forall n a. [a] -> Array n a
Array ([a] -> Array n a) -> [a] -> Array n a
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Proxy n -> Int
forall n a. (Integer n, Num a) => Proxy n -> a
Dec.integralFromProxy Proxy n
n) a
x
   Array [a -> b]
fs <*> :: forall a b. Array n (a -> b) -> Array n a -> Array n b
<*> Array [a]
xs = [b] -> Array n b
forall n a. [a] -> Array n a
Array ([b] -> Array n b) -> [b] -> Array n b
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> a -> b) -> [a -> b] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> b) -> a -> b
forall a. a -> a
id [a -> b]
fs [a]
xs

instance (Dec.Integer n) => Fold.Foldable (Array n) where
   foldMap :: forall m a. Monoid m => (a -> m) -> Array n a -> m
foldMap a -> m
f (Array [a]
xs) = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap a -> m
f [a]
xs

instance (Dec.Integer n) => Trav.Traversable (Array n) where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array n a -> f (Array n b)
traverse a -> f b
f (Array [a]
xs) = [b] -> Array n b
forall n a. [a] -> Array n a
Array ([b] -> Array n b) -> f [b] -> f (Array n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Trav.traverse a -> f b
f [a]
xs

withArraySize :: (Proxy n -> gen (Array n a)) -> gen (Array n a)
withArraySize :: forall n (gen :: * -> *) a.
(Proxy n -> gen (Array n a)) -> gen (Array n a)
withArraySize Proxy n -> gen (Array n a)
f = Proxy n -> gen (Array n a)
f Proxy n
forall a. Proxy a
Proxy


instance (TypeNum.Natural n, Marshal.C a) => MultiValue.C (Array n a) where
   type Repr (Array n a) = LLVM.Value (LLVM.Array n (Marshal.Struct a))
   cons :: Array n a -> T (Array n a)
cons (Array [a]
xs) = Array n (Struct (Repr a)) -> T (Array n a)
forall al a. (IsConst al, Value al ~ Repr a) => al -> T a
MultiValue.consPrimitive (Array n (Struct (Repr a)) -> T (Array n a))
-> Array n (Struct (Repr a)) -> T (Array n a)
forall a b. (a -> b) -> a -> b
$ [Struct (Repr a)] -> Array n (Struct (Repr a))
forall n a. [a] -> Array n a
LLVM.Array ([Struct (Repr a)] -> Array n (Struct (Repr a)))
-> [Struct (Repr a)] -> Array n (Struct (Repr a))
forall a b. (a -> b) -> a -> b
$ (a -> Struct (Repr a)) -> [a] -> [Struct (Repr a)]
forall a b. (a -> b) -> [a] -> [b]
map a -> Struct (Repr a)
forall a. C a => a -> Struct a
Marshal.pack [a]
xs
   undef :: T (Array n a)
undef = T (Array n a)
forall al a. (IsType al, Value al ~ Repr a) => T a
MultiValue.undefPrimitive
   zero :: T (Array n a)
zero = T (Array n a)
forall al a. (IsType al, Value al ~ Repr a) => T a
MultiValue.zeroPrimitive
   phi :: forall r.
BasicBlock -> T (Array n a) -> CodeGenFunction r (T (Array n a))
phi = BasicBlock -> T (Array n a) -> CodeGenFunction r (T (Array n a))
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> CodeGenFunction r (T a)
MultiValue.phiPrimitive
   addPhi :: forall r.
BasicBlock
-> T (Array n a) -> T (Array n a) -> CodeGenFunction r ()
addPhi = BasicBlock
-> T (Array n a) -> T (Array n a) -> CodeGenFunction r ()
forall al a r.
(IsFirstClass al, Value al ~ Repr a) =>
BasicBlock -> T a -> T a -> CodeGenFunction r ()
MultiValue.addPhiPrimitive

instance
   (TypeNum.Natural n, Marshal.C a,
    Dec.Natural (n Dec.:*: LLVM.SizeOf (Marshal.Struct a))) =>
      Marshal.C (Array n a) where
   pack :: Array n a -> Struct (Array n a)
pack (Array [a]
xs) = [Struct a] -> Array n (Struct a)
forall n a. [a] -> Array n a
LLVM.Array ([Struct a] -> Array n (Struct a))
-> [Struct a] -> Array n (Struct a)
forall a b. (a -> b) -> a -> b
$ (a -> Struct a) -> [a] -> [Struct a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Struct a
forall a. C a => a -> Struct a
Marshal.pack [a]
xs
   unpack :: Struct (Array n a) -> Array n a
unpack (LLVM.Array [Struct a]
xs) = [a] -> Array n a
forall n a. [a] -> Array n a
Array ([a] -> Array n a) -> [a] -> Array n a
forall a b. (a -> b) -> a -> b
$ (Struct a -> a) -> [Struct a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Struct a -> a
forall a. C a => Struct a -> a
Marshal.unpack [Struct a]
xs

extractArrayValue ::
   (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>
   i -> MultiValue.T (Array n a) ->
   LLVM.CodeGenFunction r (MultiValue.T a)
extractArrayValue :: forall n i a r.
(Natural n, ArrayIndex n i, C a) =>
i -> T (Array n a) -> CodeGenFunction r (T a)
extractArrayValue i
i (MultiValue.Cons Repr (Array n a)
arr) =
   Repr a -> T a
forall a. Repr a -> T a
MultiValue.Cons (Repr a -> T a)
-> CodeGenFunction r (Repr a) -> CodeGenFunction r (T a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value (Struct (Repr a)) -> CodeGenFunction r (Repr a)
forall r. Value (Struct (Repr a)) -> CodeGenFunction r (Repr a)
forall llvmValue r.
C llvmValue =>
Value (Struct llvmValue) -> CodeGenFunction r llvmValue
Memory.decompose (Value (Struct (Repr a)) -> CodeGenFunction r (Repr a))
-> CodeGenFunction r (Value (Struct (Repr a)))
-> CodeGenFunction r (Repr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Array n (Struct (Repr a)))
-> i
-> CodeGenFunction
     r (Value (ValueType (Array n (Struct (Repr a))) i))
forall r agg i.
GetValue agg i =>
Value agg -> i -> CodeGenFunction r (Value (ValueType agg i))
LLVM.extractvalue Value (Array n (Struct (Repr a)))
Repr (Array n a)
arr i
i)

insertArrayValue ::
   (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>
   i -> MultiValue.T a -> MultiValue.T (Array n a) ->
   LLVM.CodeGenFunction r (MultiValue.T (Array n a))
insertArrayValue :: forall n i a r.
(Natural n, ArrayIndex n i, C a) =>
i -> T a -> T (Array n a) -> CodeGenFunction r (T (Array n a))
insertArrayValue i
i (MultiValue.Cons Repr a
a) (MultiValue.Cons Repr (Array n a)
arr) =
   Value (Array n (Struct (Repr a))) -> T (Array n a)
Repr (Array n a) -> T (Array n a)
forall a. Repr a -> T a
MultiValue.Cons (Value (Array n (Struct (Repr a))) -> T (Array n a))
-> CodeGenFunction r (Value (Array n (Struct (Repr a))))
-> CodeGenFunction r (T (Array n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value (Struct (Repr a))
 -> i -> CodeGenFunction r (Value (Array n (Struct (Repr a)))))
-> i
-> Value (Struct (Repr a))
-> CodeGenFunction r (Value (Array n (Struct (Repr a))))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Value (Array n (Struct (Repr a)))
-> Value (ValueType (Array n (Struct (Repr a))) i)
-> i
-> CodeGenFunction r (Value (Array n (Struct (Repr a))))
forall r agg i.
GetValue agg i =>
Value agg
-> Value (ValueType agg i) -> i -> CodeGenFunction r (Value agg)
LLVM.insertvalue Value (Array n (Struct (Repr a)))
Repr (Array n a)
arr) i
i (Value (Struct (Repr a))
 -> CodeGenFunction r (Value (Array n (Struct (Repr a)))))
-> CodeGenFunction r (Value (Struct (Repr a)))
-> CodeGenFunction r (Value (Array n (Struct (Repr a))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repr a -> CodeGenFunction r (Value (Struct (Repr a)))
forall r. Repr a -> CodeGenFunction r (Value (Struct (Repr a)))
forall llvmValue r.
C llvmValue =>
llvmValue -> CodeGenFunction r (Value (Struct llvmValue))
Memory.compose Repr a
a)