{-# LANGUAGE GADTs           #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies    #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.CodeGen.Sugar
-- Copyright   : [2015..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.CodeGen.Sugar (

  IRExp, MIRExp, IRFun1, IRFun2,
  IROpenExp, IROpenFun1(..), IROpenFun2(..),
  IROpenAcc(..),
  IRDelayed(..), MIRDelayed(..),

  IRArray(..),

) where

import LLVM.AST.Type.AddrSpace
import LLVM.AST.Type.Instruction.Volatile

import Data.Array.Accelerate.Representation.Array

import Data.Array.Accelerate.LLVM.CodeGen.IR
import Data.Array.Accelerate.LLVM.CodeGen.Module
import {-# SOURCE #-} Data.Array.Accelerate.LLVM.CodeGen.Monad


-- Scalar expressions
-- ------------------

-- | LLVM IR is in single static assignment, so we need to be able to generate
-- fresh names for each application of a scalar function or expression.
--
type IRExp     arch     aenv t = IROpenExp arch () aenv t
type MIRExp    arch     aenv t = Maybe (IRExp arch aenv t)
type IROpenExp arch env aenv t = CodeGen arch (Operands t)

type IRFun1 arch aenv t = IROpenFun1 arch () aenv t
type IRFun2 arch aenv t = IROpenFun2 arch () aenv t

data IROpenFun1 arch env aenv t where
  IRFun1 :: { IROpenFun1 arch env aenv (a -> b)
-> Operands a -> IROpenExp arch (env, a) aenv b
app1 :: Operands a -> IROpenExp arch (env,a) aenv b }
         -> IROpenFun1 arch env aenv (a -> b)

data IROpenFun2 arch env aenv t where
  IRFun2 :: { IROpenFun2 arch env aenv (a -> b -> c)
-> Operands a -> Operands b -> IROpenExp arch ((env, a), b) aenv c
app2 :: Operands a -> Operands b -> IROpenExp arch ((env,a),b) aenv c }
         -> IROpenFun2 arch env aenv (a -> b -> c)


-- Arrays
-- ------

data IROpenAcc arch aenv arrs where
  IROpenAcc :: [Kernel arch aenv arrs]
            -> IROpenAcc arch aenv arrs

data MIRDelayed arch aenv a
  = IRDelayedJust (IRDelayed arch aenv a)
  | IRDelayedNothing (ArrayR a)

data IRDelayed arch aenv a where
  IRDelayed :: { IRDelayed arch aenv (Array sh e) -> ArrayR (Array sh e)
delayedRepr        :: ArrayR (Array sh e)
               , IRDelayed arch aenv (Array sh e) -> IRExp arch aenv sh
delayedExtent      :: IRExp  arch aenv sh
               , IRDelayed arch aenv (Array sh e) -> IRFun1 arch aenv (sh -> e)
delayedIndex       :: IRFun1 arch aenv (sh -> e)
               , IRDelayed arch aenv (Array sh e) -> IRFun1 arch aenv (Int -> e)
delayedLinearIndex :: IRFun1 arch aenv (Int -> e)
               }
            -> IRDelayed arch aenv (Array sh e)

data IRArray a where
  IRArray :: { IRArray (Array sh e) -> ArrayR (Array sh e)
irArrayRepr        :: ArrayR (Array sh e)
             , IRArray (Array sh e) -> Operands sh
irArrayShape       :: Operands sh        -- Array extent
             , IRArray (Array sh e) -> Operands e
irArrayData        :: Operands e         -- Array payloads (should really be 'Ptr e')
             , IRArray (Array sh e) -> AddrSpace
irArrayAddrSpace   :: AddrSpace
             , IRArray (Array sh e) -> Volatility
irArrayVolatility  :: Volatility
             }
          -> IRArray (Array sh e)