1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
5 -- Copyright : (c) sof, 2003
6 -- License : see libraries/base/LICENSE
8 -- Maintainer : cvs-ghc@haskell.org
9 -- Stability : internal
10 -- Portability : non-portable (GHC extensions)
12 -- Primitive operations and types for doing .NET interop
14 -----------------------------------------------------------------------------
30 import Foreign.Marshal.Array
31 import Foreign.Marshal.Alloc
32 import Foreign.Storable
33 import Foreign.C.String
38 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
40 checkResult fun = IO $ \ st ->
43 | err `eqAddr#` nullAddr# -> (# st1, res #)
44 | otherwise -> throw (IOException (raiseError err)) st1
46 -- ToDo: attach finaliser.
47 unmarshalObject :: Addr# -> Object a
48 unmarshalObject x = Object x
50 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
51 marshalObject (Object x) cont = cont x
53 -- dotnet interop support passing and returning
55 marshalString :: String
58 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
60 -- char** received back from a .NET interop layer.
61 unmarshalString :: Addr# -> String
62 unmarshalString p = unsafePerformIO $ do
64 str <- peekCString ptr
69 -- room for improvement..
70 raiseError :: Addr# -> IOError
71 raiseError p = userError (".NET error: " ++ unmarshalString p)