Haskell/FFI

通用實踐

除錯
 測試
 打包您的軟體 (Cabal)
使用外部函式介面 (FFI)
通用程式設計：摒棄你的模板程式碼

使用 Haskell 很不錯，但在現實世界中，其他語言（特別是 C）中存在大量有用的庫。為了使用這些庫，並讓 C 程式碼使用 Haskell 函式，我們引入了外部函式介面 (FFI)。

從 Haskell 呼叫 C

編組 (型別轉換)

在使用 C 函式時，需要將 Haskell 型別轉換為相應的 C 型別。這些型別在 Foreign.C.Types 模組中可用；以下表格中給出了一些示例。

Haskell	Foreign.C.Types	C
Double	CDouble	double
Char	CUChar	unsigned char
Int	CLong	long int

將 Haskell 型別轉換為 C 型別的操作稱為編組（反之，可以預見地稱為解組）。對於基本型別來說，這相當簡單：對於浮點數，可以使用 realToFrac（無論哪種方式，例如 Double 和 CDouble 都是類 Real 和 Fractional 的例項），對於整數，可以使用 fromIntegral，等等。

呼叫純 C 函式

在 C 中實現的純函式在 Haskell 中不會造成重大麻煩。C 標準庫的 sin 函式就是一個很好的例子。

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.Types

foreign import ccall unsafe "math.h sin"
     c_sin :: CDouble -> CDouble

首先，我們在第一行指定一個用於 FFI 的 GHC 擴充套件。然後，我們匯入 Foreign 和 Foreign.C.Types 模組，後者包含有關 CDouble 的資訊，CDouble 是 C 中雙精度浮點數的表示。

然後，我們指定我們正在匯入一個外部函式，並呼叫 C。需要使用關鍵字 safe（預設值）或 unsafe 指定“安全級別”。通常，unsafe 更有效率，safe 僅在 C 程式碼可能回撥 Haskell 函式時才需要。由於這是一個非常特殊的情況，在大多數情況下使用 unsafe 關鍵字實際上是相當安全的。最後，我們需要指定標頭檔案和函式名稱，用空格隔開。

然後給出 Haskell 函式名，在本例中我們使用標準的 c_sin，但它可以是任何名稱。請注意，函式簽名必須正確——GHC 不會檢查 C 標頭檔案以確認函式實際上接受一個 CDouble 並返回另一個，而編寫一個錯誤的簽名可能會導致不可預知的結果。

然後可以使用 CDouble 生成一個函式包裝器，使其看起來與任何 Haskell 函式完全相同。

haskellSin :: Double -> Double
haskellSin = realToFrac . c_sin . realToFrac

匯入 C 的 sin 很簡單，因為它是一個純函式，接收一個簡單的 double 作為輸入，並返回另一個作為輸出：對於不純函式和指標來說，事情會變得複雜，這些函式和指標在更復雜的 C 庫中無處不在。

不純 C 函式

一個經典的不純 C 函式是 rand，用於生成偽隨機數。假設您不想使用 Haskell 的 System.Random.randomIO，例如因為您想要精確地複製某個 C 例程輸出的偽隨機數序列。然後，您可以像之前的 sin 一樣匯入它。

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.Types

foreign import ccall unsafe "stdlib.h rand"
     c_rand :: CUInt -- Oops!

如果您在 GHCI 中嘗試這個天真的實現，您會注意到 c_rand 始終返回相同的值。

> c_rand
1714636915
> c_rand
1714636915

事實上，我們已經告訴 GHC 它是一個純函式，GHC 認為沒有必要計算一個純函式的結果兩次。請注意，GHC 沒有給出任何錯誤或警告訊息。

為了讓 GHC 理解這不是一個純函式，我們必須使用IO 單子

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.Types

foreign import ccall unsafe "stdlib.h rand"
     c_rand :: IO CUInt

foreign import ccall "stdlib.h srand"
     c_srand :: CUInt -> IO ()

這裡，我們還匯入了 srand 函式，以便能夠為 C 偽隨機生成器播種。

