inline-r 0.9.1 → 0.9.2

raw patch · 9 files changed

+66/−271 lines, 9 filesdep ~basedep ~vectorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• inline-r.cabal +3/−5
• src/Data/Vector/SEXP.hs +16/−2
• src/Foreign/R.c +0/−254
• src/Foreign/R.hsc +5/−0
• src/Language/R/Instance.hs +7/−3
• src/Language/R/Literal.hs +16/−0
• src/Language/R/Matcher.hs +10/−6
• tests/test-qq.hs +5/−1

@@ -1,5 +1,9 @@ # Change Log +## 0.9.2 - 2018-06-29+* GHC 8.4 compatibility+* Add Literal instance for 'Text'+ ## 0.9.1 - 2018-01-26 * Droped c2hs usage. Fixes installation on macOS. * Fix QQ generation. Fixed possible resource free during QQ generation.

@@ -1,12 +1,11 @@ name:                inline-r-version:             0.9.1+version:             0.9.2 license:             BSD3 license-file:        LICENSE copyright:           Copyright (c) 2013-2015 Amgen, Inc.-                     Copyright (c) 2015-2017 Tweag I/O Limited.+                     Copyright (c) 2015-2018 Tweag I/O Limited. author:              Mathieu Boespflug, Facundo Dominguez, Alexander Vershilov maintainer:          Mathieu Boespflug <m@tweag.io>-cabal-version:       >=1.10 build-type:          Simple Category:            FFI Synopsis:            Seamlessly call R from Haskell and vice versa. No FFI required.@@ -35,6 +34,7 @@                       tests/shootout/fannkuchredux.R                       tests/R/fib.R                       tests/R/fib-benchmark.R+extra-tmp-files:     inline-r.buildinfo  source-repository head   type:     git@@ -98,8 +98,6 @@   if impl(ghc < 8.2.1)     build-depends:       inline-c >=0.5.6.1 && <0.6-    c-sources:-      src/Foreign/R.c   else     build-depends:       inline-c >=0.6 && <0.7

@@ -252,8 +252,10 @@   -- ** SEXP specific helpers.   , toString   , toByteString+  , unsafeWithByteString   ) where +import Control.Exception (evaluate) import Control.Monad.R.Class import Control.Monad.R.Internal import Control.Memory.Region@@ -265,7 +267,6 @@ import qualified Foreign.R as R import Foreign.R.Type ( SEXPTYPE(Char) ) -import Control.Monad.Primitive ( PrimMonad ) import Control.Monad.ST (ST, runST) import Data.Int import Data.Proxy (Proxy(..))@@ -274,6 +275,7 @@ import Data.Vector.Generic.New (run) import Data.ByteString ( ByteString ) import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B  import Control.Applicative hiding (empty) #if MIN_VERSION_vector(0,11,0)@@ -288,7 +290,8 @@ import qualified Data.Vector.Fusion.Stream.Monadic as MStream #endif -import Control.Monad.Primitive ( unsafeInlineIO, unsafePrimToPrim )+import Control.Monad.Primitive ( PrimMonad, unsafeInlineIO, unsafePrimToPrim )+import qualified Control.DeepSeq as DeepSeq import Data.Word ( Word8 ) import Foreign ( Storable, Ptr, castPtr, peekElemOff ) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)@@ -454,6 +457,17 @@ toByteString v = unsafeInlineIO $    B.packCStringLen ( castPtr $ unsafeToPtr v                     , fromIntegral $ vectorLength v)++-- | This function is unsafe and ByteString should not be used+-- outside of the function. Any change to bytestring will be+-- reflected in the source vector, thus breaking referencial+-- transparancy.+unsafeWithByteString :: DeepSeq.NFData a => Vector s 'Char Word8 -> (ByteString -> IO a) -> a+unsafeWithByteString v f = unsafeInlineIO $ do+   x <- B.unsafePackCStringLen (castPtr $ unsafeToPtr v+                               ,fromIntegral $ vectorLength v)+   w <- DeepSeq.force <$> f x+   evaluate w   ------------------------------------------------------------------------ -- Vector API

