inline-r 0.7.1.0 → 0.7.1.1
raw patch · 7 files changed
+47/−33 lines, 7 files
Files
- inline-r.cabal +6/−1
- src/Foreign/R.chs +15/−3
- src/Foreign/R/Type.hsc +8/−9
- src/H/Prelude.hs +12/−16
- src/Language/R/HExp.chs +4/−1
- tests/Test/Vector.hs +1/−1
- tests/test-qq.hs +1/−2
inline-r.cabal view
@@ -1,5 +1,5 @@ name: inline-r-version: 0.7.1.0+version: 0.7.1.1 license: BSD3 copyright: Copyright (c) 2013-2015 Amgen, Inc. Copyright (c) 2015 Tweag I/O Limited.@@ -9,6 +9,11 @@ build-type: Simple Category: FFI Synopsis: Seamlessly call R from Haskell and vice versa. No FFI required.+description:++ For up to date Haddock documentation, please see+ http://www.stackage.org/package/inline-r.+ cabal-version: >=1.10 extra-source-files: cbits/Hcompat.h
src/Foreign/R.chs view
@@ -18,6 +18,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE DeriveDataTypeable #-}+#endif {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -151,13 +154,16 @@ import Foreign.R.Type (SEXPTYPE, SSEXPTYPE) import Control.Applicative-import Control.Monad.Primitive ( unsafeInlineIO )+import Control.DeepSeq (NFData(..)) import Control.Exception (bracket)+import Control.Monad.Primitive ( unsafeInlineIO ) import Data.Bits import Data.Complex import Data.Int (Int32) import Data.Singletons (fromSing)-import Control.DeepSeq (NFData(..))+#if __GLASGOW_HASKELL__ < 710+import Data.Typeable (Typeable)+#endif import Foreign (Ptr, castPtr, plusPtr, Storable(..)) #ifdef H_ARCH_WINDOWS import Foreign (nullPtr)@@ -187,7 +193,13 @@ -- | The basic type of all R expressions, classified by the form of the -- expression, and the memory region in which it has been allocated. newtype SEXP s (a :: SEXPTYPE) = SEXP { unSEXP :: Ptr (HExp s a) }- deriving (Eq, Storable)+ deriving ( Eq+ , Ord+ , Storable+#if __GLASGOW_HASKELL__ < 710+ , Typeable+#endif+ ) instance Show (SEXP s a) where show (SEXP ptr) = show ptr
src/Foreign/R/Type.hsc view
@@ -46,7 +46,6 @@ import Foreign (castPtr) import Foreign.C (CInt) import Foreign.Storable(Storable(..))-import Prelude hiding (Bool(..)) -- | R \"type\". Note that what R calls a \"type\" is not what is usually meant -- by the term: there is really only a single type, called 'SEXP', and an@@ -90,7 +89,7 @@ | New | Free | Fun- deriving (Eq, Show)+ deriving (Eq, Ord, Show) instance Enum SEXPTYPE where fromEnum Nil = #const NILSXP@@ -159,25 +158,25 @@ lift a = [| $(Hs.conE (Hs.mkName $ "Foreign.R.Type." ++ show a)) |] -- | R uses three-valued logic.-data Logical = False- | True+data Logical = FALSE+ | TRUE | NA -- XXX no Enum instance because NA = INT_MIN, not representable as an Int on -- 32-bit systems.- deriving (Eq, Show)+ deriving (Eq, Ord, Show) instance Storable Logical where sizeOf _ = sizeOf (undefined :: CInt) alignment _ = alignment (undefined :: CInt)- poke ptr False = poke (castPtr ptr) (0 :: CInt)- poke ptr True = poke (castPtr ptr) (1 :: CInt)+ poke ptr FALSE = poke (castPtr ptr) (0 :: CInt)+ poke ptr TRUE = poke (castPtr ptr) (1 :: CInt) -- Currently NA_LOGICAL = INT_MIN. poke ptr NA = poke (castPtr ptr) (#{const INT_MIN} :: CInt) peek ptr = do x <- peek (castPtr ptr) case x :: CInt of- 0 -> return False- 1 -> return True+ 0 -> return FALSE+ 1 -> return TRUE #{const INT_MIN} -> return NA _ -> failure "Storable Logical peek" "Not a Logical."
src/H/Prelude.hs view
@@ -20,7 +20,6 @@ -- * Globals , module Language.R.Globals , Show(..)- , show ) where import Control.Memory.Region@@ -52,30 +51,27 @@ class Show a where -- | Equivalent of R's @deparse()@.- showIO :: a -> IO Text+ show :: a -> Text -- | Make this a class method to allow matching R's @print()@ behaviour, whose -- output is subtly different from @deparse()@. print :: MonadR m => a -> m ()- print = io . (showIO >=> Text.putStrLn)---- | Pure version of 'showIO'.-show :: Show a => a -> Text-show = unsafePerformIO . showIO+ print = io . Text.putStrLn . show instance Show (SEXP s a) where- showIO s =+ show s =+ unsafePerformIO $ withCString "quote" $ R.install >=> \quote ->- R.lang2 quote (R.release s) >>= r1 "deparse" >>= \(SomeSEXP slang) ->- return .- Text.Lazy.fromChunks .- map (Text.pack . Vector.toString . vector) .- Vector.toList .- vector $- (R.unsafeCoerce (R.release slang) :: SEXP V 'R.String)+ R.lang2 quote (R.release s) >>= r1 "deparse" >>= \(SomeSEXP slang) ->+ return .+ Text.Lazy.fromChunks .+ map (Text.pack . Vector.toString . vector) .+ Vector.toList .+ vector $+ (R.unsafeCoerce (R.release slang) :: SEXP V 'R.String) print = io . R.printValue instance Show (R.SomeSEXP s) where- showIO s = R.unSomeSEXP s showIO+ show s = R.unSomeSEXP s show print s = R.unSomeSEXP s print
src/Language/R/HExp.chs view
@@ -173,7 +173,7 @@ Expr :: {-# UNPACK #-} !Int32 -> {-# UNPACK #-} !(Vector.Vector s R.Expr (SomeSEXP s)) -> HExp s R.Expr- Bytecode :: HExp s R.Bytecode -- XXX+ Bytecode :: HExp s R.Bytecode -- TODO -- Fields: pointer, protectionValue, tagval ExtPtr :: Ptr () -> SEXP s b@@ -193,6 +193,9 @@ -- Fields: tagval. S4 :: SEXP s a -> HExp s R.S4++instance Eq (HExp s a) where+ (==) = (===) -- | Heterogeneous equality. (===) :: TestEquality f => f a -> f b -> Bool
tests/Test/Vector.hs view
@@ -126,7 +126,7 @@ vectorCopy = testCase "Copying vector of doubles works" $ runRegion $ do vs1 :: R.SEXP s 'R.Real <- V.toSEXP (V.fromList [1..3::Double]) vs2 :: R.SEXP s 'R.Real <- V.unsafeToSEXP (V.fromList [1..3::Double])- R.SomeSEXP (hexp -> Logical [R.True]) <- [r| identical(vs1_hs, vs2_hs) |]+ R.SomeSEXP (hexp -> Logical [R.TRUE]) <- [r| identical(vs1_hs, vs2_hs) |] return () tests :: TestTree
tests/test-qq.hs view
@@ -37,8 +37,7 @@ -- | Version of '(@=?)' that works in the R monad. (@=?) :: H.Show a => String -> a -> R s () expected @=? actual = liftIO $ do- txt <- H.showIO actual- assertEqual "" expected (Text.unpack txt)+ assertEqual "" expected (Text.unpack (H.show actual)) main :: IO () main = H.withEmbeddedR H.defaultConfig $ H.runRegion $ do