Haskell/FFI
使用 Haskell 很不错，但在现实世界中，其他语言（特别是 C）中存在大量有用的库。为了使用这些库，并让 C 代码使用 Haskell 函数，我们引入了外部函数接口 (FFI)。
在使用 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 中实现的纯函数在 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 函数是 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 库的典型模式是提供分配内存的指针作为“目标”，以便在其中写入结果，而函数本身返回一个整数值（通常，如果为 0，则计算成功，否则由数字指定了问题）。另一种可能性是函数将返回指向结构体的指针（可能在实现中定义，因此我们无法访问）。
作为教学示例，我们考虑GNU 科学库的 gsl_frexp 函数，这是一个免费提供的科学计算库。这是一个具有以下原型的简单 C 函数。
double gsl_frexp (double x, int * e)
该函数接收一个 double x，并返回其归一化的分数 f 和整数指数 e，使得
我们使用以下代码将该 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 函数通常以 struct 或指向这些结构的指针的形式返回数据。在一些罕见的情况下，这些结构直接返回，但更常见的是作为指针返回；返回值通常是表示执行正确性的 int。
我们将考虑另一个 GSL 函数，gsl_sf_bessel_Jn_e。该函数为给定阶数 n 提供正则圆柱贝塞尔函数，并将结果作为 gsl_sf_result 结构指针返回。该结构包含两个 double，一个用于结果，一个用于错误。函数返回的整型错误代码可以通过函数 gsl_strerror 转换为 C 字符串。因此，我们正在寻找的 Haskell 函数的签名为
BesselJn :: Int -> Double -> Either String (Double, Double)
其中第一个参数是圆柱贝塞尔函数的阶数，第二个是函数的参数，返回值是错误消息或包含结果和误差范围的元组。
为了分配和读取指向 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宏实现。
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 例程、枚举以及处理未知结构的指针。
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 函数目标
[edit | edit source]现在我们可以写下我们想要的函数的签名
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 算法
[edit | edit source]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 数据结构。
处理未知结构
[edit | edit source]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）。
完整函数
[edit | edit source]现在可以实现一个具有与 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 跳过簿记，但让其工作所需的工作量超过了记住一行清理工作的努力。
然后，我们继续检查返回值并返回结果，就像贝塞尔函数一样。
自释放指针
[edit | edit source]在前面的示例中，我们通过调用其 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。就是这样，外部指针准备就绪，可以立即使用！
| 此函数需要编译目标代码，因此，如果你使用 GHCI（一个解释器）加载此模块，则必须指示它 $ ghci GSLWorkSpace.hs -fobject-code 或者，从 GHCI 内部 > :set -fobject-code> :load GSLWorkSpace.hs |
该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
[edit | edit source]有时从 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 源代码
[edit | edit source]文件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 源代码
[edit | edit source]编译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