@@ -1,254 +0,0 @@--#include <Rinternals.h>--#include <stdlib.h>--SEXP inline_c_Foreign_R_0_9ac4562d8ebe9f2d5b52142d8b99697816220748(SEXP s_inline_c_0) {-return ( CAR( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_1_9ac4562d8ebe9f2d5b52142d8b99697816220748(SEXP s_inline_c_0) {-return ( CAR( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_2_c4c0eada410b32434665934795b7db0755802aa0(SEXP s_inline_c_0) {-return ( TAG( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_3_cfa520d753fc0262696ca1a84e30b84cd0e8457c(SEXP s_inline_c_0) {-return ( FRAME( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_4_88a8e173a8634b579f1465e01765614d09169107(SEXP s_inline_c_0) {-return ( ENCLOS( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_5_f41ea2abb505e4001eca9f52e80c3cd86ca41452(SEXP s_inline_c_0) {-return ( HASHTAB( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_6_08304863ec80cca65182799dafb8bada5711f636(SEXP s_inline_c_0) {-return ( FORMALS( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_7_eeb3464221812c40270f1d0db6118803cf504819(SEXP s_inline_c_0) {-return ( BODY( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_8_00f7ebadb2693dcb69a30c64fbd07e5ce907738e(SEXP s_inline_c_0) {-return ( CLOENV( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_9_2b683ec3793cf9e95c1cd7634ca8b89d1efda6ac(SEXP s_inline_c_0) {-return ( PRVALUE( s_inline_c_0 ));-}---SEXP inline_c_Foreign_R_10_3ed141c2f3da0f50478b9f565b29e0cf434fa5a6(SEXP s_inline_c_0) {-return ( PRENV( s_inline_c_0 ));-}---SEXP inline_c_Foreign_R_11_311da71ae5bf546de0b07f93aa78461ad0d7ec57(SEXP s_inline_c_0) {-return ( PRCODE( s_inline_c_0 ));-}---int inline_c_Foreign_R_12_8c5c1fd6560f4ce545f63bfe49820bc3d3659956(SEXP s_inline_c_0) {-return ( TRUELENGTH( s_inline_c_0 ) );-}---const char * inline_c_Foreign_R_13_306a964504a2977974ccc1d13f083f8a0098a33a(SEXP s_inline_c_0) {-return ( CHAR(s_inline_c_0));-}---double * inline_c_Foreign_R_14_e8baa047ffedb94c6e841341c90e5bf18b2df6cb(SEXP s_inline_c_0) {-return ( REAL( s_inline_c_0) );-}---int32_t * inline_c_Foreign_R_15_ddf45047733520c72a3ead2cfd2a280fa3f90458(SEXP s_inline_c_0) {-return ( INTEGER( s_inline_c_0 ));-}---char * inline_c_Foreign_R_16_4b3d17a51b6529b826e8c5bfa4cbeeee0fc23209(SEXP s_inline_c_0) {-return ( RAW(s_inline_c_0) );-}---int * inline_c_Foreign_R_17_d580ef2b3a4306f2e3c98f5917b8b15e61487652(SEXP s_inline_c_0) {-return ( LOGICAL(s_inline_c_0) );-}---Rcomplex * inline_c_Foreign_R_18_a78b3e677291a9c6faeeda3171886d1546a8fe2f(SEXP s_inline_c_0) {-return ( COMPLEX(s_inline_c_0) );-}---SEXP * inline_c_Foreign_R_19_f8c583061f1f156cb2922c59012ee03d103d09f3(SEXP s_inline_c_0) {-return ( STRING_PTR(s_inline_c_0) );-}---SEXP inline_c_Foreign_R_20_502f2e4c0c21d4e444b277c80f1f1a839fed21ee(SEXP s_inline_c_0, int n_inline_c_1) {-return ( VECTOR_ELT( s_inline_c_0, n_inline_c_1 ) );-}---SEXP inline_c_Foreign_R_21_6044fb2a9fa0c80b919984361e609c76d51efd6a(SEXP a_inline_c_0, int n_inline_c_1, SEXP b_inline_c_2) {-return ( SET_VECTOR_ELT(a_inline_c_0,n_inline_c_1, b_inline_c_2) );-}---SEXP inline_c_Foreign_R_22_bf5c65cd674a4ee46795158c4c25efe4adc3c31e(SEXP s_inline_c_0) {-return ( PRINTNAME( s_inline_c_0) );-}---SEXP inline_c_Foreign_R_23_9cb109af6528d13922a4437aa08b9e300c57e067(SEXP s_inline_c_0) {-return ( SYMVALUE( s_inline_c_0) );-}---SEXP inline_c_Foreign_R_24_77b9e12a6e8b49be6ad94bfc5a7556452bec26ee(SEXP s_inline_c_0) {-return ( INTERNAL( s_inline_c_0) );-}---SEXP inline_c_Foreign_R_25_9d1497356b19a1672ff9d062c14e4a66cd940330(char * value_inline_c_0) {-return ( Rf_mkString(value_inline_c_0) );-}---SEXP inline_c_Foreign_R_26_b499bcbe64ec29676b9eeb059ee2f1fd076b603c(char * value_inline_c_0) {-return ( Rf_mkChar(value_inline_c_0) );-}---SEXP inline_c_Foreign_R_27_97cb6796cb20eebd3952787597b0a891de13baca(char * value_inline_c_0, int ce_inline_c_1) {-return ( Rf_mkCharCE(value_inline_c_0, ce_inline_c_1) );-}---SEXP inline_c_Foreign_R_28_358ff488f4bb3977dfcb5baf80a86e83a33096b5(char * name_inline_c_0) {-return ( Rf_install(name_inline_c_0) );-}---SEXP inline_c_Foreign_R_29_a7a3ad06904be40179e687c85320f64c64c3439b(unsigned s_inline_c_0) {-return ( Rf_allocSExp( s_inline_c_0 ) );-}---SEXP inline_c_Foreign_R_30_96e76e88957819df4d68e77b0c4601c6b8d0d5ac(int n_inline_c_0) {-return (Rf_allocList(n_inline_c_0));-}---SEXP inline_c_Foreign_R_31_2e3d3d510438d7b4472b0ec840c602625c28e895(unsigned p_inline_c_0, int n_inline_c_1) {-return (Rf_allocVector( p_inline_c_0, n_inline_c_1) );-}---SEXP inline_c_Foreign_R_32_6df82e7267bd3132e472fd9fc5abef02f77c786c(SEXP a_inline_c_0, SEXP b_inline_c_1) {-return ( Rf_cons(a_inline_c_0, b_inline_c_1) );-}---SEXP inline_c_Foreign_R_33_5d0e6900bd9d03c953baea8253edcba6c6243e0e(SEXP a_inline_c_0, SEXP b_inline_c_1) {-return ( Rf_lcons(a_inline_c_0, b_inline_c_1) );-}---void inline_c_Foreign_R_34_a86150c5c5230395a66b5aa480799296d4686db4(SEXP s_inline_c_0) {- Rf_PrintValue(s_inline_c_0) ;-}---SEXP inline_c_Foreign_R_35_0a5c53e1aee56e0de60cb177f0edf14227ad665c(SEXP s_inline_c_0) {-return ( Rf_protect(s_inline_c_0) );-}---void inline_c_Foreign_R_36_429a287fe0eefa7d81c06cf88e820974b383daf1(int i_inline_c_0) {- Rf_unprotect(i_inline_c_0) ;-}---void inline_c_Foreign_R_37_a5fa62b73e2ecddba7265a2be8cb3c0ffcee557f(SEXP s_inline_c_0) {- Rf_unprotect_ptr(s_inline_c_0) ;-}---void inline_c_Foreign_R_38_380434553ebc421919de5f6266f6b67c4ceb134d() {- R_gc() ;-}---void inline_c_Foreign_R_39_7b402e46bce46d9ab6f3d251ada670baff8e05a9(SEXP s_inline_c_0) {- R_PreserveObject( s_inline_c_0 );-}---void inline_c_Foreign_R_40_750ea415e41427d35ca1e926375a0d21d4d5f19b(SEXP s_inline_c_0) {- R_ReleaseObject( s_inline_c_0 );-}---SEXP inline_c_Foreign_R_41_ec6f426618ff7aa18237e2a78831c6bb81fc6368(SEXP expr_inline_c_0, SEXP env_inline_c_1) {-return ( Rf_eval(expr_inline_c_0, env_inline_c_1) );-}---SEXP inline_c_Foreign_R_42_7a1331564f59685bfaf46bc9f47ca3560ae1e97d(SEXP expr_inline_c_0, SEXP env_inline_c_1, int * retCode_inline_c_2) {-return ( R_tryEval(expr_inline_c_0, env_inline_c_1, retCode_inline_c_2) );-}---SEXP inline_c_Foreign_R_43_f7b5b859d36e6970dad17270944cadf4d42349be(SEXP expr_inline_c_0, SEXP env_inline_c_1, int * retCode_inline_c_2) {-return ( R_tryEvalSilent(expr_inline_c_0, env_inline_c_1, retCode_inline_c_2) );-}---SEXP inline_c_Foreign_R_44_ece895f975aabfd0a332423a7b0410d03fa10a06(SEXP s_inline_c_0) {-return (Rf_lang1(s_inline_c_0) );-}---SEXP inline_c_Foreign_R_45_3a6d98bf9d66e9c8887bcacbeff51cb644e48e1a(SEXP f_inline_c_0, SEXP x_inline_c_1) {-return (Rf_lang2(f_inline_c_0, x_inline_c_1) );-}---SEXP inline_c_Foreign_R_46_c5c313abb017c03512777a01709c3d9fbf71fcac(SEXP f_inline_c_0, SEXP x_inline_c_1, SEXP y_inline_c_2) {-return (Rf_lang3(f_inline_c_0, x_inline_c_1, y_inline_c_2) );-}---SEXP inline_c_Foreign_R_47_3613a760d00d0a7f584ac9bafcefbd2af7ebdf77(SEXP a_inline_c_0, SEXP env_inline_c_1) {-return ( Rf_findFun(a_inline_c_0, env_inline_c_1) );-}---SEXP inline_c_Foreign_R_48_9600e44aa0ae956e1d299718d0827a67ffde9a6a(SEXP a_inline_c_0, SEXP env_inline_c_1) {-return (Rf_findVar(a_inline_c_0, env_inline_c_1));-}---SEXP inline_c_Foreign_R_49_73c7bf706d49a8e678a17c1922d1ee6810212d45(SEXP a_inline_c_0, SEXP b_inline_c_1, SEXP c_inline_c_2, int t_inline_c_3) {-return (R_MakeWeakRef(a_inline_c_0, b_inline_c_1, c_inline_c_2, t_inline_c_3));-}-

