{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}
module Language.R.Instance
(
R
, runRegion
, unsafeRunRegion
, Config(..)
, defaultConfig
, withEmbeddedR
, initialize
, finalize
) where
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
import qualified Foreign.R.Embedded as R
#ifndef mingw32_HOST_OS
import qualified Foreign.R.EventLoop as R
#endif
import Foreign.C.String
import Language.R.Globals
import Control.Applicative
import Control.Concurrent.MVar
( newMVar
, withMVar
, MVar
)
import Control.DeepSeq ( NFData, deepseq )
import Control.Exception
( bracket
, bracket_
, uninterruptibleMask_
)
import Control.Monad.Catch ( MonadCatch, MonadMask, MonadThrow )
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif
import Control.Monad.Reader
import Data.IORef (IORef, newIORef, readIORef, modifyIORef')
import Foreign
( Ptr
, allocaArray
)
import Foreign.C.Types ( CInt(..) )
import Foreign.Storable (Storable(..))
import System.Environment ( getProgName, lookupEnv )
import System.IO.Unsafe ( unsafePerformIO )
import System.Process ( readProcess )
import System.SetEnv
#ifndef mingw32_HOST_OS
import Control.Exception ( onException )
import System.IO ( hPutStrLn, stderr )
import System.Posix.Resource
#endif
import Prelude
newtype R s a = R { R s a -> ReaderT (IORef Int) IO a
unR :: ReaderT (IORef Int) IO a }
deriving (Functor (R s)
a -> R s a
Functor (R s) =>
(forall a. a -> R s a)
-> (forall a b. R s (a -> b) -> R s a -> R s b)
-> (forall a b c. (a -> b -> c) -> R s a -> R s b -> R s c)
-> (forall a b. R s a -> R s b -> R s b)
-> (forall a b. R s a -> R s b -> R s a)
-> Applicative (R s)
R s a -> R s b -> R s b
R s a -> R s b -> R s a
R s (a -> b) -> R s a -> R s b
(a -> b -> c) -> R s a -> R s b -> R s c
forall s. Functor (R s)
forall a. a -> R s a
forall s a. a -> R s a
forall a b. R s a -> R s b -> R s a
forall a b. R s a -> R s b -> R s b
forall a b. R s (a -> b) -> R s a -> R s b
forall s a b. R s a -> R s b -> R s a
forall s a b. R s a -> R s b -> R s b
forall s a b. R s (a -> b) -> R s a -> R s b
forall a b c. (a -> b -> c) -> R s a -> R s b -> R s c
forall s a b c. (a -> b -> c) -> R s a -> R s b -> R s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: R s a -> R s b -> R s a
$c<* :: forall s a b. R s a -> R s b -> R s a
*> :: R s a -> R s b -> R s b
$c*> :: forall s a b. R s a -> R s b -> R s b
liftA2 :: (a -> b -> c) -> R s a -> R s b -> R s c
$cliftA2 :: forall s a b c. (a -> b -> c) -> R s a -> R s b -> R s c
<*> :: R s (a -> b) -> R s a -> R s b
$c<*> :: forall s a b. R s (a -> b) -> R s a -> R s b
pure :: a -> R s a
$cpure :: forall s a. a -> R s a
$cp1Applicative :: forall s. Functor (R s)
Applicative, a -> R s b -> R s a
(a -> b) -> R s a -> R s b
(forall a b. (a -> b) -> R s a -> R s b)
-> (forall a b. a -> R s b -> R s a) -> Functor (R s)
forall a b. a -> R s b -> R s a
forall a b. (a -> b) -> R s a -> R s b
forall s a b. a -> R s b -> R s a
forall s a b. (a -> b) -> R s a -> R s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> R s b -> R s a
$c<$ :: forall s a b. a -> R s b -> R s a
fmap :: (a -> b) -> R s a -> R s b
$cfmap :: forall s a b. (a -> b) -> R s a -> R s b
Functor, Applicative (R s)
a -> R s a
Applicative (R s) =>
(forall a b. R s a -> (a -> R s b) -> R s b)
-> (forall a b. R s a -> R s b -> R s b)
-> (forall a. a -> R s a)
-> Monad (R s)
R s a -> (a -> R s b) -> R s b
R s a -> R s b -> R s b
forall s. Applicative (R s)
forall a. a -> R s a
forall s a. a -> R s a
forall a b. R s a -> R s b -> R s b
forall a b. R s a -> (a -> R s b) -> R s b
forall s a b. R s a -> R s b -> R s b
forall s a b. R s a -> (a -> R s b) -> R s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> R s a
$creturn :: forall s a. a -> R s a
>> :: R s a -> R s b -> R s b
$c>> :: forall s a b. R s a -> R s b -> R s b
>>= :: R s a -> (a -> R s b) -> R s b
$c>>= :: forall s a b. R s a -> (a -> R s b) -> R s b
$cp1Monad :: forall s. Applicative (R s)
Monad, Monad (R s)
Monad (R s) => (forall a. IO a -> R s a) -> MonadIO (R s)
IO a -> R s a
forall s. Monad (R s)
forall a. IO a -> R s a
forall s a. IO a -> R s a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> R s a
$cliftIO :: forall s a. IO a -> R s a
$cp1MonadIO :: forall s. Monad (R s)
MonadIO, MonadThrow (R s)
MonadThrow (R s) =>
(forall e a. Exception e => R s a -> (e -> R s a) -> R s a)
-> MonadCatch (R s)
R s a -> (e -> R s a) -> R s a
forall s. MonadThrow (R s)
forall e a. Exception e => R s a -> (e -> R s a) -> R s a
forall s e a. Exception e => R s a -> (e -> R s a) -> R s a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: R s a -> (e -> R s a) -> R s a
$ccatch :: forall s e a. Exception e => R s a -> (e -> R s a) -> R s a
$cp1MonadCatch :: forall s. MonadThrow (R s)
MonadCatch, MonadCatch (R s)
MonadCatch (R s) =>
(forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b)
-> (forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b)
-> (forall a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c))
-> MonadMask (R s)
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
((forall a. R s a -> R s a) -> R s b) -> R s b
((forall a. R s a -> R s a) -> R s b) -> R s b
forall s. MonadCatch (R s)
forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b
forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
forall a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
forall s a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
$cgeneralBracket :: forall s a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
uninterruptibleMask :: ((forall a. R s a -> R s a) -> R s b) -> R s b
$cuninterruptibleMask :: forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
mask :: ((forall a. R s a -> R s a) -> R s b) -> R s b
$cmask :: forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
$cp1MonadMask :: forall s. MonadCatch (R s)
MonadMask, Monad (R s)
e -> R s a
Monad (R s) =>
(forall e a. Exception e => e -> R s a) -> MonadThrow (R s)
forall s. Monad (R s)
forall e a. Exception e => e -> R s a
forall s e a. Exception e => e -> R s a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> R s a
$cthrowM :: forall s e a. Exception e => e -> R s a
$cp1MonadThrow :: forall s. Monad (R s)
MonadThrow)
#if MIN_VERSION_base(4,9,0)
instance MonadFail (R s) where
fail :: String -> R s a
fail s :: String
s = ReaderT (IORef Int) IO a -> R s a
forall s a. ReaderT (IORef Int) IO a -> R s a
R (ReaderT (IORef Int) IO a -> R s a)
-> ReaderT (IORef Int) IO a -> R s a
forall a b. (a -> b) -> a -> b
$ (IORef Int -> IO a) -> ReaderT (IORef Int) IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef Int -> IO a) -> ReaderT (IORef Int) IO a)
-> (IORef Int -> IO a) -> ReaderT (IORef Int) IO a
forall a b. (a -> b) -> a -> b
$ \_ -> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
s
#endif
instance PrimMonad (R s) where
type PrimState (R s) = s
primitive :: (State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #))
-> R s a
primitive f :: State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #)
f = ReaderT (IORef Int) IO a -> R s a
forall s a. ReaderT (IORef Int) IO a -> R s a
R (ReaderT (IORef Int) IO a -> R s a)
-> ReaderT (IORef Int) IO a -> R s a
forall a b. (a -> b) -> a -> b
$ IO a -> ReaderT (IORef Int) IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ReaderT (IORef Int) IO a)
-> IO a -> ReaderT (IORef Int) IO a
forall a b. (a -> b) -> a -> b
$ ST s a -> IO a
forall s a. ST s a -> IO a
unsafeSTToIO (ST s a -> IO a) -> ST s a -> IO a
forall a b. (a -> b) -> a -> b
$ (State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #))
-> ST s a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #)
State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #)
f
instance MonadR (R s) where
io :: IO a -> R s a
io m :: IO a
m = ReaderT (IORef Int) IO a -> R s a
forall s a. ReaderT (IORef Int) IO a -> R s a
R (ReaderT (IORef Int) IO a -> R s a)
-> ReaderT (IORef Int) IO a -> R s a
forall a b. (a -> b) -> a -> b
$ (IORef Int -> IO a) -> ReaderT (IORef Int) IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef Int -> IO a) -> ReaderT (IORef Int) IO a)
-> (IORef Int -> IO a) -> ReaderT (IORef Int) IO a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a
m
acquire :: SEXP s a -> R s (SEXP (Region (R s)) a)
acquire s :: SEXP s a
s = ReaderT (IORef Int) IO (SEXP s a) -> R s (SEXP (Region (R s)) a)
forall s a. ReaderT (IORef Int) IO a -> R s a
R (ReaderT (IORef Int) IO (SEXP s a) -> R s (SEXP (Region (R s)) a))
-> ReaderT (IORef Int) IO (SEXP s a) -> R s (SEXP (Region (R s)) a)
forall a b. (a -> b) -> a -> b
$ (IORef Int -> IO (SEXP s a)) -> ReaderT (IORef Int) IO (SEXP s a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef Int -> IO (SEXP s a)) -> ReaderT (IORef Int) IO (SEXP s a))
-> (IORef Int -> IO (SEXP s a))
-> ReaderT (IORef Int) IO (SEXP s a)
forall a b. (a -> b) -> a -> b
$ \cnt :: IORef Int
cnt -> IO (SEXP s a) -> IO (SEXP s a)
forall a. IO a -> IO a
uninterruptibleMask_ (IO (SEXP s a) -> IO (SEXP s a)) -> IO (SEXP s a) -> IO (SEXP s a)
forall a b. (a -> b) -> a -> b
$ do
SEXP s a
x <- SEXP G a -> SEXP s a
forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release (SEXP G a -> SEXP s a) -> IO (SEXP G a) -> IO (SEXP s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP s a -> IO (SEXP G a)
forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
R.protect SEXP s a
s
IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
cnt Int -> Int
forall a. Enum a => a -> a
succ
SEXP s a -> IO (SEXP s a)
forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s a
x
newtype ExecContext (R s) = ExecContext (IORef Int)
getExecContext :: R s (ExecContext (R s))
getExecContext = ReaderT (IORef Int) IO (ExecContext (R s))
-> R s (ExecContext (R s))
forall s a. ReaderT (IORef Int) IO a -> R s a
R (ReaderT (IORef Int) IO (ExecContext (R s))
-> R s (ExecContext (R s)))
-> ReaderT (IORef Int) IO (ExecContext (R s))
-> R s (ExecContext (R s))
forall a b. (a -> b) -> a -> b
$ (IORef Int -> IO (ExecContext (R s)))
-> ReaderT (IORef Int) IO (ExecContext (R s))
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef Int -> IO (ExecContext (R s)))
-> ReaderT (IORef Int) IO (ExecContext (R s)))
-> (IORef Int -> IO (ExecContext (R s)))
-> ReaderT (IORef Int) IO (ExecContext (R s))
forall a b. (a -> b) -> a -> b
$ \ref :: IORef Int
ref -> ExecContext (R s) -> IO (ExecContext (R s))
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef Int -> ExecContext (R s)
forall s. IORef Int -> ExecContext (R s)
ExecContext IORef Int
ref)
unsafeRunWithExecContext :: R s a -> ExecContext (R s) -> IO a
unsafeRunWithExecContext m :: R s a
m (ExecContext ref) = ReaderT (IORef Int) IO a -> IORef Int -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (R s a -> ReaderT (IORef Int) IO a
forall s a. R s a -> ReaderT (IORef Int) IO a
unR R s a
m) IORef Int
ref
withEmbeddedR :: Config -> IO a -> IO a
withEmbeddedR :: Config -> IO a -> IO a
withEmbeddedR config :: Config
config = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Config -> IO ()
initialize Config
config) IO ()
finalize
runRegion :: NFData a => (forall s. R s a) -> IO a
runRegion :: (forall s. R s a) -> IO a
runRegion r :: forall s. R s a
r = R Any a -> IO a
forall a s. NFData a => R s a -> IO a
unsafeRunRegion R Any a
forall s. R s a
r
unsafeRunRegion :: NFData a => R s a -> IO a
unsafeRunRegion :: R s a -> IO a
unsafeRunRegion r :: R s a
r =
IO (IORef Int)
-> (IORef Int -> IO ()) -> (IORef Int -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef 0)
(Int -> IO ()
R.unprotect (Int -> IO ()) -> (IORef Int -> IO Int) -> IORef Int -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef)
(\d :: IORef Int
d -> do
a
x <- ReaderT (IORef Int) IO a -> IORef Int -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (R s a -> ReaderT (IORef Int) IO a
forall s a. R s a -> ReaderT (IORef Int) IO a
unR R s a
r) IORef Int
d
a
x a -> IO a -> IO a
forall a b. NFData a => a -> b -> b
`deepseq` a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
data Config = Config
{
Config -> Last String
configProgName :: Last String
, Config -> [String]
configArgs :: [String]
, Config -> Last Bool
configSignalHandlers :: Last Bool
}
instance Default Config where
def :: Config
def = Config
defaultConfig
instance Sem.Semigroup Config where
<> :: Config -> Config -> Config
(<>) cfg1 :: Config
cfg1 cfg2 :: Config
cfg2 = Config :: Last String -> [String] -> Last Bool -> Config
Config
{ configProgName :: Last String
configProgName = Config -> Last String
configProgName Config
cfg1 Last String -> Last String -> Last String
forall a. Semigroup a => a -> a -> a
<> Config -> Last String
configProgName Config
cfg2
, configArgs :: [String]
configArgs = Config -> [String]
configArgs Config
cfg1 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Config -> [String]
configArgs Config
cfg2
, configSignalHandlers :: Last Bool
configSignalHandlers = Config -> Last Bool
configSignalHandlers Config
cfg1 Last Bool -> Last Bool -> Last Bool
forall a. Semigroup a => a -> a -> a
<> Config -> Last Bool
configSignalHandlers Config
cfg2
}
instance Monoid Config where
mempty :: Config
mempty = Config
defaultConfig
mappend :: Config -> Config -> Config
mappend = Config -> Config -> Config
forall a. Semigroup a => a -> a -> a
(<>)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Last String -> [String] -> Last Bool -> Config
Config (Maybe String -> Last String
forall a. Maybe a -> Last a
Last Maybe String
forall a. Maybe a
Nothing) ["--vanilla", "--silent"] (Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))
populateEnv :: IO ()
populateEnv :: IO ()
populateEnv = do
Maybe String
mh <- String -> IO (Maybe String)
lookupEnv "R_HOME"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String
mh Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> String -> IO ()
setEnv "R_HOME" (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> String
forall a. [a] -> a
head ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (String -> [String] -> String -> IO String
readProcess "R" ["-e","cat(R.home())","--quiet","--slave"] "")
foreign import ccall "missing_r.h &isRInitialized" isRInitializedPtr :: Ptr CInt
newCArray :: Storable a
=> [a]
-> (Ptr a -> IO r)
-> IO r
newCArray :: [a] -> (Ptr a -> IO r) -> IO r
newCArray xs :: [a]
xs k :: Ptr a -> IO r
k =
Int -> (Ptr a -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ((Ptr a -> IO r) -> IO r) -> (Ptr a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr -> do
(Int -> a -> IO ()) -> [Int] -> [a] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr) [0..] [a]
xs
Ptr a -> IO r
k Ptr a
ptr
initLock :: MVar ()
initLock :: MVar ()
initLock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
{-# NOINLINE initLock #-}
initialize :: Config -> IO ()
initialize :: Config -> IO ()
initialize Config{..} = do
#ifndef mingw32_HOST_OS
#if defined(darwin_HOST_OS) || defined(freebsd_HOST_OS)
let stackLimit :: ResourceLimit
stackLimit = Integer -> ResourceLimit
ResourceLimit 67104768
#else
let stackLimit = ResourceLimitUnknown
#endif
Resource -> ResourceLimits -> IO ()
setResourceLimit Resource
ResourceStackSize (ResourceLimit -> ResourceLimit -> ResourceLimits
ResourceLimits ResourceLimit
stackLimit ResourceLimit
stackLimit)
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
"Language.R.Interpreter: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Cannot increase stack size limit."
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Try increasing your stack size limit manually:"
#ifdef darwin_HOST_OS
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$ launchctl limit stack 67104768"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$ ulimit -s 65532"
#elif defined(freebsd_HOST_OS)
++ "$ ulimit -s 67104768"
#else
++ "$ ulimit -s unlimited"
#endif
)
#endif
Bool
initialized <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==1) (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isRInitializedPtr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
initialized (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
initLock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
initialized2 <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==1) (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isRInitializedPtr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
initialized2 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ mdo
RVariables -> IO ()
pokeRVariables
( Ptr (SEXP G 'Env)
R.baseEnv
, Ptr (SEXP G 'Env)
R.emptyEnv
, Ptr (SEXP G 'Env)
R.globalEnv
, Ptr (SEXP G 'Nil)
R.nilValue
, Ptr (SEXP G 'Symbol)
R.unboundValue
, Ptr (SEXP G 'Symbol)
R.missingArg
, Ptr CInt
R.isRInteractive
, Ptr CInt
R.signalHandlers
#ifndef mingw32_HOST_OS
, Ptr (Ptr InputHandler)
R.inputHandlers
#endif
)
IO ()
populateEnv
[String]
args <- (:) (String -> [String] -> [String])
-> IO String -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getProgName String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Last String -> Maybe String
forall a. Last a -> Maybe a
getLast Last String
configProgName)
IO ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
configArgs
[CString]
argv <- (String -> IO CString) -> [String] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO CString
newCString [String]
args
let argc :: Int
argc = [CString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CString]
argv
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Last Bool -> Maybe Bool
forall a. Last a -> Maybe a
getLast Last Bool
configSignalHandlers) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
signalHandlersPtr 0
[CString] -> (Ptr CString -> IO ()) -> IO ()
forall a r. Storable a => [a] -> (Ptr a -> IO r) -> IO r
newCArray [CString]
argv ((Ptr CString -> IO ()) -> IO ())
-> (Ptr CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Ptr CString -> IO ()
R.initEmbeddedR Int
argc
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInteractive 0
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInitializedPtr 1
finalize :: IO ()
finalize :: IO ()
finalize = do
Int -> IO ()
R.endEmbeddedR 0
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInitializedPtr 0