{-# LANGUAGE CPP, ForeignFunctionInterface #-} 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) -- decide which size of C int to use #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 -- initialization / termination 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 -- errors 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) -- packets 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 -- messages 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 -- misc foreign import ccall safe "mathlink.h MLTransferExpression" mlTransferExpression :: Link -> Link -> IO CInt transferExpression :: Link -> Link -> IO Bool transferExpression l1 l2 = mlTransferExpression l1 l2 >>= convToBool -- puts 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 -- gets 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 ()