{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TypeApplications    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native.Foreign
-- Copyright   : [2016..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Native.Foreign (

  -- Foreign functions
  ForeignAcc(..),
  ForeignExp(..),

  -- useful re-exports
  LLVM,
  Native(..),
  liftIO,
  module Data.Array.Accelerate.LLVM.Native.Array.Data,
  module Data.Array.Accelerate.LLVM.Native.Execute.Async,

) where

import qualified Data.Array.Accelerate.Sugar.Foreign                as S

import Data.Array.Accelerate.LLVM.State
import Data.Array.Accelerate.LLVM.CodeGen.Sugar

import Data.Array.Accelerate.LLVM.Foreign
import Data.Array.Accelerate.LLVM.Native.Array.Data
import Data.Array.Accelerate.LLVM.Native.Execute.Async
import Data.Array.Accelerate.LLVM.Native.Target

import Control.Monad.State
import Data.Typeable


instance Foreign Native where
  foreignAcc :: asm (a -> b) -> Maybe (a -> Par Native (FutureR Native b))
foreignAcc (asm (a -> b)
ff :: asm (a -> b))
    | Just asm :~: ForeignAcc
Refl        <- (Typeable asm, Typeable ForeignAcc) => Maybe (asm :~: ForeignAcc)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @asm @ForeignAcc
    , ForeignAcc _ asm <- asm (a -> b)
ff = (a -> Par Native (Future b)) -> Maybe (a -> Par Native (Future b))
forall a. a -> Maybe a
Just a -> Par Native (Future b)
asm
    | Bool
otherwise              = Maybe (a -> Par Native (FutureR Native b))
forall a. Maybe a
Nothing

  foreignExp :: asm (x -> y) -> Maybe (IRFun1 Native () (x -> y))
foreignExp (asm (x -> y)
ff :: asm (x -> y))
    | Just asm :~: ForeignExp
Refl        <- (Typeable asm, Typeable ForeignExp) => Maybe (asm :~: ForeignExp)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @asm @ForeignExp
    , ForeignExp _ asm <- asm (x -> y)
ff = IRFun1 Native () (x -> y) -> Maybe (IRFun1 Native () (x -> y))
forall a. a -> Maybe a
Just IRFun1 Native () (x -> y)
asm
    | Bool
otherwise              = Maybe (IRFun1 Native () (x -> y))
forall a. Maybe a
Nothing

instance S.Foreign ForeignAcc where
  strForeign :: ForeignAcc args -> String
strForeign (ForeignAcc String
s a -> Par Native (Future b)
_) = String
s

instance S.Foreign ForeignExp where
  strForeign :: ForeignExp args -> String
strForeign (ForeignExp String
s IRFun1 Native () (x -> y)
_) = String
s


-- Foreign functions in the Native backend.
--
-- This is just some arbitrary monadic computation.
--
data ForeignAcc f where
  ForeignAcc :: String
             -> (a -> Par Native (Future b))
             -> ForeignAcc (a -> b)

-- Foreign expressions in the Native backend.
--
-- I'm not sure how useful this is; perhaps we want a way to splice in an
-- arbitrary llvm-hs term, which would give us access to instructions not
-- currently encoded in Accelerate (i.e. SIMD operations, struct types, etc.)
--
data ForeignExp f where
  ForeignExp :: String
             -> IRFun1 Native () (x -> y)
             -> ForeignExp (x -> y)

deriving instance Typeable ForeignAcc
deriving instance Typeable ForeignExp