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 -----------------------------------------------------------------------------
29 import Foreign.Marshal.Alloc
30 import Foreign.C.String
35 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
37 checkResult fun = IO $ \ st ->
40 | err `eqAddr#` nullAddr# -> (# st1, res #)
41 | otherwise -> throw (raiseError err) st1
43 -- ToDo: attach finaliser.
44 unmarshalObject :: Addr# -> Object a
45 unmarshalObject x = Object x
47 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
48 marshalObject (Object x) cont = cont x
50 -- dotnet interop support passing and returning
52 marshalString :: String
55 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
57 -- char** received back from a .NET interop layer.
58 unmarshalString :: Addr# -> String
59 unmarshalString p = unsafePerformIO $ do
61 str <- peekCString ptr
66 -- room for improvement..
67 raiseError :: Addr# -> IOError
68 raiseError p = userError (".NET error: " ++ unmarshalString p)