{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Array.Knead.Parameterized.Private where

import qualified Data.Array.Knead.Symbolic as Core

import qualified Data.Array.Knead.Shape as Shape
import qualified Data.Array.Knead.Expression as Expr
import Data.Array.Knead.Expression (Exp, )

import qualified LLVM.DSL.Parameter as Param

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue

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

import Data.Tuple.Strict (zipPair)

import Prelude2010 hiding (id, map, zipWith, replicate)
import Prelude ()



-- in principle we could define Array in terms of Hull and Core.Array
data Array p sh a =
   forall parameter context.
   (Marshal.C parameter) =>
   Array {
      ()
core :: MultiValue.T parameter -> Core.Array sh a,
      ()
createContext :: p -> IO (context, parameter),
      ()
deleteContext :: context -> IO ()
   }

instance Core.C (Array p) where
   lift0 :: forall sh a. Array sh a -> Array p sh a
lift0 Array sh a
arr = (T () -> Array sh a)
-> (p -> IO ((), ())) -> (() -> IO ()) -> Array p sh a
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array (Array sh a -> T () -> Array sh a
forall a b. a -> b -> a
const Array sh a
arr) ((p -> ()) -> p -> IO ((), ())
forall (m :: * -> *) p pl. Monad m => (p -> pl) -> p -> m ((), pl)
createPlain (() -> p -> ()
forall a b. a -> b -> a
const ())) () -> IO ()
forall (m :: * -> *). Monad m => () -> m ()
deletePlain
   lift1 :: forall sha a shb b.
(Array sha a -> Array shb b) -> Array p sha a -> Array p shb b
lift1 Array sha a -> Array shb b
f (Array T parameter -> Array sha a
arr p -> IO (context, parameter)
create context -> IO ()
delete) = (T parameter -> Array shb b)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p shb b
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array (Array sha a -> Array shb b
f (Array sha a -> Array shb b)
-> (T parameter -> Array sha a) -> T parameter -> Array shb b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T parameter -> Array sha a
arr) p -> IO (context, parameter)
create context -> IO ()
delete
   lift2 :: forall sha a shb b shc c.
(Array sha a -> Array shb b -> Array shc c)
-> Array p sha a -> Array p shb b -> Array p shc c
lift2 Array sha a -> Array shb b -> Array shc c
f (Array T parameter -> Array sha a
arrA p -> IO (context, parameter)
createA context -> IO ()
deleteA) (Array T parameter -> Array shb b
arrB p -> IO (context, parameter)
createB context -> IO ()
deleteB) =
      (T (parameter, parameter) -> Array shc c)
-> (p -> IO ((context, context), (parameter, parameter)))
-> ((context, context) -> IO ())
-> Array p shc c
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array
         ((T parameter -> T parameter -> Array shc c)
-> T (parameter, parameter) -> Array shc c
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameter -> T parameter -> Array shc c)
 -> T (parameter, parameter) -> Array shc c)
-> (T parameter -> T parameter -> Array shc c)
-> T (parameter, parameter)
-> Array shc c
forall a b. (a -> b) -> a -> b
$ \T parameter
paramA T parameter
paramB ->
            Array sha a -> Array shb b -> Array shc c
f (T parameter -> Array sha a
arrA T parameter
paramA) (T parameter -> Array shb b
arrB T parameter
paramB))
         ((p -> IO (context, parameter))
-> (p -> IO (context, parameter))
-> p
-> IO ((context, context), (parameter, parameter))
forall (m :: * -> *) p ctxA paramA ctxB paramB.
Monad m =>
(p -> m (ctxA, paramA))
-> (p -> m (ctxB, paramB))
-> p
-> m ((ctxA, ctxB), (paramA, paramB))
combineCreate p -> IO (context, parameter)
createA p -> IO (context, parameter)
createB)
         ((context -> IO ())
-> (context -> IO ()) -> (context, context) -> IO ()
forall (m :: * -> *) ctxA ctxB.
Monad m =>
(ctxA -> m ()) -> (ctxB -> m ()) -> (ctxA, ctxB) -> m ()
combineDelete context -> IO ()
deleteA context -> IO ()
deleteB)


(!) ::
   (Shape.C sh, Shape.Index sh ~ ix, Marshal.C ix,
    Shape.Scalar z) =>
   Array p sh a -> Param.T p ix -> Array p z a