@@ -57,6 +57,7 @@   , mkChar   , CEType(..)   , mkCharCE+  , mkCharLenCE   , mkWeakRef     -- * Node attributes   , typeOf@@ -327,6 +328,10 @@ mkCharCE :: CEType -> CString -> IO (SEXP V 'R.Char) mkCharCE (cIntFromEnum -> ce) value = sexp <$>    [C.exp| SEXP  { Rf_mkCharCE($(char * value), $(int ce)) } |]++mkCharLenCE :: CEType -> CString -> Int -> IO (SEXP V 'R.Char)+mkCharLenCE (cIntFromEnum -> ce) value (fromIntegral -> len) = sexp <$>+  [C.exp| SEXP { Rf_mkCharLenCE($(char * value), $(int len), $(int ce)) } |]  -- | Intern a string @name@ into the symbol table. --

@@ -40,6 +40,7 @@ import           Control.Monad.Primitive (PrimMonad(..)) import           Control.Monad.R.Class import           Control.Monad.ST.Unsafe (unsafeSTToIO)+import qualified Data.Semigroup as Sem import           Data.Monoid import           Data.Default.Class (Default(..)) import qualified Foreign.R as R@@ -160,13 +161,16 @@ instance Default Config where   def = defaultConfig -instance Monoid Config where-  mempty = defaultConfig-  mappend cfg1 cfg2 = Config+instance Sem.Semigroup Config where+  (<>) cfg1 cfg2 = Config       { configProgName = configProgName cfg1 <> configProgName cfg2       , configArgs = configArgs cfg1 <> configArgs cfg2       , configSignalHandlers =  configSignalHandlers cfg1 <> configSignalHandlers cfg2       }++instance Monoid Config where+  mempty = defaultConfig+  mappend = (<>)  -- | Default argument to pass to 'initialize'. defaultConfig :: Config