> c_rand
1957747793
> c_rand
424238335
> c_srand 0
> c_rand
1804289383
> c_srand 0
> c_rand
1804289383

使用 C 指標

最有用的 C 函式通常是那些對多個引數進行復雜計算的函式，隨著複雜性的增加，返回值程式碼的需求也隨之出現。這意味著 C 庫的典型模式是提供分配記憶體的指標作為“目標”，以便在其中寫入結果，而函式本身返回一個整數值（通常，如果為 0，則計算成功，否則由數字指定了問題）。另一種可能性是函式將返回指向結構體的指標（可能在實現中定義，因此我們無法訪問）。

作為教學示例，我們考慮GNU 科學庫的 gsl_frexp 函式，這是一個免費提供的科學計算庫。這是一個具有以下原型的簡單 C 函式。

double gsl_frexp (double x, int * e)

該函式接收一個 double x，並返回其歸一化的分數 f 和整數指數 e，使得

x=f\times 2^{e}\qquad e\in \mathbb {Z} ,\quad 0.5\leq f<1

我們使用以下程式碼將該 C 函式與 Haskell 介面連線。

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.Ptr
import Foreign.C.Types
import System.IO.Unsafe         -- for unsafePerformIO

foreign import ccall unsafe "gsl/gsl_math.h gsl_frexp"
     gsl_frexp :: CDouble -> Ptr CInt -> IO CDouble

新部分是 Ptr，它可以與 Storable 類的任何例項一起使用，其中包括所有 C 型別，以及一些 Haskell 型別。

請注意 gsl_frexp 函式的結果在 IO 單子中。這在使用指標時很常見，無論它們用於輸入還是輸出（在本例中）；我們很快就會看到，如果我們為該函式使用一個簡單的 CDouble 會發生什麼。

frexp 函式在純 Haskell 程式碼中實現如下。

frexp :: Double -> (Double, Int)
frexp x = unsafePerformIO $
    alloca $ \expptr -> do
        f <- gsl_frexp (realToFrac x) expptr
        e <- peek expptr
        return (realToFrac f, fromIntegral e)

我們知道，撇開記憶體管理細節，函式是純的：這就是為什麼簽名在 IO monad 之外返回一個包含 f 和 e 的元組。然而，f 是在 IO monad 之內提供的：為了提取它，我們使用函式 unsafePerformIO，它從 IO monad 中提取值：顯然，只有在我們知道函式是純的並且我們可以讓 GHC 最佳化時才可以使用它。

為了分配指標，我們使用 alloca 函式，該函式也負責釋放記憶體。作為引數，alloca 接受一個型別為 Ptr a -> IO b 的函式，並返回 IO b。在實踐中，這轉化為使用以下模式與 λ 函式

... alloca $ \pointer -> do
        c_function argument pointer
        result <- peek pointer
        return result

如果需要多個指標，該模式可以輕鬆巢狀

... alloca $ \firstPointer ->
        alloca $ \secondPointer -> do
            c_function argument firstPointer secondPointer
            first  <- peek firstPointer
            second <- peek secondPointer
            return (first, second)

回到我們的 frexp 函式：在作為 alloca 引數的 λ 函式中，函式被評估，並且指標隨後立即使用 peek 讀取。在這裡，我們可以理解為什麼我們希望匯入的 C 函式 gsl_frexp 在 IO monad 中返回值：如果 GHC 可以決定何時計算數量 f，它很可能決定不在必要之前進行計算：即在最後一行使用 return 時，並且在 e 從已分配但尚未初始化的記憶體地址讀取之後，該地址將包含隨機資料。簡而言之，我們希望 gsl_frexp 返回一個單子值，因為我們希望自己確定計算的順序。

如果其他一些函式需要一個指標來提供輸入而不是儲存輸出，則可以使用類似的 poke 函式來設定指向的值，顯然是在評估函式之前

... alloca $ \inputPointer ->
        alloca $ \outputPointer -> do
            poke inputPointer value
            c_function argument inputPointer outputPointer
            result <- peek outputPointer
            return result

在最後一行，結果在轉換為 C 型別後，被安排在一個元組中並返回。