! :: forall sh ix z p a.
(C sh, Index sh ~ ix, C ix, Scalar z) =>
Array p sh a -> T p ix -> Array p z a
(!) Array p sh a
arr T p ix
pix =
   Hull p (Array z a) -> Array p z a
forall p sh a. Hull p (Array sh a) -> Array p sh a
runHull (Hull p (Array z a) -> Array p z a)
-> Hull p (Array z a) -> Array p z a
forall a b. (a -> b) -> a -> b
$
   (Exp ix -> Array sh a -> Array z a)
-> Tunnel p ix -> Hull p (Array sh a) -> Hull p (Array z a)
forall sl a b p.
(Exp sl -> a -> b) -> Tunnel p sl -> Hull p a -> Hull p b
mapHullWithExp
      (\Exp ix
ix Array sh a
carr -> Exp a -> Array z a
forall sh a. Scalar sh => Exp a -> Array sh a
Core.fromScalar (Exp a -> Array z a) -> Exp a -> Array z a
forall a b. (a -> b) -> a -> b
$ Array sh a
carr Array sh a -> Exp ix -> Exp a
forall sh ix a.
(C sh, Index sh ~ ix) =>
Array sh a -> Exp ix -> Exp a
Core.! Exp ix
ix)
      (T p ix -> Tunnel p ix
forall a p. C a => T p a -> Tunnel p a
expParam T p ix
pix)
      (Array p sh a -> Hull p (Array sh a)
forall p sh a. Array p sh a -> Hull p (Array sh a)
arrayHull Array p sh a
arr)


fill ::
   (Shape.C sh, Marshal.C sh, Marshal.C a) =>
   Param.T p sh -> Param.T p a -> Array p sh a
fill :: forall sh a p. (C sh, C sh, C a) => T p sh -> T p a -> Array p sh a
fill T p sh
sh T p a
a =
   T p sh
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val sh)
    -> Array p sh a)
-> Array p sh a
forall b p a.
C b =>
T p b
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val b)
    -> a)
-> a
Shape.paramWith T p sh
sh ((forall parameters.
  C parameters =>
  (p -> parameters)
  -> (forall (val :: * -> *). Value val => T parameters -> val sh)
  -> Array p sh a)
 -> Array p sh a)
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val sh)
    -> Array p sh a)
-> Array p sh a
forall a b. (a -> b) -> a -> b
$ \p -> parameters
getSh forall (val :: * -> *). Value val => T parameters -> val sh
valueSh ->
   T p a
-> (forall parameters.
    C parameters =>
    (p -> parameters) -> (T parameters -> T a) -> Array p sh a)
-> Array p sh a
forall b p a.
C b =>
T p b
-> (forall parameters.
    C parameters =>
    (p -> parameters) -> (T parameters -> T b) -> a)
-> a
Param.withMulti T p a
a ((forall parameters.
  C parameters =>
  (p -> parameters) -> (T parameters -> T a) -> Array p sh a)
 -> Array p sh a)
-> (forall parameters.
    C parameters =>
    (p -> parameters) -> (T parameters -> T a) -> Array p sh a)
-> Array p sh a
forall a b. (a -> b) -> a -> b
$ \p -> parameters
getA T parameters -> T a
valueA ->
   (T (parameters, parameters) -> Array sh a)
-> (p -> IO ((), (parameters, parameters)))
-> (() -> IO ())
-> Array p sh a
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array
      ((T parameters -> T parameters -> Array sh a)
-> T (parameters, parameters) -> Array sh a
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameters -> T parameters -> Array sh a)
 -> T (parameters, parameters) -> Array sh a)
-> (T parameters -> T parameters -> Array sh a)
-> T (parameters, parameters)
-> Array sh a
forall a b. (a -> b) -> a -> b
$ \T parameters
vsh T parameters
va ->
         Exp sh -> Exp a -> Array sh a
