Added Unknowns for higher kinds
[packages/random.git] / GHC / Dotnet.hs
1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : GHC.Dotnet
5 -- Copyright : (c) sof, 2003
6 -- License : see libraries/base/LICENSE
7 --
8 -- Maintainer : cvs-ghc@haskell.org
9 -- Stability : internal
10 -- Portability : non-portable (GHC extensions)
11 --
12 -- Primitive operations and types for doing .NET interop
13 --
14 -----------------------------------------------------------------------------
15
16 module GHC.Dotnet
17 ( Object
18 , unmarshalObject
19 , marshalObject
20 , unmarshalString
21 , marshalString
22 , checkResult
23 ) where
24
25 import GHC.Prim
26 import GHC.Base
27 import GHC.IO
28 import GHC.IOBase
29 import GHC.Ptr
30 import Foreign.Marshal.Array
31 import Foreign.Marshal.Alloc
32 import Foreign.Storable
33 import Foreign.C.String
34
35 data Object a
36 = Object Addr#
37
38 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
39 -> IO a
40 checkResult fun = IO $ \ st ->
41 case fun st of
42 (# st1, res, err #)
43 | err `eqAddr#` nullAddr# -> (# st1, res #)
44 | otherwise -> throw (IOException (raiseError err)) st1
45
46 -- ToDo: attach finaliser.
47 unmarshalObject :: Addr# -> Object a
48 unmarshalObject x = Object x
49
50 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
51 marshalObject (Object x) cont = cont x
52
53 -- dotnet interop support passing and returning
54 -- strings.
55 marshalString :: String
56 -> (Addr# -> IO a)
57 -> IO a
58 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
59
60 -- char** received back from a .NET interop layer.
61 unmarshalString :: Addr# -> String
62 unmarshalString p = unsafePerformIO $ do
63 let ptr = Ptr p
64 str <- peekCString ptr
65 free ptr
66 return str
67
68
69 -- room for improvement..
70 raiseError :: Addr# -> IOError
71 raiseError p = userError (".NET error: " ++ unmarshalString p)