為了測試函式，請記住將 GHC 連結到 GSL；在 GHCI 中，請執行以下操作

$ ghci frexp.hs -lgsl

(請注意，大多數系統都沒有預裝 GSL，您可能需要下載並安裝其開發包。)

使用 C 結構

C 函式通常以 struct 或指向這些結構的指標的形式返回資料。在一些罕見的情況下，這些結構直接返回，但更常見的是作為指標返回；返回值通常是表示執行正確性的 int。

我們將考慮另一個 GSL 函式，gsl_sf_bessel_Jn_e。該函式為給定階數 n 提供正則圓柱貝塞爾函式，並將結果作為 gsl_sf_result 結構指標返回。該結構包含兩個 double，一個用於結果，一個用於錯誤。函式返回的整型錯誤程式碼可以透過函式 gsl_strerror 轉換為 C 字串。因此，我們正在尋找的 Haskell 函式的簽名為

BesselJn :: Int -> Double -> Either String (Double, Double)

其中第一個引數是圓柱貝塞爾函式的階數，第二個是函式的引數，返回值是錯誤訊息或包含結果和誤差範圍的元組。

建立 `Storable` 類的新例項

為了分配和讀取指向 gsl_sf_result 結構的指標，需要將其設定為 Storable 類的例項。

為了做到這一點，使用 hsc2hs 程式很有用：我們首先建立一個Bessel.hsc檔案，使用 Haskell 和 C 宏的混合語法，該檔案稍後由命令擴充套件為 Haskell

$ hsc2hs Bessel.hsc

之後，我們只需在 GHC 中載入Bessel.hs檔案。

這是檔案的第一部分Bessel.hsc:

