module Foreign.MathLink.IO ( acquireEnvironment
, acquireLink
, releaseEnvironment
, releaseLink
, activate
, flush
, checkReady
, getError
, clearError
, getErrorMessage
, convToBool
, valueOrErrorMsg
, getPacket
, endPacket
, newPacket
, getMessage
, putMessage
, checkMessage
, transferExpression
, mlGetNext
, mlGetType
, mlTestHead
, mlPutInt16
, mlGetInt16
, mlPutInt32
, mlGetInt32
, mlPutInt
, mlGetInt
, mlPutReal32
, mlGetReal32
, mlPutReal64
, mlGetReal64
, mlPutInt16List
, mlGetInt16List
, mlReleaseInt16List
, mlPutInt32List
, mlGetInt32List
, mlReleaseInt32List
, mlPutIntList
, mlGetIntList
, mlReleaseIntList
, mlPutReal32List
, mlGetReal32List
, mlReleaseReal32List
, mlPutReal64List
, mlGetReal64List
, mlReleaseReal64List
, mlPutInt16Array
, mlGetInt16Array
, mlReleaseInt16Array
, mlPutInt32Array
, mlGetInt32Array
, mlReleaseInt32Array
, mlPutIntArray
, mlGetIntArray
, mlReleaseIntArray
, mlPutReal32Array
, mlGetReal32Array
, mlReleaseReal32Array
, mlPutReal64Array
, mlGetReal64Array
, mlReleaseReal64Array
, mlPutString
, mlGetString
, mlReleaseString
, mlPutSymbol
, mlGetSymbol
, mlReleaseSymbol
, mlPutFunction
, mlGetFunction
) where
import Foreign
import Foreign.C
import Foreign.MathLink.Types
import Control.Exception
import Control.Monad (liftM)
#if (HS_INT_MIN >= __INT32_MIN) && (HS_INT_MAX <= __INT32_MAX)
# define USE_INT32
#elif (HS_INT_MIN >= __INT64_MIN) && (HS_INT_MAX <= __INT64_MAX)
# define USE_INT64
#else
# error "Unexpected size of Int."
#endif
foreign import ccall safe "mathlink.h MLInitialize" mlInitialize
:: Ptr () -> IO Environment
acquireEnvironment :: IO Environment
acquireEnvironment = do
env@(Environment ptr) <- mlInitialize nullPtr
if ptr == nullPtr then
error "Unable to initialize MathLink environment."
else
return env
foreign import ccall safe "mathlink.h MLOpenString" mlOpenString
:: Environment -> CString -> Ptr CInt -> IO Link
foreign import ccall safe "mathlink.h MLErrorString" mlErrorString
:: Environment -> CLong -> IO CString
acquireLink :: Environment -> [String] -> IO Link
acquireLink env args = do
(lnk@(Link ptr),err) <- withCString (unwords args) $ \argPtr ->
bracket malloc free $ \errPtr -> do
l <- mlOpenString env argPtr errPtr
e <- peek errPtr
return (l,e)
if ptr == nullPtr || err /= 0 then
mlErrorString env (fromIntegral err) >>= peekCString >>= error
else
return lnk
foreign import ccall safe "mathlink.h MLClose" mlClose
:: Link -> IO ()
releaseLink :: Link -> IO ()
releaseLink = mlClose
foreign import ccall safe "mathlink.h MLDeinitialize" mlDeinitialize
:: Environment -> IO ()
releaseEnvironment :: Environment -> IO ()
releaseEnvironment = mlDeinitialize
foreign import ccall safe "mathlink.h MLActivate" mlActivate
:: Link -> IO CInt
activate :: Link -> IO Bool
activate l = mlActivate l >>= convToBool
foreign import ccall safe "mathlink.h MLFlush" mlFlush
:: Link -> IO CInt
flush :: Link -> IO Bool
flush l = mlFlush l >>= convToBool
foreign import ccall safe "mathlink.h MLReady" mlReady
:: Link -> IO CInt
checkReady :: Link -> IO Bool
checkReady l = mlReady l >>= convToBool
foreign import ccall safe "mathlink.h MLError" mlError
:: Link -> IO CInt
getError :: Link -> IO Error
getError l = mlError l >>= (return . toEnum . fromIntegral)
convToBool :: Integral a => a -> IO Bool
convToBool = return . (/= 0)
foreign import ccall safe "mathlink.h MLClearError" mlClearError
:: Link -> IO CInt
clearError :: Link -> IO Bool
clearError l = mlClearError l >>= convToBool
foreign import ccall safe "mathlink.h MLErrorMessage" mlErrorMessage
:: Link -> IO CString
getErrorMessage :: Link -> IO String
getErrorMessage l = mlErrorMessage l >>= peekCString
valueOrErrorMsg :: Integral a => Link -> b -> a -> IO (Either String b)
valueOrErrorMsg l val i =
if i /= 0 then
return $ Right val
else
getErrorMessage l >>= (return . Left)
foreign import ccall safe "mathlink.h MLNextPacket" mlNextPacket
:: Link -> IO CInt
getPacket :: Link -> IO Packet
getPacket l = mlNextPacket l >>= (return . toEnum . fromIntegral)
foreign import ccall safe "mathlink.h MLEndPacket" mlEndPacket
:: Link -> IO CInt
endPacket :: Link -> IO Bool
endPacket l = mlEndPacket l >>= convToBool
foreign import ccall safe "mathlink.h MLNewPacket" mlNewPacket
:: Link -> IO CInt
newPacket :: Link -> IO Bool
newPacket l = mlNewPacket l >>= convToBool
foreign import ccall safe "mathlink.h MLGetMessage" mlGetMessage
:: Link -> Ptr CInt -> Ptr CInt -> IO CInt
getMessage :: Link -> IO (Maybe (Message,Int))
getMessage l =
bracket malloc free $ \mPtr ->
bracket malloc free $ \aPtr -> do
present <- mlGetMessage l mPtr aPtr >>= convToBool
if present then do
msgId <- peek mPtr
arg <- peek aPtr
return $ Just (mkMessage msgId, fromIntegral arg)
else
return Nothing
foreign import ccall safe "mathlink.h MLPutMessage" mlPutMessage
:: Link -> CInt -> IO CInt
putMessage :: Link -> Message -> IO Bool
putMessage l m = mlPutMessage l (fromIntegral $ fromEnum m) >>= convToBool
foreign import ccall safe "mathlink.h MLMessageReady" mlMessageReady
:: Link -> IO CInt
checkMessage :: Link -> IO Bool
checkMessage l = mlMessageReady l >>= convToBool
foreign import ccall safe "mathlink.h MLTransferExpression" mlTransferExpression
:: Link -> Link -> IO CInt
transferExpression :: Link -> Link -> IO Bool
transferExpression l1 l2 = mlTransferExpression l1 l2 >>= convToBool
foreign import ccall safe "mathlink.h MLPutInteger16" mlPutInt16
:: Link -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger32" mlPutInt32
:: Link -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger64" mlPutInt64
:: Link -> CLong -> IO CInt
#ifdef USE_INT32
mlPutInt = mlPutInt32
#elif defined USE_INT64
mlPutInt = mlPutInt64
#endif
foreign import ccall safe "mathlink.h MLPutReal32" mlPutReal32
:: Link -> CFloat -> IO CInt
foreign import ccall safe "mathlink.h MLPutReal64" mlPutReal64
:: Link -> CDouble -> IO CInt
foreign import ccall safe "mathlink.h MLPutString" mlPutString
:: Link -> CString -> IO CInt
foreign import ccall safe "mathlink.h MLPutSymbol" mlPutSymbol
:: Link -> CString -> IO CInt
foreign import ccall safe "mathlink.h MLPutFunction" mlPutFunction
:: Link -> CString -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger16List" mlPutInt16List
:: Link -> Ptr CShort -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger32List" mlPutInt32List
:: Link -> Ptr CInt -> CInt -> IO CInt
#ifdef USE_INT32
mlPutIntList
:: Link -> Ptr CInt -> CInt -> IO CInt
mlPutIntList = mlPutInt32List
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLPutInteger64List" mlPutIntList
:: Link -> Ptr CLong -> CInt -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLPutReal32List" mlPutReal32List
:: Link -> Ptr CFloat -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutReal64List" mlPutReal64List
:: Link -> Ptr CDouble -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger16Array" mlPutInt16Array
:: Link -> Ptr CShort -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutInteger32Array" mlPutInt32Array
:: Link -> Ptr CInt -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
#ifdef USE_INT32
mlPutIntArray
:: Link -> Ptr CInt -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
mlPutIntArray = mlPutInt32Array
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLPutInteger64Array" mlPutIntArray
:: Link -> Ptr CLong -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLPutReal32Array" mlPutReal32Array
:: Link -> Ptr CFloat -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLPutReal64Array" mlPutReal64Array
:: Link -> Ptr CDouble -> Ptr CInt -> Ptr CString -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetNext" mlGetNext
:: Link -> IO CInt
foreign import ccall safe "mathlink.h MLGetType" mlGetType
:: Link -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger16" mlGetInt16
:: Link -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger32" mlGetInt32
:: Link -> Ptr CInt -> IO CInt
#ifdef USE_INT32
mlGetInt
:: Link -> Ptr CInt -> IO CInt
mlGetInt = mlGetInt32
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLGetInteger64" mlGetInt
:: Link -> Ptr CLong -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLGetReal32" mlGetReal32
:: Link -> Ptr CFloat -> IO CInt
foreign import ccall safe "mathlink.h MLGetReal64" mlGetReal64
:: Link -> Ptr CDouble -> IO CInt
foreign import ccall safe "mathlink.h MLGetString" mlGetString
:: Link -> Ptr CString -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseString" mlReleaseString
:: Link -> CString -> IO ()
foreign import ccall safe "mathlink.h MLGetSymbol" mlGetSymbol
:: Link -> Ptr CString -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseSymbol" mlReleaseSymbol
:: Link -> CString -> IO ()
foreign import ccall safe "mathlink.h MLTestHead" mlTestHead
:: Link -> CString -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetFunction" mlGetFunction
:: Link -> Ptr CString -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger16List" mlGetInt16List
:: Link -> Ptr (Ptr CShort) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger32List" mlGetInt32List
:: Link -> Ptr (Ptr CInt) -> Ptr CInt -> IO CInt
#ifdef USE_INT32
mlGetIntList
:: Link -> Ptr (Ptr CInt) -> Ptr CInt -> IO CInt
mlGetIntList = mlGetInt32List
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLGetInteger64List" mlGetIntList
:: Link -> Ptr (Ptr CLong) -> Ptr CInt -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLGetReal32List" mlGetReal32List
:: Link -> Ptr (Ptr CFloat) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetReal64List" mlGetReal64List
:: Link -> Ptr (Ptr CDouble) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseInteger16List" mlReleaseInt16List
:: Link -> Ptr CShort -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseInteger32List" mlReleaseInt32List
:: Link -> Ptr CInt -> CInt -> IO CInt
#ifdef USE_INT32
mlReleaseIntList
:: Link -> Ptr CInt -> CInt -> IO CInt
mlReleaseIntList = mlReleaseInt32List
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLReleaseInteger64List" mlReleaseIntList
:: Link -> Ptr CLong -> CInt -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLReleaseReal32List" mlReleaseReal32List
:: Link -> Ptr CFloat -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseReal64List" mlReleaseReal64List
:: Link -> Ptr CDouble -> CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger16Array" mlGetInt16Array
:: Link -> Ptr (Ptr CShort) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetInteger32Array" mlGetInt32Array
:: Link -> Ptr (Ptr CInt) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
#ifdef USE_INT32
mlGetIntArray
:: Link -> Ptr (Ptr CInt) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
mlGetIntArray = mlGetInt32Array
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLGetInteger64Array" mlGetIntArray
:: Link -> Ptr (Ptr CLong) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
#endif
foreign import ccall safe "mathlink.h MLReleaseInteger16Array" mlReleaseInt16Array
:: Link -> Ptr CShort -> Ptr CInt -> Ptr CString -> CInt -> IO ()
foreign import ccall safe "mathlink.h MLReleaseInteger32Array" mlReleaseInt32Array
:: Link -> Ptr CInt -> Ptr CInt -> Ptr CString -> CInt -> IO ()
#ifdef USE_INT32
mlReleaseIntArray
:: Link -> Ptr CInt -> Ptr CInt -> Ptr CString -> CInt -> IO ()
mlReleaseIntArray = mlReleaseInt32Array
#elif defined USE_INT64
foreign import ccall safe "mathlink.h MLReleaseInteger64Array" mlReleaseIntArray
:: Link -> Ptr CLong -> Ptr CInt -> Ptr CString -> CInt -> IO ()
#endif
foreign import ccall safe "mathlink.h MLGetReal32Array" mlGetReal32Array
:: Link -> Ptr (Ptr CFloat) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLGetReal64Array" mlGetReal64Array
:: Link -> Ptr (Ptr CDouble) -> Ptr (Ptr CInt) -> Ptr (Ptr CString) -> Ptr CInt -> IO CInt
foreign import ccall safe "mathlink.h MLReleaseReal32Array" mlReleaseReal32Array
:: Link -> Ptr CFloat -> Ptr CInt -> Ptr CString -> CInt -> IO ()
foreign import ccall safe "mathlink.h MLReleaseReal64Array" mlReleaseReal64Array
:: Link -> Ptr CDouble -> Ptr CInt -> Ptr CString -> CInt -> IO ()