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)