forall sh a. Exp sh -> Exp a -> Array sh a
Core.fill (T parameters -> Exp sh
forall (val :: * -> *). Value val => T parameters -> val sh
valueSh T parameters
vsh) (T a -> Exp a
forall a. T a -> Exp a
forall (val :: * -> *) a. Value val => T a -> val a
Expr.lift0 (T a -> Exp a) -> T a -> Exp a
forall a b. (a -> b) -> a -> b
$ T parameters -> T a
valueA T parameters
va))
      ((p -> (parameters, parameters))
-> p -> IO ((), (parameters, parameters))
forall (m :: * -> *) p pl. Monad m => (p -> pl) -> p -> m ((), pl)
createPlain ((p -> (parameters, parameters))
 -> p -> IO ((), (parameters, parameters)))
-> (p -> (parameters, parameters))
-> p
-> IO ((), (parameters, parameters))
forall a b. (a -> b) -> a -> b
$ \p
p -> (p -> parameters
getSh p
p, p -> parameters
getA p
p))
      () -> IO ()
forall (m :: * -> *). Monad m => () -> m ()
deletePlain

gather ::
   (Shape.C sh0, Shape.Index sh0 ~ ix0,
    Shape.C sh1, MultiValue.C a) =>
   Array p sh1 ix0 ->
   Array p sh0 a ->
   Array p sh1 a
gather :: forall sh0 ix0 sh1 a p.
(C sh0, Index sh0 ~ ix0, C sh1, C a) =>
Array p sh1 ix0 -> Array p sh0 a -> Array p sh1 a
gather = Array p sh1 ix0 -> Array p sh0 a -> Array p sh1 a
forall (array :: * -> * -> *) sh0 ix0 sh1 ix1 a.
(C array, C sh0, Index sh0 ~ ix0, C sh1, Index sh1 ~ ix1, C a) =>
array sh1 ix0 -> array sh0 a -> array sh1 a
Core.gather


id ::
   (Shape.C sh, Marshal.C sh, Shape.Index sh ~ ix) =>
   Param.T p sh -> Array p sh ix
id :: forall sh ix p.
(C sh, C sh, Index sh ~ ix) =>
T p sh -> Array p sh ix
id T p sh
sh =
   T p sh
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val sh)
    -> Array p sh ix)
-> Array p sh ix
forall b p a.
C b =>
T p b
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val b)
    -> a)
-> a
Shape.paramWith T p sh
sh ((forall parameters.
  C parameters =>
  (p -> parameters)
  -> (forall (val :: * -> *). Value val => T parameters -> val sh)
  -> Array p sh ix)
 -> Array p sh ix)
-> (forall parameters.
    C parameters =>
    (p -> parameters)
    -> (forall (val :: * -> *). Value val => T parameters -> val sh)
    -> Array p sh ix)
-> Array p sh ix
forall a b. (a -> b) -> a -> b
$ \p -> parameters
getSh forall (val :: * -> *). Value val => T parameters -> val sh
valueSh ->
   (T parameters -> Array sh ix)
-> (p -> IO ((), parameters)) -> (() -> IO ()) -> Array p sh ix
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array
      (Exp sh -> Array sh ix
forall (array :: * -> * -> *) sh ix.
(C array, C sh, Index sh ~ ix) =>
Exp sh -> array sh ix
Core.id (Exp sh -> Array sh ix)
-> (T parameters -> Exp sh) -> T parameters -> Array sh ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T parameters -> Exp sh
forall (val :: * -> *). Value val => T parameters -> val sh
valueSh)
      ((p -> parameters) -> p -> IO ((), parameters)
forall (m :: * -> *) p pl. Monad m => (p -> pl) -> p -> m ((), pl)
createPlain p -> parameters
getSh)
      () -> IO ()
forall (m :: * -> *). Monad m => () -> m ()
deletePlain

map ::
   (Shape.C sh, Marshal.C c) =>
   (Exp c -> Exp a -> Exp b) ->
   Param.T p c -> Array p sh a -> Array p sh b
map :: forall sh c a b p.
(C sh, C c) =>
(Exp c -> Exp a -> Exp b) -> T p c -> Array p sh a -> Array p sh b
map = ((Exp a -> Exp b) -> Array sh a -> Array sh b)
-> (Exp c -> Exp a -> Exp b)
-> T p c
-> Array p sh a
-> Array p sh b
forall sh0 sh1 c f a b p.
(C sh0, C sh1, C c) =>
(f -> Array sh0 a -> Array sh1 b)
-> (Exp c -> f) -> T p c -> Array p sh0 a -> Array p sh1 b
lift (Exp a -> Exp b) -> Array sh a -> Array sh b
forall (array :: * -> * -> *) sh a b.
(C array, C sh) =>
(Exp a -> Exp b) -> array sh a -> array sh b
Core.map

