1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
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 -----------------------------------------------------------------------------
31 import Foreign.Marshal.Array
32 import Foreign.Marshal.Alloc
33 import Foreign.Storable
34 import Foreign.C.String
39 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
41 checkResult fun = IO $ \ st ->
44 | err `eqAddr#` nullAddr# -> (# st1, res #)
45 | otherwise -> throw (IOException (raiseError err)) st1
47 -- ToDo: attach finaliser.
48 unmarshalObject :: Addr# -> Object a
49 unmarshalObject x = Object x
51 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
52 marshalObject (Object x) cont = cont x
54 -- dotnet interop support passing and returning
56 marshalString :: String
59 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
61 -- char** received back from a .NET interop layer.
62 unmarshalString :: Addr# -> String
63 unmarshalString p = unsafePerformIO $ do
65 str <- peekCString ptr
70 -- room for improvement..
71 raiseError :: Addr# -> IOError
72 raiseError p = userError (".NET error: " ++ unmarshalString p)