Haskell で文字列型を使ったDLLの作成例

HaskellのDLLの作成については次の記事を参照．
13.6. Win32のDLLをビルド・利用する

文字列型のDLLの作成については次の記事を参照．
VB6, VBA の文字列 String を返す DLLを作成する - happynowの日記

DLL の作成

-- HsConcat.hs
{-# LANGUAGE ForeignFunctionInterface #-}
module HsConcat where
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Ptr (nullPtr)

foreign import stdcall "windows.h SysAllocString" cSysAllocString :: CWString -> IO CWString
foreign export stdcall hsConcat :: CWString -> CWString -> IO CWString

hsConcat :: CWString -> CWString -> IO CWString
hsConcat a b = do
    s1 <- toHsString a
    s2 <- toHsString b
    cstr <- newCWString (s1 ++ s2)
    ret <- cSysAllocString cstr
    free cstr
    return ret

  where toHsString s = if s == nullPtr    -- peekCWString に NULLを与えるとクラッシュするため、NULLなら、空文字列に置換.
                       then return ""
                       else peekCWString s

// StartEnd.c
#include <Rts.h>

void HsStart()
{
   int argc = 1;
   char* argv[] = {"ghcDll", NULL}; // argvはNULLで終わっていなければならない

   // Haskellのランタイムを初期化する
   char** args = argv;
   hs_init(&argc, &args);
}

void HsEnd()
{
   hs_exit();
}

コンパイル、リンク

gcc -c HsConcat.hs
gcc -c StartEnd.c
gcc -shared -o HsConcat.dll HsConcat.o StartEnd.o -loleaut32

呼出し側 (Excel VBAでの使用例)
コンパイルされた HsConcat.dll と Book.xls を同一フォルダに置く。
Book.xlsには以下、ふたつのモジュールを記述する。

'同一フォルダにあるDLLファイルのロード、アンロード
Option Explicit

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Sub HsStart Lib "HsConcat.dll" ()
Public Declare Sub HsEnd Lib "HsConcat.dll" ()
'

Private Property Get LibraryPath() As String
    LibraryPath = ThisWorkbook.Path & "\HsConcat.dll"
End Property

Private Sub Auto_Open()
    LoadDLL
    HsStart
End Sub

Private Sub Auto_Close()
    HsEnd
    FreeDLL
End Sub

Private Sub LoadDLL()
    If 0 = GetModuleHandle(StrPtr(LibraryPath)) Then
        LoadLibrary StrPtr(LibraryPath)
    End If
End Sub

Private Sub FreeDLL()
    Dim hLib As Long
    hLib = GetModuleHandle(StrPtr(LibraryPath))
    If hLib <> 0 Then
        FreeLibrary hLib
    End If
End Sub

'DLL関数の呼出しコード
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Public Declare Function HsConcat Lib "HsConcat.dll" Alias "hsConcat@8" (ByVal x As Long, ByVal y As Long) As Long
'

Sub TestHsConcat()

    Debug.Print Concat("かきくxけこ", "def")

    Debug.Print Concat(vbNullString, "ab あいうc")

    Debug.Print Concat("らりるれ", vbNullString)

    Debug.Print Concat(vbNullString, vbNullString)

End Sub

Function Concat(s1 As String, s2 As String) As String
    Concat = PtrToString(HsConcat(StrPtr(s1), StrPtr(s2)))
End Function

Private Function PtrToString(pBSTR As Long) As String
    CopyMemory VarPtr(PtrToString), VarPtr(pBSTR), Len(pBSTR)
End Function

peekCStringにNULLポインタを渡すとエラー（セグメンテーション・フォールト）になることが、次の記事にレポートされている。しかし、これは期待すべき動作であるとしてクローズされている。

The module is described as "Utilities for primitive marshalling of C strings", so I think a segfault is the expected behaviour when passing a NULL pointer.
http://ghc.haskell.org/trac/ghc/ticket/4906