-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Provides a /shallow/ view of a 'SEXP' R value as an algebraic datatype. This
-- is useful to define functions over R values in Haskell with pattern matching.
-- For example:
--
-- @
-- toPair :: SEXP a -> (SomeSEXP, SomeSEXP)
-- toPair (hexp -> List _ (Just car) (Just cdr)) = (SomeSEXP car, SomeSEXP cdr)
-- toPair (hexp -> Lang car (Just cdr)) = (SomeSEXP car, SomeSEXP cdr)
-- toPair s = error $ "Cannot extract pair from object of type " ++ typeOf s
-- @
--
-- (See 'Foreign.R.SomeSEXP' for why we need to use it here.)
--
-- The view is said to be 'shallow' because it only unfolds the head of the
-- R value into an algebraic datatype. In this way, functions producing views
-- can be written non-recursively, hence inlined at all call sites and
-- simplified away. When produced by a view function in a pattern match,
-- allocation of the view can be compiled away and hence producing a view can be
-- done at no runtime cost. In fact, pattern matching on a view in this way is
-- more efficient than using the accessor functions defined in "Foreign.R",
-- because we avoid the overhead of calling one or more FFI functions entirely.
--
-- 'HExp' is the /view/ and 'hexp' is the /view function/ that projects 'SEXP's
-- into 'HExp' views.

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

module Language.R.HExp
  ( HExp(..)
  , (===)
  , hexp
  , vector
  ) where

import Control.Applicative
import Control.Memory.Region (V)
import qualified Foreign.R      as R
import Foreign.R (SEXP, SomeSEXP(..), SEXPTYPE)
import Foreign.R.Constraints
import Internal.Error

import qualified Data.Vector.SEXP as Vector

import Control.Monad (guard, void)
import Control.Monad.Primitive ( unsafeInlineIO )
import Data.Int (Int32)
import Data.Word (Word8)
import Data.Complex
import Data.Maybe (isJust)
import Data.Type.Equality (TestEquality(..), (:~:)(Refl))
import GHC.Ptr (Ptr(..))
import Foreign.Storable
import Foreign (castPtr)
import Unsafe.Coerce (unsafeCoerce)
-- Fixes redundant import warning >= 7.10 without CPP
import Prelude


-- Use explicit UNPACK pragmas rather than -funbox-strict-fields in order to get
-- warnings if a field is not unpacked when we expect it to.

