GHC/Dotnet.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   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.Base
  26 import GHC.Exception
  27 import GHC.IOBase
  28 import GHC.Ptr
  29 import Foreign.Marshal.Alloc
  30 import Foreign.C.String
  31
  32 data Object a
  33   = Object Addr#
  34
  35 checkResult :: (State# RealWorld -> (# State# RealWorld, a, Addr# #))
  36             -> IO a
  37 checkResult fun = IO $ \ st ->
  38   case fun st of
  39     (# st1, res, err #)
  40       | err `eqAddr#` nullAddr# -> (# st1, res #)
  41       | otherwise               -> throw (raiseError err) st1
  42
  43 -- ToDo: attach finaliser.
  44 unmarshalObject :: Addr# -> Object a
  45 unmarshalObject x = Object x
  46
  47 marshalObject :: Object a -> (Addr# -> IO b) -> IO b
  48 marshalObject (Object x) cont = cont x
  49
  50 -- dotnet interop support passing and returning
  51 -- strings.
  52 marshalString :: String
  53               -> (Addr# -> IO a)
  54               -> IO a
  55 marshalString str cont = withCString str (\ (Ptr x) -> cont x)
  56
  57 -- char** received back from a .NET interop layer.
  58 unmarshalString :: Addr# -> String
  59 unmarshalString p = unsafePerformIO $ do
  60    let ptr = Ptr p
  61    str <- peekCString ptr
  62    free ptr
  63    return str
  64
  65
  66 -- room for improvement..
  67 raiseError :: Addr# -> IOError
  68 raiseError p = userError (".NET error: " ++ unmarshalString p)