{-# 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 = 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 = Run.Cons PhysP.render


instance C_IO Float where
   type DSL_IO Float = Exp Float
   buildIO = Render.storable

instance C_IO Word32 where
   type DSL_IO Word32 = Exp Word32
   buildIO = Render.storable

newtype MarshalValue a = MarshalValue {getMarshalValue :: a}

instance (Marshal.C a) => C_IO (MarshalValue a) where
   type DSL_IO (MarshalValue a) = Exp a
   buildIO = Run.postmapPlain (fmap MarshalValue) Render.marshal


instance (Argument arg, C func) => C (arg -> func) where
   type DSL (arg -> func) = DSLArg arg -> DSL func
   function = argument Render.*-> function



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

instance Argument () where
   type DSLArg () = ()
   argument = 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 = Arg.array


instance Argument Float where
   type DSLArg Float = Exp Float
   argument = Arg.primitive

instance Argument Int where
   type DSLArg Int = Exp Int
   argument = Arg.primitive

instance Argument Word where
   type DSLArg Word = Exp Word
   argument = Arg.primitive

instance Argument Word32 where
   type DSLArg Word32 = Exp Word32
   argument = Arg.primitive

instance (Argument a, Argument b) => Argument (a,b) where
   type DSLArg (a,b) = (DSLArg a, DSLArg b)
   argument = Arg.pair argument 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 = Arg.triple argument argument argument



run :: (C f) => DSL f -> IO f
run = Render.run function