@@ -56,7 +56,10 @@ import Control.DeepSeq ( NFData ) import Control.Monad ( void, zipWithM_ ) import Data.Int (Int32)+import qualified Data.ByteString.Unsafe as B import Data.Complex (Complex)+import Data.Text (Text)+import qualified Data.Text.Encoding as T import Foreign          ( FunPtr, castPtr ) import Foreign.C.String ( withCString ) import Foreign.Storable ( Storable, pokeElemOff )@@ -170,6 +173,19 @@         map (\(hexp -> Char xs) -> SVector.toString xs) (SVector.toList v)     fromSEXP _ =         failure "fromSEXP" "String expected where some other expression appeared."++instance Literal Text 'R.String where+    mkSEXPIO s =+        mkSEXPVectorIO sing+          [ B.unsafeUseAsCStringLen (T.encodeUtf8 s) $+              uncurry (R.mkCharLenCE R.CE_UTF8) ]+    fromSEXP (hexp -> String v) =+      case SVector.toList v of +        [hexp -> Char x] -> SVector.unsafeWithByteString x $ \p -> do+           pure $ T.decodeUtf8 p+        _ -> failure "fromSEXP" "Not a singleton vector"+    fromSEXP _ =+      failure "fromSEXP" "String expected where some other expression appeared."  -- | Create a pairlist from an association list. Result is either a pairlist or -- @nilValue@ if the input is the null list. These are two distinct forms. Hence

