From 8d3da431df9ba5e21de09a313ae7de0b794f0fc4 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 29 May 2003 14:39:31 +0000
Subject: [PATCH] [project @ 2003-05-29 14:39:31 by sof] Support for
 interop'ing with .NET via FFI declarations along the lines
 of what Hugs98.NET offers, see

 http://haskell.org/pipermail/cvs-hugs/2003-March/001723.html

for FFI decl details.

To enable, configure with --enable-dotnet + have a look
in ghc/rts/dotnet/Makefile for details of what tools are needed to
build the .NET interop layer (tools from VS.NET / Framework SDK.)

The commit doesn't include some library additions + wider-scale
testing is required before this extension can be regarded as available
for general use. 'foreign import dotnet' is currently only supported
by the C backend.
---
 GHC/Dotnet.hs |   70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 GHC/Dotnet.hs

diff --git a/GHC/Dotnet.hs b/GHC/Dotnet.hs
new file mode 100644
index 0000000..9d427fd
--- /dev/null
+++ b/GHC/Dotnet.hs
@@ -0,0 +1,70 @@
+{-# OPTIONS -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)
-- 
1.7.10.4