+++ /dev/null
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
------------------------------------------------------------------------------
--- |
--- Module : GHC.Dotnet
--- Copyright : (c) sof, 2003
--- License : see libraries/base/LICENSE
---
--- Maintainer : cvs-ghc@haskell.org
--- Stability : internal
--- Portability : non-portable (GHC extensions)
---
--- Primitive operations and types for doing .NET interop
---
------------------------------------------------------------------------------
-
-module GHC.Dotnet
- ( Object
- , unmarshalObject
- , marshalObject
- , unmarshalString
- , marshalString
- , checkResult
- ) where
-
-import GHC.Base
-import GHC.Exception
-import GHC.IOBase
-import GHC.Ptr
-import Foreign.Marshal.Alloc
-import Foreign.C.String
-
-data Object a
- = Object Addr#
-
-checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
- -> IO a
-checkResult fun = IO $ \ st ->
- case fun st of
- (# st1, res, err #)
- | err `eqAddr#` nullAddr# -> (# st1, res #)
- | otherwise -> throw (raiseError err) st1
-
--- ToDo: attach finaliser.
-unmarshalObject :: Addr# -> Object a
-unmarshalObject x = Object x
-
-marshalObject :: Object a -> (Addr# -> IO b) -> IO b
-marshalObject (Object x) cont = cont x
-
--- dotnet interop support passing and returning
--- strings.
-marshalString :: String
- -> (Addr# -> IO a)
- -> IO a
-marshalString str cont = withCString str (\ (Ptr x) -> cont x)
-
--- char** received back from a .NET interop layer.
-unmarshalString :: Addr# -> String
-unmarshalString p = unsafePerformIO $ do
- let ptr = Ptr p
- str <- peekCString ptr
- free ptr
- return str
-
-
--- room for improvement..
-raiseError :: Addr# -> IOError
-raiseError p = userError (".NET error: " ++ unmarshalString p)