-- | A view of R's internal 'SEXP' structure as an algebraic datatype. Because
-- this is in fact a GADT, the use of named record fields is not possible here.
-- Named record fields give rise to functions for whom it is not possible to
-- assign a reasonable type (existentially quantified type variables would
-- escape).
--
-- See <https://cran.r-project.org/doc/manuals/r-release/R-ints.html#SEXPTYPEs>.
type role HExp phantom nominal
data HExp :: * -> SEXPTYPE -> * where
  -- Primitive types. The field names match those of <RInternals.h>.
  -- | The NULL value (@NILSXP@).
  Nil       :: HExp s 'R.Nil
  -- | A symbol (@SYMSXP@).
  Symbol    :: (a :∈ ['R.Char, 'R.Nil])
            => SEXP s a -- ^ the name (is 'Nil' for 'H.unboundValue')
            -> SEXP s b -- ^ the value. Many symbols have their value set to 'H.unboundValue'.
            -> SEXP s c -- ^ «internal»: if the symbol's value is a @.Internal@ function,
                        -- this is a pointer to the appropriate 'SEXP'.
            -> HExp s 'R.Symbol
  -- | A list (@LISTSXP@).
  List      :: (R.IsPairList b, c :∈ ['R.Symbol, 'R.Nil])
            => SEXP s a -- ^ CAR
            -> SEXP s b -- ^ CDR (usually a 'List' or 'Nil')
            -> SEXP s c -- ^ TAG (a 'Symbol' or 'Nil')
            -> HExp s 'R.List
  -- | An environment (@ENVSXP@).
  Env       :: (R.IsPairList a, b :∈ ['R.Env, 'R.Nil], c :∈ ['R.Vector, 'R.Nil])
            => SEXP s a -- ^ the frame: a tagged pairlist with tag the symbol and CAR the bound value
            -> SEXP s b -- ^ the enclosing environment
            -> SEXP s c -- ^ the hash table
            -> HExp s 'R.Env
  -- | A closure (@CLOSXP@).
  Closure   :: (R.IsPairList a)
            => SEXP s a -- ^ formals (a pairlist)
            -> SEXP s b -- ^ the body
            -> SEXP s 'R.Env -- ^ the environment
            -> HExp s 'R.Closure
  -- | A promise (@PROMSXP@).
  Promise   :: (R.IsExpression b, c :∈ ['R.Env, 'R.Nil])
            => SEXP s a -- ^ the value
            -> SEXP s b -- ^ the expression
            -> SEXP s c -- ^ the environment. Once the promise has been
                        -- evaluated, the environment is set to NULL.
            -> HExp s 'R.Promise
  -- Derived types. These types don't have their own 'struct' declaration in
  -- <Rinternals.h>.
  -- | Language objects (@LANGSXP@) are calls (including formulae and so on).
  -- Internally they are pairlists with first element a reference to the
  -- function to be called with remaining elements the actual arguments for
  -- the call (and with the tags if present giving the specified argument
  -- names). Although this is not enforced, many places in the R code assume
  -- that the pairlist is of length one or more, often without checking.
  Lang      :: (R.IsExpression a, R.IsPairList b)
            => SEXP s a -- ^ CAR: the function (perhaps via a symbol or language object)
            -> SEXP s b -- ^ CDR: the argument list with tags for named arguments
            -> HExp s 'R.Lang
  -- | A special (built-in) function call (@SPECIALSXP@). It carries an offset
  -- into the table of primitives but for our purposes is opaque.
  Special   :: HExp s 'R.Special
  -- | A @BUILTINSXP@. This is similar to 'Special', except the arguments to a 'Builtin'
  -- are always evaluated.
  Builtin   :: HExp s 'R.Builtin
  -- | An internal character string (@CHARSXP@).
  Char      :: {-# UNPACK #-} !(Vector.Vector 'R.Char Word8)
            -> HExp s 'R.Char
  -- | A logical vector (@LGLSXP@).
  Logical   :: {-# UNPACK #-} !(Vector.Vector 'R.Logical R.Logical)
            -> HExp s 'R.Logical
  -- | An integer vector (@INTSXP@).
  Int       :: {-# UNPACK #-} !(Vector.Vector 'R.Int Int32)
            -> HExp s 'R.Int
  -- | A numeric vector (@REALSXP@).
  Real      :: {-# UNPACK #-} !(Vector.Vector 'R.Real Double)
            -> HExp s 'R.Real
  -- | A complex vector (@CPLXSXP@).
  Complex   :: {-# UNPACK #-} !(Vector.Vector 'R.Complex (Complex Double))
            -> HExp s 'R.Complex
  -- | A character vector (@STRSXP@).
  String    :: {-# UNPACK #-} !(Vector.Vector 'R.String (SEXP V 'R.Char))
            -> HExp s 'R.String
  -- | A special type of @LISTSXP@ for the value bound to a @...@ symbol
  DotDotDot :: (R.IsPairList a)
            => SEXP s a -- ^ a pairlist of promises
            -> HExp s 'R.List
  -- | A list/generic vector (@VECSXP@).
  Vector    :: {-# UNPACK #-} !Int32 -- ^ true length
            -> {-# UNPACK #-} !(Vector.Vector 'R.Vector (SomeSEXP V))
            -> HExp s 'R.Vector
  -- | An expression vector (@EXPRSXP@).
  Expr      :: {-# UNPACK #-} !Int32 -- ^ true length
            -> {-# UNPACK #-} !(Vector.Vector 'R.Expr (SomeSEXP V))
            -> HExp s 'R.Expr
  -- | A ‘byte-code’ object generated by R (@BCODESXP@).
  Bytecode  :: HExp s 'R.Bytecode -- TODO
  -- | An external pointer (@EXTPTRSXP@)
  ExtPtr    :: (c :∈ ['R.Symbol, 'R.Nil])
            => Ptr () -- ^ the pointer
            -> SEXP s b -- ^ the protection value (an R object which if alive protects this object)
            -> SEXP s c -- ^ a tag
            -> HExp s 'R.ExtPtr
  -- | A weak reference (@WEAKREFSXP@).
  WeakRef   :: ( a :∈ ['R.Env, 'R.ExtPtr, 'R.Nil]
               , c :∈ ['R.Closure, 'R.Builtin, 'R.Special, 'R.Nil]
               , d :∈ ['R.WeakRef, 'R.Nil] )
            => SEXP s a -- ^ the key
            -> SEXP s b -- ^ the value
            -> SEXP s c -- ^ the finalizer
            -> SEXP s d -- ^ the next entry in the weak references list
            -> HExp s 'R.WeakRef
  -- | A raw vector (@RAWSXP@).
  Raw       :: {-# UNPACK #-} !(Vector.Vector 'R.Raw Word8)
            -> HExp s 'R.Raw
  -- | An S4 class which does not consist solely of a simple type such as an atomic vector or function (@S4SXP@).
  S4        :: (a :∈ ['R.Symbol, 'R.Nil])
            => SEXP s a -- ^ the tag
            -> HExp s 'R.S4

-- 'Im a hack

instance Eq (HExp s a) where
  == :: HExp s a -> HExp s a -> Bool
(==) = forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Bool
(===)

-- | Heterogeneous equality.
(===) :: TestEquality f => f a -> f b -> Bool
f a
x === :: forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Bool
=== f b
y = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality f a
x f b
y

-- | Wrapper for partially applying a type synonym.
newtype E s a = E (SEXP s a)

instance TestEquality (E s) where
  testEquality :: forall (a :: SEXPTYPE) (b :: SEXPTYPE).
E s a -> E s b -> Maybe (a :~: b)
testEquality (E x :: SEXP s a
x@(forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s a
t1)) (E y :: SEXP s b
y@(forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s b
t2)) =
      (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
x forall a. Eq a => a -> a -> Bool
== forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s b
y) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b
unsafeCoerce forall {k} (a :: k). a :~: a
Refl)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality HExp s a
t1 HExp s b
t2

instance TestEquality (HExp s) where
  testEquality :: forall (a :: SEXPTYPE) (b :: SEXPTYPE).
HExp s a -> HExp s b -> Maybe (a :~: b)
testEquality HExp s a
Nil HExp s b
Nil = forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Symbol SEXP s a
pname1 SEXP s b
value1 SEXP s c
internal1) (Symbol SEXP s a
pname2 SEXP s b
value2 SEXP s c
internal2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
pname1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
pname2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
value1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
value2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
internal1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
internal2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (List SEXP s a
carval1 SEXP s b
cdrval1 SEXP s c
tagval1) (List SEXP s a
carval2 SEXP s b
cdrval2 SEXP s c
tagval2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
carval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
carval2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
cdrval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
cdrval2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
tagval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
tagval2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Env SEXP s a
frame1 SEXP s b
enclos1 SEXP s c
hashtab1) (Env SEXP s a
frame2 SEXP s b
enclos2 SEXP s c
hashtab2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
frame1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
frame2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
enclos1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
enclos2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
hashtab1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
hashtab2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Closure SEXP s a
formals1 SEXP s b
body1 SEXP s 'Env
env1) (Closure SEXP s a
formals2 SEXP s b
body2 SEXP s 'Env
env2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
formals1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
formals2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
body1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
body2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s 'Env
env1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s 'Env
env2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Promise SEXP s a
value1 SEXP s b
expr1 SEXP s c
env1) (Promise SEXP s a
value2 SEXP s b
expr2 SEXP s c
env2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
value1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
value2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
expr1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
expr2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
env1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
env2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Lang SEXP s a
carval1 SEXP s b
cdrval1) (Lang SEXP s a
carval2 SEXP s b
cdrval2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
carval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
carval2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
cdrval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
cdrval2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  -- Not comparable
  testEquality HExp s a
Special HExp s b
Special = forall a. Maybe a
Nothing
  -- Not comparable
  testEquality HExp s a
Builtin HExp s b
Builtin = forall a. Maybe a
Nothing
  testEquality (Char Vector 'Char Word8
vec1) (Char Vector 'Char Word8
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'Char Word8
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'Char Word8
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Int Vector 'Int Int32
vec1) (Int Vector 'Int Int32
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'Int Int32
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'Int Int32
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Real Vector 'Real Double
vec1) (Real Vector 'Real Double
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'Real Double
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'Real Double
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (String Vector 'String (SEXP V 'Char)
vec1) (String Vector 'String (SEXP V 'Char)
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'String (SEXP V 'Char)
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'String (SEXP V 'Char)
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Complex Vector 'Complex (Complex Double)
vec1) (Complex Vector 'Complex (Complex Double)
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'Complex (Complex Double)
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'Complex (Complex Double)
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (DotDotDot SEXP s a
pairlist1) (DotDotDot SEXP s a
pairlist2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
pairlist1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
pairlist2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Vector Int32
truelength1 Vector 'Vector (SomeSEXP V)
vec1) (Vector Int32
truelength2 Vector 'Vector (SomeSEXP V)
vec2) = do
      let eq :: SomeSEXP s -> SomeSEXP s -> Bool
eq (SomeSEXP SEXP s a
s1) (SomeSEXP SEXP s a
s2) = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
s1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
s2)
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int32
truelength1 forall a. Eq a => a -> a -> Bool
== Int32
truelength2
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {s}. SomeSEXP s -> SomeSEXP s -> Bool
eq (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Vector (SomeSEXP V)
vec1) (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Vector (SomeSEXP V)
vec2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Expr Int32
truelength1 Vector 'Expr (SomeSEXP V)
vec1) (Expr Int32
truelength2 Vector 'Expr (SomeSEXP V)
vec2) = do
      let eq :: SomeSEXP s -> SomeSEXP s -> Bool
eq (SomeSEXP SEXP s a
s1) (SomeSEXP SEXP s a
s2) = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
s1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
s2)
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int32
truelength1 forall a. Eq a => a -> a -> Bool
== Int32
truelength2
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {s}. SomeSEXP s -> SomeSEXP s -> Bool
eq (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Expr (SomeSEXP V)
vec1) (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Expr (SomeSEXP V)
vec2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality HExp s a
Bytecode HExp s b
Bytecode = forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (ExtPtr Ptr ()
pointer1 SEXP s b
protectionValue1 SEXP s c
tagval1) (ExtPtr Ptr ()
pointer2 SEXP s b
protectionValue2 SEXP s c
tagval2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pointer1 forall a. Eq a => a -> a -> Bool
== forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pointer2
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
protectionValue1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
protectionValue2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
tagval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
tagval2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (WeakRef SEXP s a
key1 SEXP s b
value1 SEXP s c
finalizer1 SEXP s d
next1) (WeakRef SEXP s a
key2 SEXP s b
value2 SEXP s c
finalizer2 SEXP s d
next2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
key1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
key2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
value1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s b
value2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
finalizer1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s c
finalizer2)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s d
next1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s d
next2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (Raw Vector 'Raw Word8
vec1) (Raw Vector 'Raw Word8
vec2) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Vector 'Raw Word8
vec1 forall a. Eq a => a -> a -> Bool
== Vector 'Raw Word8
vec2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality (S4 SEXP s a
tagval1) (S4 SEXP s a
tagval2) = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
tagval1) (forall s (a :: SEXPTYPE). SEXP s a -> E s a
E SEXP s a
tagval2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
  testEquality HExp s a
_ HExp s b
_ = forall a. Maybe a
Nothing

{-# INLINE peekHExp #-}
peekHExp :: forall s a. SEXP s a -> IO (HExp s a)
peekHExp :: forall s (a :: SEXPTYPE). SEXP s a -> IO (HExp s a)
peekHExp SEXP s a
s = do
    let coerce :: IO (HExp s b) -> IO (HExp s c)
        coerce :: forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce = forall a b. a -> b
unsafeCoerce

        -- (:∈) constraints are impossible to respect in 'peekHExp', because
        -- R doesn't tell us statically the form of the SEXPREC referred to by
        -- a pointer. So in this function only, we pretend all constrained
        -- fields actually always contain fields of form ANYSXP. This has no
        -- operational significance - it's only a way to bypass what's
        -- impossible to prove.
        coerceAny :: SEXP s b -> SEXP s 'R.Any -- '
        coerceAny :: forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny = forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce

        coerceAnySome :: SomeSEXP s -> SEXP s 'R.Any -- '
        coerceAnySome :: SomeSEXP s -> SEXP s 'Any
coerceAnySome (SomeSEXP SEXP s a
s1) = forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny SEXP s a
s1

        su :: forall b. SEXP s b
        su :: forall (b :: SEXPTYPE). SEXP s b
su = forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
s

    case forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s of
      SEXPTYPE
R.Nil       -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall s. HExp s 'Nil
Nil
      SEXPTYPE
R.Symbol    -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) s (c :: SEXPTYPE) (d :: SEXPTYPE).
(a :∈ '[ 'Char, 'Nil]) =>
SEXP s a -> SEXP s c -> SEXP s d -> HExp s 'Symbol
Symbol    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Symbol -> IO (SomeSEXP s)
R.symbolPrintName forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Symbol -> IO (SomeSEXP s)
R.symbolValue forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Symbol -> IO (SomeSEXP s)
R.symbolInternal forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.List      -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) (c :: SEXPTYPE) s (d :: SEXPTYPE).
(IsPairList a, c :∈ '[ 'Symbol, 'Nil]) =>
SEXP s d -> SEXP s a -> SEXP s c -> HExp s 'List
List      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.car forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.cdr forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.tag forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Env       -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) (c :: SEXPTYPE) (d :: SEXPTYPE) s.
(IsPairList a, c :∈ '[ 'Env, 'Nil], d :∈ '[ 'Vector, 'Nil]) =>
SEXP s a -> SEXP s c -> SEXP s d -> HExp s 'Env
Env       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Env -> IO (SEXP s 'List)
R.envFrame forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Env -> IO (SEXP s 'Env)
R.envEnclosing forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Env -> IO (SEXP s 'Vector)
R.envHashtab forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Closure   -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) s (c :: SEXPTYPE).
IsPairList a =>
SEXP s a -> SEXP s c -> SEXP s 'Env -> HExp s 'Closure
Closure   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Closure -> IO (SEXP s 'List)
R.closureFormals forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Closure -> IO (SomeSEXP s)
R.closureBody forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. SEXP s 'Closure -> IO (SEXP s 'Env)
R.closureEnv forall (b :: SEXPTYPE). SEXP s b
su
      SEXPTYPE
R.Promise   -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) (c :: SEXPTYPE) s (d :: SEXPTYPE).
(IsExpression a, c :∈ '[ 'Env, 'Nil]) =>
SEXP s d -> SEXP s a -> SEXP s c -> HExp s 'Promise
Promise   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Promise -> IO (SomeSEXP s)
R.promiseValue forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Promise -> IO (SomeSEXP s)
R.promiseCode forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. SEXP s 'Promise -> IO (SomeSEXP s)
R.promiseEnv forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Lang      -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) (c :: SEXPTYPE) s.
(IsExpression a, IsPairList c) =>
SEXP s a -> SEXP s c -> HExp s 'Lang
Lang      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.car forall (b :: SEXPTYPE). SEXP s b
su)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.cdr forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Special   -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall s. HExp s 'Special
Special
      SEXPTYPE
R.Builtin   -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall s. HExp s 'Builtin
Builtin
      SEXPTYPE
R.Char      -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Char Word8 -> HExp s 'Char
Char    (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Logical   -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Logical Logical -> HExp s 'Logical
Logical (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Int       -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Int Int32 -> HExp s 'Int
Int     (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Real      -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Real Double -> HExp s 'Real
Real    (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Complex   -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Complex (Complex Double) -> HExp s 'Complex
Complex (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.String    -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'String (SEXP V 'Char) -> HExp s 'String
String  (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.DotDotDot -> forall a. String -> a
unimplemented forall a b. (a -> b) -> a -> b
$ String
"peekHExp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s)
      SEXPTYPE
R.Vector    -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall s. Int32 -> Vector 'Vector (SomeSEXP V) -> HExp s 'Vector
Vector    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: SEXPTYPE) s. IsVector a => SEXP s a -> IO CInt
R.trueLength (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (b :: SEXPTYPE). SEXP s b
su))
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Expr      -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall s. Int32 -> Vector 'Expr (SomeSEXP V) -> HExp s 'Expr
Expr      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: SEXPTYPE) s. IsVector a => SEXP s a -> IO CInt
R.trueLength (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (b :: SEXPTYPE). SEXP s b
su))
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.Bytecode  -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall s. HExp s 'Bytecode
Bytecode
      SEXPTYPE
R.ExtPtr    -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) s (c :: SEXPTYPE).
(a :∈ '[ 'Symbol, 'Nil]) =>
Ptr () -> SEXP s c -> SEXP s a -> HExp s 'ExtPtr
ExtPtr    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\(R.SomeSEXP (R.SEXP (R.SEXP0 Ptr SEXPREC
ptr))) -> forall a b. Ptr a -> Ptr b
castPtr Ptr SEXPREC
ptr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.car SEXP s a
s)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.cdr SEXP s a
s)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.tag SEXP s a
s)
      SEXPTYPE
R.WeakRef   -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) (c :: SEXPTYPE) (d :: SEXPTYPE) s
       (b :: SEXPTYPE).
(a :∈ '[ 'Env, 'ExtPtr, 'Nil],
 c :∈ '[ 'Closure, 'Builtin, 'Special, 'Nil],
 d :∈ '[ 'WeakRef, 'Nil]) =>
SEXP s a -> SEXP s b -> SEXP s c -> SEXP s d -> HExp s 'WeakRef
WeakRef   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
R.sexp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s a
s) Int
0)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
R.sexp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s a
s) Int
1)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
R.sexp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s a
s) Int
2)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (b :: SEXPTYPE). SEXP s b -> SEXP s 'Any
coerceAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
R.sexp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s a
s) Int
3)
      SEXPTYPE