@@ -67,6 +67,7 @@ import Data.Foldable (asum) import Data.Functor (void) import Data.Maybe (mapMaybe)+import Data.Semigroup as Sem import Data.Singletons import Data.Traversable import Data.Typeable (Typeable)@@ -120,10 +121,13 @@   f <|> g = Matcher $ \s ok err ->       runMatcher f s ok (\e' -> runMatcher g s ok (err . (mappend e'))) +instance Sem.Semigroup (MatcherError s) where+  a <> MatcherError "empty" = a+  _ <> a = a+ instance Monoid (MatcherError s) where   mempty = MatcherError "empty"-  a `mappend` MatcherError "empty" = a-  _ `mappend` a = a+  mappend = (<>)  -- | Exception during matching. data MatcherError s@@ -182,7 +186,7 @@ -- $guards -- -- Guards provides a handy way to check if we are expecting object of the type--- we are interesting in.+-- we are interested in.  -- | Succeeds if current @SomeSEXP@ is 'R.Null'. null :: Matcher s ()@@ -203,7 +207,7 @@ -- it's better to use 'getS3Class' because it will run same check, but also will -- return the class(es) of the current expression. ----- This test is not expressible in terms of the 'guardType', becausee guardType+-- This test is not expressible in terms of the 'guardType', because guardType -- does not see additional information about S3 types. And any raw object can be -- a class instance. s3 :: [String] -> Matcher s ()@@ -224,7 +228,7 @@ -- vector, or factors are presented as an interger vector with 'rownames' -- attribute attached. --- | Returns any attribute by it's name if it exists. Fails with+-- | Returns any attribute by its name if it exists. Fails with -- @NoSuchAttribute@ otherwise. someAttribute :: String -> Matcher s (SomeSEXP s) someAttribute n = Matcher $ \(SomeSEXP s) ok err ->@@ -267,7 +271,7 @@ lookupAttribute s = (Just <$> someAttribute s) <|> pure Nothing  -- | 'Language.R.Hexp.hexp' lifted to Matcher, applies hexp to the current value--- and allow to run internal matcher on it. Is useful when you need to inspect+-- and allows you to run internal matcher on it. Is useful when you need to inspect -- data using high level functions from @Language.R@. hexp :: SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a hexp ty f = f . H.hexp =<< sexp ty

@@ -9,6 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}  module Main where @@ -17,6 +18,7 @@ import qualified Data.Vector.SEXP as SVector import qualified Data.Vector.SEXP.Mutable as SMVector import Control.Memory.Region+import Data.Text (Text)  import Control.Applicative import Control.Monad.Trans (liftIO)@@ -108,9 +110,11 @@     ("c(7, 2, 3)" @=?) =<< [r| v = v2_hs; v[1] <- 7; v |]     io . assertEqual "" "fromList [1,2,3]" . Prelude.show =<< SVector.unsafeFreeze v1 -    let utf8string = "abcd çéõßø"+    let utf8string = "abcd çéõßø" :: String     io . assertEqual "" utf8string =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string_hs |] +    let utf8string1 = "abcd çéõßø" :: Text+    io . assertEqual "" utf8string1 =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string1_hs |]      -- Disable gctorture, otherwise test takes too long to execute.     _ <- [r| gctorture2(0) |]