1 {-# OPTIONS -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 -----------------------------------------------------------------------------
29 import Foreign.Marshal.Array
30 import Foreign.Marshal.Alloc
31 import Foreign.Storable
32 import Foreign.C.String
37 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
39 checkResult fun = IO $ \ st ->
42 | err `eqAddr#` nullAddr# -> (# st1, res #)
43 | otherwise -> throw (IOException (raiseError err)) st1
45 -- ToDo: attach finaliser.
46 unmarshalObject :: Addr# -> Object a
47 unmarshalObject x = Object x
49 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
50 marshalObject (Object x) cont = cont x
52 -- dotnet interop support passing and returning
54 marshalString :: String
57 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
59 -- char** received back from a .NET interop layer.
60 unmarshalString :: Addr# -> String
61 unmarshalString p = unsafePerformIO $ do
63 str <- peekCString ptr
68 -- room for improvement..
69 raiseError :: Addr# -> IOError
70 raiseError p = userError (".NET error: " ++ unmarshalString p)