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