mapWithIndex ::
   (Shape.C sh, Marshal.C c, Shape.Index sh ~ ix) =>
   (Exp c -> Exp ix -> Exp a -> Exp b) ->
   Param.T p c -> Array p sh a -> Array p sh b
mapWithIndex :: forall sh c ix a b p.
(C sh, C c, Index sh ~ ix) =>
(Exp c -> Exp ix -> Exp a -> Exp b)
-> T p c -> Array p sh a -> Array p sh b
mapWithIndex = ((Exp ix -> Exp a -> Exp b) -> Array sh a -> Array sh b)
-> (Exp c -> Exp ix -> Exp a -> Exp b)
-> T p c
-> Array p sh a
-> Array p sh b
forall sh0 sh1 c f a b p.
(C sh0, C sh1, C c) =>
(f -> Array sh0 a -> Array sh1 b)
-> (Exp c -> f) -> T p c -> Array p sh0 a -> Array p sh1 b
lift (Exp ix -> Exp a -> Exp b) -> Array sh a -> Array sh b
forall (array :: * -> * -> *) sh ix a b.
(C array, C sh, Index sh ~ ix) =>
(Exp ix -> Exp a -> Exp b) -> array sh a -> array sh b
Core.mapWithIndex


fold1 ::
   (Shape.C sh0, Shape.C sh1, Marshal.C c, MultiValue.C a) =>
   (Exp c -> Exp a -> Exp a -> Exp a) ->
   Param.T p c -> Array p (sh0, sh1) a -> Array p sh0 a
fold1 :: forall sh0 sh1 c a p.
(C sh0, C sh1, C c, C a) =>
(Exp c -> Exp a -> Exp a -> Exp a)
-> T p c -> Array p (sh0, sh1) a -> Array p sh0 a
fold1 = ((Exp a -> Exp a -> Exp a) -> Array (sh0, sh1) a -> Array sh0 a)
-> (Exp c -> Exp a -> Exp a -> Exp a)
-> T p c
-> Array p (sh0, sh1) a
-> Array p sh0 a
forall sh0 sh1 c f a b p.
(C sh0, C sh1, C c) =>
(f -> Array sh0 a -> Array sh1 b)
-> (Exp c -> f) -> T p c -> Array p sh0 a -> Array p sh1 b
lift (Exp a -> Exp a -> Exp a) -> Array (sh0, sh1) a -> Array sh0 a
forall (array :: * -> * -> *) sh0 sh1 a.
(C array, C sh0, C sh1, C a) =>
(Exp a -> Exp a -> Exp a) -> array (sh0, sh1) a -> array sh0 a
Core.fold1

fold1All ::
   (Shape.C sh, Shape.Scalar z, Marshal.C c, MultiValue.C a) =>
   (Exp c -> Exp a -> Exp a -> Exp a) ->
   Param.T p c -> Array p sh a -> Array p z a
fold1All :: forall sh z c a p.
(C sh, Scalar z, C c, C a) =>
(Exp c -> Exp a -> Exp a -> Exp a)
-> T p c -> Array p sh a -> Array p z a
fold1All = ((Exp a -> Exp a -> Exp a) -> Array sh a -> Array z a)
-> (Exp c -> Exp a -> Exp a -> Exp a)
-> T p c
-> Array p sh a
-> Array p z a
forall sh0 sh1 c f a b p.
(C sh0, C sh1, C c) =>
(f -> Array sh0 a -> Array sh1 b)
-> (Exp c -> f) -> T p c -> Array p sh0 a -> Array p sh1 b
lift (\Exp a -> Exp a -> Exp a
p -> Exp z -> Exp a -> Array z a
forall sh a. Exp sh -> Exp a -> Array sh a
Core.fill Exp z
forall sh (val :: * -> *). (Scalar sh, Value val) => val sh
forall (val :: * -> *). Value val => val z
Shape.scalar (Exp a -> Array z a)
-> (Array sh a -> Exp a) -> Array sh a -> Array z a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp a -> Exp a -> Exp a) -> Array sh a -> Exp a
forall sh a.
(C sh, C a) =>
(Exp a -> Exp a -> Exp a) -> Array sh a -> Exp a
Core.fold1All Exp a -> Exp a -> Exp a
p)