R.Raw       -> forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ forall s. Vector 'Raw Word8 -> HExp s 'Raw
Raw (forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
Vector.unsafeFromSEXP forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
R.S4        -> forall (b :: SEXPTYPE) (c :: SEXPTYPE).
IO (HExp s b) -> IO (HExp s c)
coerce forall a b. (a -> b) -> a -> b
$
        forall (a :: SEXPTYPE) s.
(a :∈ '[ 'Symbol, 'Nil]) =>
SEXP s a -> HExp s 'S4
S4        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeSEXP s -> SEXP s 'Any
coerceAnySome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
R.tag forall (b :: SEXPTYPE). SEXP s b
su)
      SEXPTYPE
_           -> forall a. String -> a
unimplemented forall a b. (a -> b) -> a -> b
$ String
"peekHExp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s)

-- | A view function projecting a view of 'SEXP' as an algebraic datatype, that
-- can be analyzed through pattern matching.
hexp :: SEXP s a -> HExp s a
hexp :: forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp = forall a. IO a -> a
unsafeInlineIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> IO (HExp s a)
peekHExp
{-# INLINE hexp #-}

-- | Project the vector out of 'SEXP's.
vector :: R.IsVector a => SEXP s a -> Vector.Vector a (Vector.ElemRep V a)
vector :: forall (a :: SEXPTYPE) s.
IsVector a =>
SEXP s a -> Vector a (ElemRep V a)
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char Vector 'Char Word8
vec)     = Vector 'Char Word8
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Logical Vector 'Logical Logical
vec)  = Vector 'Logical Logical
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Int Vector 'Int Int32
vec)      = Vector 'Int Int32
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Real Vector 'Real Double
vec)     = Vector 'Real Double
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Complex Vector 'Complex (Complex Double)
vec)  = Vector 'Complex (Complex Double)
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String Vector 'String (SEXP V 'Char)
vec)   = Vector 'String (SEXP V 'Char)
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Vector Int32
_ Vector 'Vector (SomeSEXP V)
vec) = Vector 'Vector (SomeSEXP V)
vec
vector (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Expr Int32
_ Vector 'Expr (SomeSEXP V)
vec)   = Vector 'Expr (SomeSEXP V)
vec
vector SEXP s a
s = forall a. String -> String -> a
violation String
"vector" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s) forall a. [a] -> [a] -> [a]
++ String
" unexpected vector type."