{-# LANGUAGE ForeignFunctionInterface #-}

module Bessel (besselJn) where

import Foreign
import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types

#include <gsl/gsl_sf_result.h>

data GslSfResult = GslSfResult { gsl_value :: CDouble, gsl_error :: CDouble }

instance Storable GslSfResult where
    sizeOf    _ = (#size gsl_sf_result)
    alignment _ = alignment (undefined :: CDouble)
    peek ptr = do
        value <- (#peek gsl_sf_result, val) ptr
        error <- (#peek gsl_sf_result, err) ptr
        return  GslSfResult { gsl_value = value, gsl_error = error }
    poke ptr (GslSfResult value error) = do
        (#poke gsl_sf_result, val) ptr value
        (#poke gsl_sf_result, err) ptr error

我們使用 #include 指令來確保 hsc2hs 知道在哪裡找到有關 gsl_sf_result 的資訊。然後，我們定義一個映象 GSL 的 Haskell 資料結構，其中包含兩個 CDouble：這是我們設定為 Storable 例項的類。嚴格地說，對於本示例，我們只需要 sizeOf、alignment 和 peek；新增 poke 以確保完整性。

sizeOf 顯然是分配過程的基礎，由 hsc2hs 使用 #size 宏計算。
alignment 是以位元組為單位的資料結構對齊方式大小。通常，它應該是結構元素中最大的 alignment；在我們的例子中，由於兩個元素相同，我們只使用 CDouble 的 alignment。alignment 引數的值無關緊要，重要的是引數的型別。
peek 使用 do 塊和 #peek 宏實現，如所示。val 和 err 是在 GSL 原始碼中用於結構欄位的名稱。
類似地，poke 使用 #poke 宏實現。

匯入 C 函式

foreign import ccall unsafe "gsl/gsl_bessel.h gsl_sf_bessel_Jn_e"
     c_besselJn :: CInt -> CDouble -> Ptr GslSfResult -> IO CInt

foreign import ccall unsafe "gsl/gsl_errno.h gsl_set_error_handler_off"
     c_deactivate_gsl_error_handler :: IO ()

foreign import ccall unsafe "gsl/gsl_errno.h gsl_strerror"
     c_error_string :: CInt -> IO CString

我們從 GSL 庫中匯入多個函式：首先是貝塞爾函式本身，它將執行實際的工作。然後，我們需要一個特定的函式 gsl_set_error_handler_off，因為預設的 GSL 錯誤處理程式將直接使程式崩潰，即使被 Haskell 呼叫也是如此：相反，我們計劃自己處理錯誤。最後一個函式是 GSL 範圍內的直譯器，它將錯誤程式碼轉換為可讀的 C 字串。

實現貝塞爾函式

最後，我們可以實現階數為 n 的 GSL 圓柱貝塞爾函式的 Haskell 版本。

besselJn :: Int -> Double -> Either String (Double, Double)
besselJn n x = unsafePerformIO $
    alloca $ \gslSfPtr -> do
        c_deactivate_gsl_error_handler
        status <- c_besselJn (fromIntegral n) (realToFrac x) gslSfPtr
        if status == 0
            then do
                GslSfResult val err <- peek gslSfPtr
                return $ Right (realToFrac val, realToFrac err)
            else do
                error <- c_error_string status
                error_message <- peekCString error
                return $ Left ("GSL error: "++error_message)

我們再次使用 unsafePerformIO，因為函式是純的，即使其底層實現不是純的也是如此。在分配指向 GSL 結果結構的指標之後，我們停用 GSL 錯誤處理程式以避免在出現錯誤時發生崩潰，最後我們可以呼叫 GSL 函式。此時，如果函式返回的 status 為 0，我們將取消編組結果並將其作為元組返回。否則，我們將呼叫 GSL 錯誤字串函式，並將錯誤作為 Left 結果傳遞。

示例

完成 Bessel.hsc 函式的編寫後，我們需要將其轉換為正確的 Haskell 並載入生成的檔案

$ hsc2hs Bessel.hsc
$ ghci Bessel.hs -lgsl

然後，我們可以使用多個值呼叫貝塞爾函式

> besselJn 0 10
Right (-0.2459357644513483,1.8116861737200453e-16)
> besselJn 1 0
Right (0.0,0.0)
> besselJn 1000 2
Left "GSL error: underflow"

高階主題

本節包含一個高階示例，其中包含 FFI 的一些更復雜的功能。我們將把 GSL 的一個更復雜的函式匯入 Haskell，該函式用於計算給定兩點之間函式的積分，使用自適應高斯-克朗羅德演算法。GSL 函式為 gsl_integration_qag。

本示例將說明函式指標、將 Haskell 函式匯出到 C 例程、列舉以及處理未知結構的指標。

可用的 C 函式和結構

GSL 有三個函式是使用所考慮的方法對給定函式進行積分所必需的

gsl_integration_workspace * gsl_integration_workspace_alloc (size_t n);
void gsl_integration_workspace_free (gsl_integration_workspace * w);
int gsl_integration_qag (const gsl_function * f, double a, double b, 
                         double epsabs, double epsrel, size_t limit, 
                         int key, gsl_integration_workspace * workspace, 
                         double * result, double * abserr);

前兩個函式處理“工作區”結構的分配和釋放，我們對該結構一無所知（我們只是傳遞指標）。實際工作由最後一個函式完成，該函式需要指向工作區的指標。

為了提供函式，GSL 為 C 指定了適當的結構

struct gsl_function
{
  double (* function) (double x, void * params);
  void * params;
};

void 指標的原因是，在 C 中無法定義 λ 函式，因此該函式不能用一些獨立於 x 的通用引數進行部分應用，因此這些引數在未知型別的指標中傳遞。在 Haskell 中，我們不需要 params 元素，並將始終忽略它。

匯入和包含

我們從qag.hsc檔案開始，其中包含以下內容

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}

module Qag ( qag,
             gauss15,
             gauss21,
             gauss31,
             gauss41,
             gauss51,
             gauss61 ) where

import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String

#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>

foreign import ccall unsafe "gsl/gsl_errno.h gsl_strerror"
     c_error_string :: CInt -> IO CString

foreign import ccall unsafe "gsl/gsl_errno.h gsl_set_error_handler_off"
    c_deactivate_gsl_error_handler :: IO ()

我們宣告 EmptyDataDecls pragma，我們將在後面的 Workspace 資料型別中使用它。由於此檔案將包含大量不應提供給外部世界使用的函式，因此我們還將其宣告為模組，並且只匯出最終函式 qag 和 gauss 標誌。我們還包含 GSL 的相關 C 標頭檔案。之前已經描述了匯入用於錯誤訊息和停用錯誤處理程式的 C 函式。

列舉

gsl_integration_qag 的引數之一是 key，這是一個整數型別的值，取值範圍為 1 到 6，它指示了積分規則。GSL 為每個值定義了一個宏，但在 Haskell 中定義一個型別更為合適，我們稱之為 IntegrationRule。此外，為了讓其值由hsc2hs自動定義，我們可以使用 enum 宏

newtype IntegrationRule = IntegrationRule { rule :: CInt }
#{enum IntegrationRule, IntegrationRule,
    gauss15 = GSL_INTEG_GAUSS15,
    gauss21 = GSL_INTEG_GAUSS21,
    gauss31 = GSL_INTEG_GAUSS31,
    gauss41 = GSL_INTEG_GAUSS41,
    gauss51 = GSL_INTEG_GAUSS51,
    gauss61 = GSL_INTEG_GAUSS61
  }

hsc2hs它將搜尋標頭檔案以查詢宏，併為我們的變數分配正確的值。enum 指令將為每個列舉值定義一個具有適當型別簽名的函式。上面的示例將被翻譯成類似於以下內容（用 C 宏替換其相應的數值）

newtype IntegrationRule = IntegrationRule { rule :: CInt }

gauss15  :: IntegrationRule
gauss15  = IntegrationRule GSL_INTEG_GAUSS15
gauss21  :: IntegrationRule
gauss21  = IntegrationRule GSL_INTEG_GAUSS21
.
.
.

這些變數不可修改，本質上是常量標記。由於我們沒有在模組宣告中匯出 IntegrationRule 建構函式，而只匯出了 gauss 標記，因此使用者甚至無法構建無效的值。少了一件需要擔心的事情！

Haskell 函式目標

現在我們可以寫下我們想要的函式的簽名

qag :: IntegrationRule                 -- Algorithm type
    -> Int                             -- Step limit
    -> Double                          -- Absolute tolerance
    -> Double                          -- Relative tolerance
    -> (Double -> Double)              -- Function to integrate
    -> Double                          -- Integration interval start
    -> Double                          -- Integration interval end
    -> Either String (Double, Double)  -- Result and (absolute) error estimate

注意引數的順序與 C 版本不同：實際上，由於 C 沒有部分應用的可能性，所以排序標準與 Haskell 中不同。

與前面的示例一樣，我們用 Either String (Double, Double) 結果來表示錯誤。

將 Haskell 函式傳遞給 C 演算法

type CFunction = CDouble -> Ptr () -> CDouble

data GslFunction = GslFunction (FunPtr CFunction) (Ptr ())
instance Storable GslFunction where
    sizeOf    _ = (#size gsl_function)
    alignment _ = alignment (undefined :: Ptr ())
    peek ptr = do
        function <- (#peek gsl_function, function) ptr
        return $ GslFunction function nullPtr
    poke ptr (GslFunction fun nullPtr) = do
        (#poke gsl_function, function) ptr fun

makeCfunction :: (Double -> Double) -> (CDouble -> Ptr () -> CDouble)
makeCfunction f = \x voidpointer -> realToFrac $ f (realToFrac x)

foreign import ccall "wrapper"
    makeFunPtr :: CFunction -> IO (FunPtr CFunction)

為了便於閱讀，我們定義了一個簡寫型別 CFunction。請注意，void 指標已轉換為 Ptr ()，因為我們不打算使用它。接下來是 gsl_function 結構：這裡沒有意外。請注意，void 指標始終被假定為 null，無論是在 peek 中還是在 poke 中，並且實際上從未被讀取或寫入。

為了使 Haskell Double -> Double 函式可供 C 演算法使用，我們執行兩個步驟：首先，我們使用 makeCfunction 中的 λ 函式重新排列引數；然後，在 makeFunPtr 中，我們獲取具有重新排序引數的函式，並生成一個函式指標，我們可以將其傳遞給 poke，以便我們可以構建 GslFunction 資料結構。

處理未知結構

data Workspace
foreign import ccall unsafe "gsl/gsl_integration.h gsl_integration_workspace_alloc"
    c_qag_alloc :: CSize -> IO (Ptr Workspace)
foreign import ccall unsafe "gsl/gsl_integration.h gsl_integration_workspace_free"
    c_qag_free  :: Ptr Workspace -> IO ()

foreign import ccall safe "gsl/gsl_integration.h gsl_integration_qag"
    c_qag :: Ptr GslFunction -- Allocated GSL function structure
          -> CDouble -- Start interval
          -> CDouble -- End interval
          -> CDouble -- Absolute tolerance
          -> CDouble -- Relative tolerance
          -> CSize   -- Maximum number of subintervals
          -> CInt    -- Type of Gauss-Kronrod rule
          -> Ptr Workspace -- GSL integration workspace
          -> Ptr CDouble -- Result
          -> Ptr CDouble -- Computation error
          -> IO CInt -- Exit code

我們匯入 EmptyDataDecls 擴充套件的原因是：我們聲明瞭資料結構 Workspace，但沒有提供任何建構函式。這是一種確保它始終被作為指標處理，而不會真正例項化的方式。

否則，我們通常匯入分配和釋放例程。現在我們可以匯入積分函式，因為我們擁有所有必需的部分（GslFunction 和 Workspace）。

完整函式

現在可以實現一個具有與 GSL 的 QAG 演算法相同功能的函數了。

qag gauss steps abstol reltol f a b = unsafePerformIO $ do
    c_deactivate_gsl_error_handler
    workspacePtr <- c_qag_alloc (fromIntegral steps)
    if workspacePtr == nullPtr
        then
            return $ Left "GSL could not allocate workspace"
        else do
            fPtr <- makeFunPtr $ makeCfunction f
            alloca $ \gsl_f -> do
                poke gsl_f (GslFunction fPtr nullPtr)
                alloca $ \resultPtr -> do
                    alloca $ \errorPtr -> do
                        status <- c_qag gsl_f
                                        (realToFrac a)
                                        (realToFrac b)
                                        (realToFrac abstol)
                                        (realToFrac reltol)
                                        (fromIntegral steps)
                                        (rule gauss)
                                        workspacePtr
                                        resultPtr
                                        errorPtr
                        c_qag_free workspacePtr
                        freeHaskellFunPtr fPtr
                        if status /= 0
                            then do
                                c_errormsg <- c_error_string status
                                errormsg   <- peekCString c_errormsg
                                return $ Left errormsg
                            else do
                                c_result <- peek resultPtr
                                c_error  <- peek  errorPtr
                                let result = realToFrac c_result
                                let error  = realToFrac c_error
                                return $ Right (result, error)

首先，我們停用 GSL 錯誤處理程式，該處理程式會使程式崩潰，而不是讓我們報告錯誤。

然後，我們繼續分配工作區；請注意，如果返回的指標為 null，則存在必須報告的錯誤（通常是大小過大）。

如果工作區分配成功，我們將給定函式轉換為函式指標，並分配 GslFunction 結構，在其中放置函式指標。為結果及其誤差範圍分配記憶體是呼叫主例程之前的最後一件事。

呼叫後，我們必須進行一些清理工作，釋放工作區和函式指標分配的記憶體。請注意，可以使用 ForeignPtr 跳過簿記，但讓其工作所需的工作量超過了記住一行清理工作的努力。

然後，我們繼續檢查返回值並返回結果，就像貝塞爾函式一樣。

自釋放指標

在前面的示例中，我們透過呼叫其 C 釋放函式來手動處理 GSL 積分工作區的釋放，這是一個我們一無所知的 data structure。碰巧，相同的 workspace 被用於多個積分例程，我們可能希望在 Haskell 中匯入這些例程。

與其每次都複製相同的分配/釋放程式碼（當有人忘記釋放部分時會導致記憶體洩漏），不如提供一種“智慧指標”，當不再需要時，它會釋放記憶體。這就是所謂的 ForeignPtr（不要與 Foreign.Ptr 混淆：此處的限定名稱實際上是 Foreign.ForeignPtr！）。處理釋放的函式稱為終結器。

在本節中，我們將編寫一個簡單的模組來分配 GSL 工作區，並將它們提供為配置適當的 ForeignPtr，這樣使用者就不必擔心釋放問題了。

該模組，寫在檔案GSLWorkspace.hs中，如下所示

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}

module GSLWorkSpace (Workspace, createWorkspace) where

import Foreign.C.Types
import Foreign.Ptr
import Foreign.ForeignPtr

data Workspace
foreign import ccall unsafe "gsl/gsl_integration.h gsl_integration_workspace_alloc"
    c_ws_alloc :: CSize -> IO (Ptr Workspace)
foreign import ccall unsafe "gsl/gsl_integration.h &gsl_integration_workspace_free"
    c_ws_free  :: FunPtr( Ptr Workspace -> IO () )

createWorkspace :: CSize -> IO (Maybe (ForeignPtr Workspace) )
createWorkspace size = do
    ptr <- c_ws_alloc size
    if ptr /= nullPtr
        then do
           foreignPtr <- newForeignPtr c_ws_free ptr
           return $ Just foreignPtr
        else
           return Nothing

我們首先宣告空資料結構 Workspace，就像我們在上一節中所做的那樣。

gsl_integration_workspace_alloc 和 gsl_integration_workspace_free 函式在任何其他檔案中將不再需要：這裡請注意，釋放函式是用一個取地址符號（“&”）呼叫的，因為我們實際上並不想要該函式，而是想要一個指向它的指標，將其設定為終結器。

workspace 建立函式返回一個 IO (Maybe) 值，因為仍然有可能分配失敗，並且返回 null 指標。GSL 沒有指定對 null 指標呼叫釋放函式會發生什麼，所以為了安全起見，我們不會在這種情況下設定終結器，而是返回 IO Nothing；使用者程式碼然後必須檢查返回值的“Just-ness”。

如果分配函式生成的指標不為 null，我們將使用釋放函式構建一個外部指標，將其注入 Maybe，然後注入 IO monad。就是這樣，外部指標準備就緒，可以立即使用！

該qag.hsc檔案現在必須修改為使用新模組；更改的部分是

{-# LANGUAGE ForeignFunctionInterface #-}

-- [...]

import GSLWorkSpace

import Data.Maybe(isNothing, fromJust)

-- [...]

qag gauss steps abstol reltol f a b = unsafePerformIO $ do
    c_deactivate_gsl_error_handler
    ws <- createWorkspace (fromIntegral steps)
    if isNothing ws
        then
            return $ Left "GSL could not allocate workspace"
        else do
            withForeignPtr (fromJust ws) $ \workspacePtr -> do

-- [...]

顯然，我們不再需要 EmptyDataDecls 擴充套件；相反，我們匯入 GSLWorkSpace 模組，以及來自 Data.Maybe 的幾個方便的函式。我們還刪除了 workspace 分配和釋放函式的外部宣告。

最重要的區別在於主函式，在主函式中，我們（嘗試）分配一個 workspace ws，測試其 Just-ness，如果一切正常，我們將使用 withForeignPtr 函式提取 workspace 指標。其他一切都一樣。

從 C 呼叫 Haskell

有時從 C 呼叫 Haskell 也很方便，以便利用 Haskell 中的一些在 C 中實現起來很繁瑣的功能，例如惰性求值。

我們將考慮一個典型的 Haskell 示例，斐波那契數列。這些數字可以用一行優雅的 Haskell 程式碼生成，如下所示

fibonacci = 0 : 1 : zipWith (+) fibonacci (tail fibonacci)

我們的任務是將計算斐波那契數列的能力從 Haskell 匯出到 C。但是，在 Haskell 中，我們通常使用 Integer 型別，該型別是無界的：這無法匯出到 C，因為沒有相應的型別。為了提供更大的輸出範圍，我們指定 C 函式在結果超出其整數型別的界限時，應輸出一個浮點數的近似值。如果結果也超出了浮點數的範圍，則計算將失敗。結果的狀態（是否可以表示為 C 整數、浮點數型別或根本不能表示）由函式返回的狀態整數來表示。因此，其期望簽名為

int fib( int index, unsigned long long* result, double* approx )

Haskell 原始碼

檔案fibonacci.hs的 Haskell 原始碼為

{-# LANGUAGE ForeignFunctionInterface #-}

module Fibonacci where

import Foreign
import Foreign.C.Types

fibonacci :: (Integral a) => [a]
fibonacci = 0 : 1 : zipWith (+) fibonacci (tail fibonacci)

foreign export ccall fibonacci_c :: CInt -> Ptr CULLong -> Ptr CDouble -> IO CInt
fibonacci_c :: CInt -> Ptr CULLong -> Ptr CDouble -> IO CInt
fibonacci_c n intPtr dblPtr
    | badInt && badDouble = return 2
    | badInt              = do
        poke dblPtr dbl_result
        return 1
    | otherwise           = do
        poke intPtr (fromIntegral result)
        poke dblPtr dbl_result
        return 0
    where
    result     = fibonacci !! (fromIntegral n)
    dbl_result = realToFrac result
    badInt     = result > toInteger (maxBound :: CULLong)
    badDouble  = isInfinite dbl_result

在匯出時，我們需要將我們的函式包裝在一個模組中（這始終是一個好習慣）。我們已經看到了斐波那契無窮列表，所以讓我們重點關注匯出的函式：它接受一個引數，兩個指向目標 unsigned long long 和 double 的指標，並在 IO monad 中返回狀態（因為寫入指標是一個副作用）。

該函式使用輸入保護來實現，輸入保護定義在底部的 where 子句中。成功的計算將返回 0，部分成功的計算將返回 1（在這種情況下，我們仍然可以將浮點數作為近似值），完全不成功的計算將返回 2。

請注意，該函式沒有呼叫 alloca，因為假設指標已由呼叫的 C 函式分配。

然後，可以使用 GHC 編譯 Haskell 程式碼

ghc -c fibonacci.hs

C 原始碼

編譯fibonacci.hs已經生成了幾個檔案，其中包括fibonacci_stub.h，我們將其包含在檔案fib.c:

#include <stdio.h>
#include <stdlib.h>
#include "fibonacci_stub.h"

int main(int argc, char *argv[]) {
    if (argc < 2) {
        printf("Usage: %s <number>\n", argv[0]);
        return 2;
    }

    hs_init(&argc, &argv);

    const int arg = atoi(argv[1]);
    unsigned long long res;
    double approx;
    const int status = fibonacci_c(arg, &res, &approx);

    hs_exit();
    switch (status) {
    case 0:
        printf("F_%d: %llu\n", arg, res);
        break;
    case 1:
        printf("Error: result is out of bounds\n");
        printf("Floating-point approximation: %e\n", approx);
        break;
    case 2:
        printf("Error: result is out of bounds\n");
        printf("Floating-point approximation is infinite\n");
        break;
    default:
        printf("Unknown error: %d\n", status);
    }

    return status;
}

中的 C 程式碼中。值得注意的是，我們需要使用 hs_init 初始化 Haskell 環境，我們呼叫它並將 main 的命令列引數傳遞給它；我們還在完成後使用 hs_exit() 關閉 Haskell。其餘部分是相當標準的 C 程式碼，用於分配和錯誤處理。

請注意，你必須使用 GHC編譯 C 程式碼，而不是使用你的 C 編譯器！

ghc -no-hs-main fib.c fibonacci.o -o fib

然後，你可以繼續測試該演算法

./fib 42
F_42: 267914296
$ ./fib 666
Error: result is out of bounds
Floating-point approximation: 6.859357e+138
$ ./fib 1492
Error: result is out of bounds
Floating-point approximation is infinite
./fib -1
fib: Prelude.(!!): negative index

FFI

練習解答