lift ::
   (Shape.C sh0, Shape.C sh1, Marshal.C c) =>
   (f -> Core.Array sh0 a -> Core.Array sh1 b) ->
   (Exp c -> f) ->
   Param.T p c -> Array p sh0 a -> Array p sh1 b
lift :: forall sh0 sh1 c f a b p.
(C sh0, C sh1, C c) =>
(f -> Array sh0 a -> Array sh1 b)
-> (Exp c -> f) -> T p c -> Array p sh0 a -> Array p sh1 b
lift f -> Array sh0 a -> Array sh1 b
g Exp c -> f
f T p c
c Array p sh0 a
arr =
   Hull p (Array sh1 b) -> Array p sh1 b
forall p sh a. Hull p (Array sh a) -> Array p sh a
runHull (Hull p (Array sh1 b) -> Array p sh1 b)
-> Hull p (Array sh1 b) -> Array p sh1 b
forall a b. (a -> b) -> a -> b
$
   (Exp c -> Array sh0 a -> Array sh1 b)
-> Tunnel p c -> Hull p (Array sh0 a) -> Hull p (Array sh1 b)
forall sl a b p.
(Exp sl -> a -> b) -> Tunnel p sl -> Hull p a -> Hull p b
mapHullWithExp
      (\Exp c
cexp -> f -> Array sh0 a -> Array sh1 b
g (Exp c -> f
f Exp c
cexp))
      (T p c -> Tunnel p c
forall a p. C a => T p a -> Tunnel p a
expParam T p c
c)
      (Array p sh0 a -> Hull p (Array sh0 a)
forall p sh a. Array p sh a -> Hull p (Array sh a)
arrayHull Array p sh0 a
arr)


data Hull p a =
   forall parameter context.
   (Marshal.C parameter) =>
   Hull {
      ()
hullCore :: MultiValue.T parameter -> a,
      ()
hullCreateContext :: p -> IO (context, parameter),
      ()
hullDeleteContext :: context -> IO ()
   }

instance Functor (Hull p) where
   fmap :: forall a b. (a -> b) -> Hull p a -> Hull p b
fmap a -> b
f (Hull T parameter -> a
arr p -> IO (context, parameter)
create context -> IO ()
delete) = (T parameter -> b)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p b
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull (a -> b
f (a -> b) -> (T parameter -> a) -> T parameter -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T parameter -> a
arr) p -> IO (context, parameter)
create context -> IO ()
delete

instance Applicative (Hull p) where
   pure :: forall a. a -> Hull p a
pure a
a = (T () -> a) -> (p -> IO ((), ())) -> (() -> IO ()) -> Hull p a
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull (a -> T () -> a
forall a b. a -> b -> a
const a
a) (IO ((), ()) -> p -> IO ((), ())
forall a b. a -> b -> a
const (IO ((), ()) -> p -> IO ((), ()))
-> IO ((), ()) -> p -> IO ((), ())
forall a b. (a -> b) -> a -> b
$ ((), ()) -> IO ((), ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((),())) () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
   Hull T parameter -> a -> b
arrA p -> IO (context, parameter)
createA context -> IO ()
deleteA <*> :: forall a b. Hull p (a -> b) -> Hull p a -> Hull p b
<*> Hull T parameter -> a
arrB p -> IO (context, parameter)
createB context -> IO ()
deleteB =
      (T (parameter, parameter) -> b)
-> (p -> IO ((context, context), (parameter, parameter)))
-> ((context, context) -> IO ())
-> Hull p b
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull
         ((T parameter -> T parameter -> b) -> T (parameter, parameter) -> b
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameter -> T parameter -> b)
 -> T (parameter, parameter) -> b)
