{-# LANGUAGE TypeFamilies #-}
{- |
Apply operations on symbolic arrays to physical ones.

In contrast to the "Data.Array.Knead.Symbolic.Render" module,
here we map from Haskell types to LLVM ones.
This is analogous to "Synthesizer.LLVM.Generator.Render".
-}
module Data.Array.Knead.Symbolic.RenderAlt (
   run,
   MarshalValue(..),
   ) where

import qualified Data.Array.Knead.Symbolic.Render.Basic as Render
import qualified Data.Array.Knead.Symbolic.Render.Argument as Arg
import qualified Data.Array.Knead.Symbolic.PhysicalParametric as PhysP
import qualified Data.Array.Knead.Symbolic.Physical as Phys
import qualified Data.Array.Knead.Symbolic.Private as Core
import qualified Data.Array.Knead.Shape as Shape

import qualified LLVM.DSL.Render.Run as Run
import LLVM.DSL.Expression (Exp)

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

import Data.Word (Word, Word32)

import Prelude2010
import Prelude ()



class C f where
   type DSL f
   function :: (Marshal.C p) => Run.T IO p (DSL f) f

instance (C_IO a) => C (IO a) where
   type DSL (IO a) = DSL_IO a
   function :: forall p. C p => T IO p (DSL (IO a)) (IO a)
function = T IO p (DSL_IO a) (IO a)
T IO p (DSL (IO a)) (IO a)
forall p. C p => T IO p (DSL_IO a) (IO a)
forall f p. (C_IO f, C p) => T IO p (DSL_IO f) (IO f)
buildIO


class C_IO f where
   type DSL_IO f
   buildIO :: (Marshal.C p) => Run.T IO p (DSL_IO f) (IO f)

instance
   (Marshal.C sh, Shape.C sh, Storable.C a) =>
      C_IO (Phys.Array sh a) where
   type DSL_IO (Phys.Array sh a) = Core.Array sh a
   buildIO :: forall p. C p => T IO p (DSL_IO (Array sh a)) (IO (Array sh a))
buildIO = ((Exp p -> Array sh a) -> IO (Creator p -> IO (Array sh a)))
-> T IO p (Array sh a) (IO (Array sh a))
forall (m :: * -> *) p fdsl f.
((Exp p -> fdsl) -> m (Creator p -> f)) -> T m p fdsl f
Run.Cons (Exp p -> Array sh a) -> IO (Creator p -> IO (Array sh a))
forall sh ix p a.
(C sh, Index sh ~ ix, C sh, C p, C a) =>
Parametric p (Array sh a) -> IO (Rendered p (Array sh a))
PhysP.render


instance C_IO Float where
   type DSL_IO Float = Exp Float
   buildIO :: forall p. C p => T IO p (DSL_IO Float) (IO Float)
buildIO = T IO p (Exp Float) (IO Float)
T IO p (DSL_IO Float) (IO Float)
forall p a. (C p, C a) => T IO p (Exp a) (IO a)
Render.storable

instance C_IO Word32 where
   type DSL_IO Word32 = Exp Word32
   buildIO :: forall p. C p => T IO p (DSL_IO Word32) (IO Word32)
buildIO = T IO p (Exp Word32) (IO Word32)
T IO p (DSL_IO Word32) (IO Word32)
forall p a. (C p, C a) => T IO p (Exp a) (IO a)
Render.storable

newtype MarshalValue a = MarshalValue {forall a. MarshalValue a -> a
getMarshalValue :: a}

instance (Marshal.C a) => C_IO (MarshalValue a) where
   type DSL_IO (MarshalValue a) = Exp a
   buildIO :: forall p.
C p =>
T IO p (DSL_IO (MarshalValue a)) (IO (MarshalValue a))
buildIO = (IO a -> IO (MarshalValue a))
-> T IO p (Exp a) (IO a) -> T IO p (Exp a) (IO (MarshalValue a))
forall (m :: * -> *) f g p fdsl.
Functor m =>
(f -> g) -> T m p fdsl f -> T m p fdsl g
Run.postmapPlain ((a -> MarshalValue a) -> IO a -> IO (MarshalValue a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MarshalValue a
forall a. a -> MarshalValue a
MarshalValue) T IO p (Exp a) (IO a)
forall p a. (C p, C a) => T IO p (Exp a) (IO a)
Render.marshal


instance (Argument arg, C func) => C (arg -> func) where
   type DSL (arg -> func) = DSLArg arg -> DSL func
   function :: forall p. C p => T IO p (DSL (arg -> func)) (arg -> func)
function = T arg (DSLArg arg)
forall a. Argument a => T a (DSLArg a)
argument T arg (DSLArg arg)
-> (forall al. C al => T IO (p, al) (DSL func) func)
-> T IO p (DSLArg arg -> DSL func) (arg -> func)
forall (m :: * -> *) a adsl p fdsl f.
Functor m =>
T a adsl
-> (forall al. C al => T m (p, al) fdsl f)
-> T m p (adsl -> fdsl) (a -> f)
Render.*-> T IO (p, al) (DSL func) func
forall p. C p => T IO p (DSL func) func
forall al. C al => T IO (p, al) (DSL func) func
forall f p. (C f, C p) => T IO p (DSL f) f
function



class Argument a where
   type DSLArg a
   argument :: Arg.T a (DSLArg a)

instance Argument () where
   type DSLArg () = ()
   argument :: T () (DSLArg ())
argument = T () ()
T () (DSLArg ())
Arg.unit

instance
   (Shape.C sh, Marshal.C sh, Storable.C a) =>
      Argument (Phys.Array sh a) where
   type DSLArg (Phys.Array sh a) = Core.Array sh a
   argument :: T (Array sh a) (DSLArg (Array sh a))
argument = T (Array sh a) (Array sh a)
T (Array sh a) (DSLArg (Array sh a))
forall sh a. (C sh, C sh, C a) => T (Array sh a) (Array sh a)
Arg.array


instance Argument Float where
   type DSLArg Float = Exp Float
   argument :: T Float (DSLArg Float)
argument = T Float (Exp Float)
T Float (DSLArg Float)
forall a. C a => T a (Exp a)
Arg.primitive

instance Argument Int where
   type DSLArg Int = Exp Int
   argument :: T Int (DSLArg Int)
argument = T Int (Exp Int)
T Int (DSLArg Int)
forall a. C a => T a (Exp a)
Arg.primitive

instance Argument Word where
   type DSLArg Word = Exp Word
   argument :: T Word (DSLArg Word)
argument = T Word (Exp Word)
T Word (DSLArg Word)
forall a. C a => T a (Exp a)
Arg.primitive

instance Argument Word32 where
   type DSLArg Word32 = Exp Word32
   argument :: T Word32 (DSLArg Word32)
argument = T Word32 (Exp Word32)
T Word32 (DSLArg Word32)
forall a. C a => T a (Exp a)
Arg.primitive

instance (Argument a, Argument b) => Argument (a,b) where
   type DSLArg (a,b) = (DSLArg a, DSLArg b)
   argument :: T (a, b) (DSLArg (a, b))
argument = T a (DSLArg a) -> T b (DSLArg b) -> T (a, b) (DSLArg a, DSLArg b)
forall a ad b bd. T a ad -> T b bd -> T (a, b) (ad, bd)
Arg.pair T a (DSLArg a)
forall a. Argument a => T a (DSLArg a)
argument T b (DSLArg b)
forall a. Argument a => T a (DSLArg a)
argument

instance (Argument a, Argument b, Argument c) => Argument (a,b,c) where
   type DSLArg (a,b,c) = (DSLArg a, DSLArg b, DSLArg c)
   argument :: T (a, b, c) (DSLArg (a, b, c))
argument = T a (DSLArg a)
-> T b (DSLArg b)
-> T c (DSLArg c)
-> T (a, b, c) (DSLArg a, DSLArg b, DSLArg c)
forall a ad b bd c cd.
T a ad -> T b bd -> T c cd -> T (a, b, c) (ad, bd, cd)
Arg.triple T a (DSLArg a)
forall a. Argument a => T a (DSLArg a)
argument T b (DSLArg b)
forall a. Argument a => T a (DSLArg a)
argument T c (DSLArg c)
forall a. Argument a => T a (DSLArg a)
argument



run :: (C f) => DSL f -> IO f
run :: forall f. C f => DSL f -> IO f
run = T IO () (DSL f) f -> DSL f -> IO f
forall (m :: * -> *) fdsl f.
Functor m =>
T m () fdsl f -> fdsl -> m f
Render.run T IO () (DSL f) f
forall p. C p => T IO p (DSL f) f
forall f p. (C f, C p) => T IO p (DSL f) f
function