module Synthesizer.LLVM.Plug.Output (
T(..),
Default(..),
split,
storableVector,
) where
import qualified Synthesizer.Zip as Zip
import qualified LLVM.Extra.Storable as Storable
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM
import Control.Monad (liftM2)
import qualified Synthesizer.LLVM.Storable.Vector as SVU
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
import qualified Foreign.ForeignPtr as FPtr
import Data.Tuple.Strict (zipPair)
import NumericPrelude.Numeric
import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile)
data T a b =
forall state ioContext parameters.
(Marshal.C parameters, Memory.C state) =>
Cons
(forall r.
Tuple.ValueOf parameters ->
a -> state -> LLVM.CodeGenFunction r state)
(forall r.
Tuple.ValueOf parameters ->
LLVM.CodeGenFunction r state)
(Int -> IO (ioContext, parameters))
(Int -> ioContext -> IO b)
class Default b where
type Element b :: *
deflt :: T (Element b) b
instance (Default c, Default d) => Default (Zip.T c d) where
type Element (Zip.T c d) = (Element c, Element d)
deflt = split deflt deflt
instance (Storable.C a) => Default (SV.Vector a) where
type Element (SV.Vector a) = Tuple.ValueOf a
deflt = storableVector
split :: T a c -> T b d -> T (a,b) (Zip.T c d)
split (Cons nextA startA createA deleteA)
(Cons nextB startB createB deleteB) = Cons
(\(parameterA, parameterB) (a,b) (sa,sb) ->
liftM2 (,)
(nextA parameterA a sa)
(nextB parameterB b sb))
(\(parameterA, parameterB) ->
liftM2 (,)
(startA parameterA)
(startB parameterB))
(\len ->
liftM2 zipPair
(createA len)
(createB len))
(\len (ca,cb) ->
liftM2 Zip.Cons
(deleteA len ca)
(deleteB len cb))
storableVector ::
(Storable.C a, Tuple.ValueOf a ~ value) => T value (SV.Vector a)
storableVector = Cons
(const Storable.storeNext)
return
(\len -> do
vec <- SVB.create len (const $ return ())
let (_fp,ptr,_l) = SVU.unsafeToPointers vec
return (vec, ptr))
(\len vec -> do
let (fp,_s,_l) = SVB.toForeignPtr vec
FPtr.touchForeignPtr fp
return $ SV.take len vec)