-> (T parameter -> T parameter -> b)
-> T (parameter, parameter)
-> b
forall a b. (a -> b) -> a -> b
$ \T parameter
a T parameter
b -> T parameter -> a -> b
arrA T parameter
a (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ T parameter -> a
arrB T parameter
b)
         ((p -> IO (context, parameter))
-> (p -> IO (context, parameter))
-> p
-> IO ((context, context), (parameter, parameter))
forall (m :: * -> *) p ctxA paramA ctxB paramB.
Monad m =>
(p -> m (ctxA, paramA))
-> (p -> m (ctxB, paramB))
-> p
-> m ((ctxA, ctxB), (paramA, paramB))
combineCreate p -> IO (context, parameter)
createA p -> IO (context, parameter)
createB)
         ((context -> IO ())
-> (context -> IO ()) -> (context, context) -> IO ()
forall (m :: * -> *) ctxA ctxB.
Monad m =>
(ctxA -> m ()) -> (ctxB -> m ()) -> (ctxA, ctxB) -> m ()
combineDelete context -> IO ()
deleteA context -> IO ()
deleteB)

{- |
Equivalent to @liftA2 f (expHull p)@ but saves us an empty context.
-}
mapHullWithExp ::
   (Exp sl -> a -> b) ->
   Param.Tunnel p sl -> Hull p a -> Hull p b
mapHullWithExp :: forall sl a b p.
(Exp sl -> a -> b) -> Tunnel p sl -> Hull p a -> Hull p b
mapHullWithExp Exp sl -> a -> b
f Tunnel p sl
tunnel (Hull T parameter -> a
arr p -> IO (context, parameter)
create context -> IO ()
delete) =
   case Tunnel p sl
tunnel of
      Param.Tunnel p -> t
getSl T t -> T sl
valueSl ->
         (T (parameter, t) -> b)
-> (p -> IO (context, (parameter, t)))
-> (context -> IO ())
-> Hull p b
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull
            ((T parameter -> T t -> b) -> T (parameter, t) -> b
forall a b c. (T a -> T b -> c) -> T (a, b) -> c
MultiValue.uncurry ((T parameter -> T t -> b) -> T (parameter, t) -> b)
-> (T parameter -> T t -> b) -> T (parameter, t) -> b
forall a b. (a -> b) -> a -> b
$ \T parameter
arrp T t
sl ->
               Exp sl -> a -> b
f (T sl -> Exp sl
forall a. T a -> Exp a
forall (val :: * -> *) a. Value val => T a -> val a
Expr.lift0 (T sl -> Exp sl) -> T sl -> Exp sl
forall a b. (a -> b) -> a -> b
$ T t -> T sl
valueSl T t
sl) (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ T parameter -> a
arr T parameter
arrp)
            (\p
p -> do
               (context
ctx, parameter
param) <- p -> IO (context, parameter)
create p
p
               (context, (parameter, t)) -> IO (context, (parameter, t))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (context
ctx, (parameter
param, p -> t
getSl p
p)))
            context -> IO ()
delete

expHull :: Param.Tunnel p sl -> Hull p (Exp sl)
expHull :: forall p sl. Tunnel p sl -> Hull p (Exp sl)
expHull Tunnel p sl
tunnel =
   case Tunnel p sl
tunnel of
      Param.Tunnel p -> t
getSl T t -> T sl
valueSl ->
         (T t -> Exp sl)
-> (p -> IO ((), t)) -> (() -> IO ()) -> Hull p (Exp sl)
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull
            (T sl -> Exp sl
forall a. T a -> Exp a
forall (val :: * -> *) a. Value val => T a -> val a
Expr.lift0 (T sl -> Exp sl) -> (T t -> T sl) -> T t -> Exp sl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T t -> T sl
valueSl)
            (\p
p -> ((), t) -> IO ((), t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), p -> t
getSl p
p))
            () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

