{-# LINE 1 "src/Foreign/R/Context.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Copyright: 2018 (C) Tweag I/O Limited.
--
-- inline-c context.
module Foreign.R.Context
  ( rCtx
  , SEXPREC
  , SEXP0(..)
  , Logical(..)
  ) where

import Data.Complex
import qualified Data.Map as Map
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Language.C.Types (TypeSpecifier(TypeName))
import Language.C.Inline.Context (Context(..))
import Internal.Error



data SEXPREC

newtype {-# CTYPE "SEXP" #-} SEXP0 = SEXP0 { SEXP0 -> Ptr SEXPREC
unSEXP0 :: Ptr SEXPREC }
  deriving ( SEXP0 -> SEXP0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SEXP0 -> SEXP0 -> Bool
$c/= :: SEXP0 -> SEXP0 -> Bool
== :: SEXP0 -> SEXP0 -> Bool
$c== :: SEXP0 -> SEXP0 -> Bool
Eq
           , Eq SEXP0
SEXP0 -> SEXP0 -> Bool
SEXP0 -> SEXP0 -> Ordering
SEXP0 -> SEXP0 -> SEXP0
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SEXP0 -> SEXP0 -> SEXP0
$cmin :: SEXP0 -> SEXP0 -> SEXP0
max :: SEXP0 -> SEXP0 -> SEXP0
$cmax :: SEXP0 -> SEXP0 -> SEXP0
>= :: SEXP0 -> SEXP0 -> Bool
$c>= :: SEXP0 -> SEXP0 -> Bool
> :: SEXP0 -> SEXP0 -> Bool
$c> :: SEXP0 -> SEXP0 -> Bool
<= :: SEXP0 -> SEXP0 -> Bool
$c<= :: SEXP0 -> SEXP0 -> Bool
< :: SEXP0 -> SEXP0 -> Bool
$c< :: SEXP0 -> SEXP0 -> Bool
compare :: SEXP0 -> SEXP0 -> Ordering
$ccompare :: SEXP0 -> SEXP0 -> Ordering
Ord
           , Ptr SEXP0 -> IO SEXP0
Ptr SEXP0 -> Int -> IO SEXP0
Ptr SEXP0 -> Int -> SEXP0 -> IO ()
Ptr SEXP0 -> SEXP0 -> IO ()
SEXP0 -> Int
forall b. Ptr b -> Int -> IO SEXP0
forall b. Ptr b -> Int -> SEXP0 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr SEXP0 -> SEXP0 -> IO ()
$cpoke :: Ptr SEXP0 -> SEXP0 -> IO ()
peek :: Ptr SEXP0 -> IO SEXP0
$cpeek :: Ptr SEXP0 -> IO SEXP0
pokeByteOff :: forall b. Ptr b -> Int -> SEXP0 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SEXP0 -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO SEXP0
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SEXP0
pokeElemOff :: Ptr SEXP0 -> Int -> SEXP0 -> IO ()
$cpokeElemOff :: Ptr SEXP0 -> Int -> SEXP0 -> IO ()
peekElemOff :: Ptr SEXP0 -> Int -> IO SEXP0
$cpeekElemOff :: Ptr SEXP0 -> Int -> IO SEXP0
alignment :: SEXP0 -> Int
$calignment :: SEXP0 -> Int
sizeOf :: SEXP0 -> Int
$csizeOf :: SEXP0 -> Int
Storable
           )

instance Show SEXP0 where
  show :: SEXP0 -> String
show (SEXP0 Ptr SEXPREC
ptr) = forall a. Show a => a -> String
show Ptr SEXPREC
ptr

-- | R uses three-valued logic.
data {-# CTYPE "Logical" #-} Logical = FALSE
             | TRUE
             | NA
-- XXX no Enum instance because NA = INT_MIN, not representable as an Int on
-- 32-bit systems.
               deriving (Logical -> Logical -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Logical -> Logical -> Bool
$c/= :: Logical -> Logical -> Bool
== :: Logical -> Logical -> Bool
$c== :: Logical -> Logical -> Bool
Eq, Eq Logical
Logical -> Logical -> Bool
Logical -> Logical -> Ordering
Logical -> Logical -> Logical
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Logical -> Logical -> Logical
$cmin :: Logical -> Logical -> Logical
max :: Logical -> Logical -> Logical
$cmax :: Logical -> Logical -> Logical
>= :: Logical -> Logical -> Bool
$c>= :: Logical -> Logical -> Bool
> :: Logical -> Logical -> Bool
$c> :: Logical -> Logical -> Bool
<= :: Logical -> Logical -> Bool
$c<= :: Logical -> Logical -> Bool
< :: Logical -> Logical -> Bool
$c< :: Logical -> Logical -> Bool
compare :: Logical -> Logical -> Ordering
$ccompare :: Logical -> Logical -> Ordering
Ord, Int -> Logical -> ShowS
[Logical] -> ShowS
Logical -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Logical] -> ShowS
$cshowList :: [Logical] -> ShowS
show :: Logical -> String
$cshow :: Logical -> String
showsPrec :: Int -> Logical -> ShowS
$cshowsPrec :: Int -> Logical -> ShowS
Show)

instance Storable Logical where
  sizeOf :: Logical -> Int
sizeOf Logical
_       = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)
  alignment :: Logical -> Int
alignment Logical
_    = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: CInt)
  poke :: Ptr Logical -> Logical -> IO ()
poke Ptr Logical
ptr Logical
FALSE = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (CInt
0 :: CInt)
  poke Ptr Logical
ptr Logical
TRUE  = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (CInt
1 :: CInt)
  -- Currently NA_LOGICAL = INT_MIN.
  poke Ptr Logical
ptr Logical
NA    = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (-CInt
2147483648 :: CInt)
{-# LINE 54 "src/Foreign/R/Context.hsc" #-}
  peek ptr = do
      x <- peek (castPtr ptr)
      case x :: CInt of
          0 -> return FALSE
          1 -> return TRUE
          -2147483648 -> return NA
{-# LINE 60 "src/Foreign/R/Context.hsc" #-}
          _ -> failure "Storable Logical peek" "Not a Logical."

rCtx :: Context
rCtx :: Context
rCtx = forall a. Monoid a => a
mempty { ctxTypesTable :: TypesTable
ctxTypesTable = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TypeSpecifier, Q Type)]
tytabs }
  where
    tytabs :: [(TypeSpecifier, Q Type)]
tytabs =
      [ (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"SEXP", [t| SEXP0 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"Rcomplex", [t| Complex Double |])
      ]