arrayHull :: Array p sh a -> Hull p (Core.Array sh a)
arrayHull :: forall p sh a. Array p sh a -> Hull p (Array sh a)
arrayHull (Array T parameter -> Array sh a
arr p -> IO (context, parameter)
create context -> IO ()
delete) = (T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Hull p (Array sh a)
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull T parameter -> Array sh a
arr p -> IO (context, parameter)
create context -> IO ()
delete

runHull :: Hull p (Core.Array sh a) -> Array p sh a
runHull :: forall p sh a. Hull p (Array sh a) -> Array p sh a
runHull (Hull T parameter -> Array sh a
arr p -> IO (context, parameter)
create context -> IO ()
delete) = (T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array T parameter -> Array sh a
arr p -> IO (context, parameter)
create context -> IO ()
delete

extendHull :: (q -> p) -> Hull p a -> Hull q a
extendHull :: forall q p a. (q -> p) -> Hull p a -> Hull q a
extendHull q -> p
f (Hull T parameter -> a
arr p -> IO (context, parameter)
create context -> IO ()
delete) = (T parameter -> a)
-> (q -> IO (context, parameter)) -> (context -> IO ()) -> Hull q a
forall p a parameter context.
C parameter =>
(T parameter -> a)
-> (p -> IO (context, parameter)) -> (context -> IO ()) -> Hull p a
Hull T parameter -> a
arr (p -> IO (context, parameter)
create (p -> IO (context, parameter))
-> (q -> p) -> q -> IO (context, parameter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> p
f) context -> IO ()
delete



expParam :: (Marshal.C a) => Param.T p a -> Param.Tunnel p a
expParam :: forall a p. C a => T p a -> Tunnel p a
expParam = (a -> T a) -> T p a -> Tunnel p a
forall a p. C a => (a -> T a) -> T p a -> Tunnel p a
Param.tunnel a -> T a
forall a. C a => a -> T a
MultiValue.cons



createPlain :: (Monad m) => (p -> pl) -> p -> m ((), pl)
createPlain :: forall (m :: * -> *) p pl. Monad m => (p -> pl) -> p -> m ((), pl)
createPlain p -> pl
f p
p = ((), pl) -> m ((), pl)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), p -> pl
f p
p)

deletePlain :: (Monad m) => () -> m ()
deletePlain :: forall (m :: * -> *). Monad m => () -> m ()
deletePlain () = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


{-# INLINE combineCreate #-}
combineCreate ::
   Monad m =>
   (p -> m (ctxA, paramA)) -> (p -> m (ctxB, paramB)) ->
   p -> m ((ctxA, ctxB), (paramA, paramB))
combineCreate :: forall (m :: * -> *) p ctxA paramA ctxB paramB.
Monad m =>
(p -> m (ctxA, paramA))
-> (p -> m (ctxB, paramB))
-> p
-> m ((ctxA, ctxB), (paramA, paramB))
combineCreate p -> m (ctxA, paramA)
createA p -> m (ctxB, paramB)
createB p
p =
   ((ctxA, paramA)
 -> (ctxB, paramB) -> ((ctxA, ctxB), (paramA, paramB)))
-> m (ctxA, paramA)
-> m (ctxB, paramB)
-> m ((ctxA, ctxB), (paramA, paramB))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ctxA, paramA)
-> (ctxB, paramB) -> ((ctxA, ctxB), (paramA, paramB))
forall a b c d. (a, b) -> (c, d) -> ((a, c), (b, d))
zipPair (p -> m (ctxA, paramA)
createA p
p) (p -> m (ctxB, paramB)
createB p
p)

{-# INLINE combineDelete #-}
combineDelete ::
   Monad m =>
   (ctxA -> m ()) -> (ctxB -> m ()) -> (ctxA, ctxB) -> m ()
combineDelete :: forall (m :: * -> *) ctxA ctxB.
Monad m =>
(ctxA -> m ()) -> (ctxB -> m ()) -> (ctxA, ctxB) -> m ()
combineDelete ctxA -> m ()
deleteA ctxB -> m ()
deleteB (ctxA
ctxA, ctxB
ctxB) = do
   ctxA -> m ()
deleteA ctxA
ctxA
   ctxB -> m ()
deleteB ctxB
ctxB


extendParameter ::
   (q -> p) -> Array p sh a -> Array q sh a
extendParameter :: forall q p sh a. (q -> p) -> Array p sh a -> Array q sh a
extendParameter q -> p
f (Array T parameter -> Array sh a
arr p -> IO (context, parameter)
create context -> IO ()
delete) =
   (T parameter -> Array sh a)
-> (q -> IO (context, parameter))
-> (context -> IO ())
-> Array q sh a
forall p sh a parameter context.
C parameter =>
(T parameter -> Array sh a)
-> (p -> IO (context, parameter))
-> (context -> IO ())
-> Array p sh a
Array T parameter -> Array sh a
arr (p -> IO (context, parameter)
create (p -> IO (context, parameter))
-> (q -> p) -> q -> IO (context, parameter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> p
f) context -> IO ()
delete