Haskell FFI：在C程序中使用数据类型

Question

我与Haskell一起编写了一个库，希望将其用于C程序。我已经阅读了一些有关使用foreign export ccall命令和Foreign模块的文档。

我已经看到了一些例子，如这一个，但这些实施例使用常用的C类型，如Int或Double。

在我的库中，我创建了一些数据类型，例如：

data OrdSymb = SEQ
             | SLT
             | SGT

或提供类型的递归：

data MyType a =
        TypeDouble Double
      | TypeInt Int
      | TypeVar a 
      | TypeAdd (MyType a) (MyType a) 

但是我没有找到如何在FFI中使用/导出这些类型。

如何将自己的数据类型导出到C并在foreign声明中使用它们导出函数？

Answer 1

您问题的简短答案是：

• 如此处所建议的，以及在对相关问题的评论中所建议的，首先要完全设计C API，包括希望从C代码中使用的C数据表示形式和C函数。这不是一个微不足道的步骤。您在此处做出的设计决策将影响您将这些Haskell类型导出（又称为C）并返回到C的方法。
• 使用“ C-to-Haskell”助手来自动执行尺寸，对齐和结构成员访问的螺母和螺栓。无论是hsc2hs或c2hs或两者可能会有所帮助。这些工具不是为将 Haskell函数导出到C 而设计的，但它们仍然有用。
• 期望花费大量时间阅读整个FFI子系统，研究上述工具产生的输出，并编写大量C胶。任何非平凡的语言绑定都是复杂的，而且您试图通过以“低级”语言进行绑定来公开以“高级”语言编写的库这一事实使其更具挑战性。

现在，这是对您的问题的（非常非常长的）答案，实际上可以为您提供一些帮助。首先需要一些进口：

-- file: MyLib1.hs
module MyLib1 where

import Control.Exception.Base
import Foreign
import Foreign.C

绑定一个枚举

让我们从第一个数据类型开始，这是一个带有0元构造函数的简单求和类型：

data OrdSymb = SEQ | SLT | SGT deriving (Show, Eq)

具体来说，假设我们也有一些符号：

newtype Symbol = Symbol String

并且我们希望使用以下签名公开Haskell函数：

compareSymb :: Symbol -> Symbol -> OrdSymb
compareSymb (Symbol x) (Symbol y) =
  case compare x y of { EQ -> SEQ; LT -> SLT; GT -> SGT }

checkSymb :: Symbol -> OrdSymb -> Symbol -> Bool
checkSymb x ord y = compareSymb x y == ord

诚然，这checkSymb是愚蠢的，但是我想展示既产生OrdSymb结果又接受OrdSymb参数的函数示例。

这是我们想要用于这些数据类型和函数的C接口。带有0元构造函数的sum类型的自然C表示形式是一个枚举，因此我们得到如下所示：

enum ord_symb {
        SLT = -1,
        SEQ = 0,
        SGT = 1
};

符号只能由指向NUL终止的C字符串的指针表示：

typedef char* symbol;

导出函数的签名将类似于：

enum ord_symb compare_symb(symbol x, symbol y);
bool check_symb(symbol x, enum ord_symb ord, symbol y);

这是完全没有C-to-Haskell帮助器的完全手动创建C语言绑定的方法。这有点乏味，但是看到它可以帮助您了解引擎盖下发生的事情。

我们需要显式映射，对于OrdSymb类型，Haskell的构造表示（之间SLT，SEQ和SGT）以及C表示为一个整数（-1，0或1）。您可以用几个简单的函数（例如toOrdSymb和fromOrdSymb）来做到这一点，尽管Haskell为Enum类提供了一些符合以下描述的函数：

instance Enum OrdSymb where

  toEnum (-1) = SLT
  toEnum 0    = SEQ
  toEnum 1    = SGT

  fromEnum SLT = -1
  fromEnum SEQ = 0
  fromEnum SGT = 1

出于文档目的，定义一个表示C侧类型的类型也很有帮助enum ord_symb。C标准说，枚举与ints 具有相同的表示形式，因此我们将编写：

type C_OrdSymb = CInt

现在，因为它OrdSymb是一种简单的类型，所以创建一个实例可以使其在预先分配的内存中与C之间进行编组可能很有意义。看起来像这样：Storableenum ord_symb

instance Storable OrdSymb where
  sizeOf _ = sizeOf (undefined :: C_OrdSymb)
  alignment _ = alignment (undefined :: C_OrdSymb)
  peek ptr = genToEnum <$> peek (castPtr ptr :: Ptr C_OrdSymb)
  poke ptr val = poke (castPtr ptr :: Ptr C_OrdSymb) (genFromEnum val)

我们在其中使用了辅助函数的位置：

genToEnum :: (Integral a, Enum b) => a -> b
genToEnum = toEnum . fromIntegral

genFromEnum :: (Integral a, Enum b) => b -> a
genFromEnum = fromIntegral . fromEnum

的peek和poke在这里只是包装为纯相应方法CIntS，和它们使用的toEnum和fromEnum上面所定义的方法来执行实际的变换。

请注意，此Storable实例在技术上不是必需的。我们可以OrdSymb在enum ord_symb没有这种情况的情况下将C 编组进出，实际上，在下面的示例中，这就是我们要做的。但是，Storable如果以后我们必须使用包含一个enum ord_symb成员的C结构，或者发现我们正在编组enum ord_symbs或其他东西的数组，则可能会派上用场。

但是，值得牢记的是-通常来说，与C进行封送处理的对象不需要是Storable，并且进行某些事情Storable并不能神奇地处理封送处理的所有细节。特别是，如果我们尝试为编写Storable实例，则会Symbol遇到麻烦。 Storables应该具有预定的长度，因此sizeOf不应检查它的参数。但是，Symbol的大小取决于基础字符串，因此，除非我们决定实现最大字符串长度并Symbol以这种方式存储所有s，否则我们不应Storable在此处使用实例。相反，让我们为Symbols 编写一些封送处理功能，而没有Storable该类的好处：

peekSymbol :: Ptr Symbol -> IO Symbol
peekSymbol ptr = Symbol <$> peekCString (castPtr ptr)

newSymbol :: Symbol -> IO (Ptr Symbol)
newSymbol (Symbol str) = castPtr <$> newCString str

freeSymbol :: Ptr Symbol -> IO ()
freeSymbol = free

请注意，我们不会“戳”符号，因为通常我们没有将符号写入其中的大小正确的预分配缓冲区。相反，当我们想将输出封Symbol送给C时，我们需要为其分配一个新的C字符串，这就是要newSymbol执行的操作。为避免内存泄漏，我们需要在使用完符号后调用freeSymbol（或仅调用free）符号（或让我们的C绑定用户知道它们负责free在指针上调用C函数）。这也意味着编写一个帮助程序来包装使用编组符号的计算而不会泄漏内存的帮助程序可能会有所帮助。同样，这是我们在本示例中实际上不会使用的东西，但这是定义的一种有用的东西：

withSymbol :: Symbol -> (Ptr Symbol -> IO a) -> IO a
withSymbol sym = bracket (newSymbol sym) freeSymbol

现在，我们可以通过编写执行封送处理的包装器来导出Haskell函数：

mylib_compare_symb :: Ptr Symbol -> Ptr Symbol -> IO C_OrdSymb
mylib_compare_symb px py = do
  x <- peekSymbol px
  y <- peekSymbol py
  return $ genFromEnum (compareSymb x y)

mylib_check_symb :: Ptr Symbol -> C_OrdSymb -> Ptr Symbol -> IO CInt
mylib_check_symb px ord py = do
  x <- peekSymbol px
  y <- peekSymbol py
  return $ genFromEnum (checkSymb x (genToEnum ord) y)

请注意，genFromEnum最后一行中的Enum代表Haskell Bool类型的实例，将false / true转换为0/1。

另外，值得注意的是，对于这些包装器，我们根本没有使用任何Storable实例！

最后，我们可以将包装函数导出到C。

foreign export ccall mylib_compare_symb
  :: Ptr Symbol -> Ptr Symbol -> IO C_OrdSymb
foreign export ccall mylib_check_symb
  :: Ptr Symbol -> C_OrdSymb -> Ptr Symbol -> IO CInt

如果你把以上所有的Haskell代码到MyLib1.hs，创建 mylib.h，example1.c以及ffitypes.cabal与内容如下：

// file: mylib.h
#ifndef MYLIB_H
#define MYLIB_H

enum ord_symb {
        SLT = -1,
        SEQ = 0,
        SGT = 1
};
typedef char* symbol;   // NUL-terminated string

// don't need these signatures -- they'll be autogenerated into
// MyLib1_stub.h
//enum ord_symb compare_symb(symbol x, symbol y);
//bool check_symb(symbol x, enum ord_symb ord, symbol y);

#endif

和：

// file: example1.c
#include <HsFFI.h>
#include "MyLib1_stub.h"
#include <stdio.h>

#include "mylib.h"

int main(int argc, char *argv[])
{
    hs_init(&argc, &argv);

    symbol foo = "foo";
    symbol bar = "bar";

    printf("%s\n", mylib_compare_symb(foo, bar) == SGT ? "pass" : "fail");
    printf("%s\n", mylib_check_symb(foo, SGT, bar) ? "pass" : "fail");
    printf("%s\n", mylib_check_symb(foo, SEQ, bar) ? "fail" : "pass");

    hs_exit();
    return 0;
}

和：

-- file: ffitypes.cabal
name:                 ffitypes
version:              0.1.0.0
cabal-version:        >= 1.22
build-type:           Simple

executable example1
  main-is:            example1.c
  other-modules:      MyLib1
  include-dirs:       .
  includes:           mylib.h
  build-depends:      base
  default-language:   Haskell2010
  cc-options:         -Wall -O
  ghc-options:        -Wall -Wno-incomplete-patterns -O

并将所有内容放在一个新ffitypes目录中。然后，从该目录：

$ stack init
$ stack build
$ stack exec example1

应该可以运行示例。

封送参数化递归类型

现在，让我们谈谈更复杂的MyType。我已将更改Int为，Int32因此它将与CInt典型平台上的匹配。

data MyType a =
        TypeDouble Double
      | TypeInt Int32
      | TypeVar a 
      | TypeAdd (MyType a) (MyType a)

这是一个具有一元和二进制构造函数，任意类型参数a和递归结构的求和类型，因此非常复杂。同样，从指定具体的C实现开始也很重要。AC联合可以用于存储复杂的sum类型，但是我们也想用枚举“标记”联合以指示联合所代表的构造函数，因此C类型看起来像这样：

typedef struct mytype_s {
        enum mytype_cons_e {
                TYPEDOUBLE,
                TYPEINT,
                TYPEVAR,
                TYPEADD
        } mytype_cons;
        union {
                double type_double;
                int type_int;
                void* type_var;
                struct {
                        struct mytype_s *left;
                        struct mytype_s *right;
                } type_add;
        } mytype_value;
} mytype;

需要注意的是，为了让C绑定工作与MyType as的多个可能的参数a，我们需要使用void*的type_var工会成员。

MyType完全手动编写编组功能非常痛苦且容易出错。您需要弄清很多有关C结构的确切大小，对齐方式和布局的细节。相反，我们将使用c2hs帮助程序包。我们将从新内容顶部的一些序言开始MyLib2.chs：

-- file: MyLib2.chs
module MyLib2 where

import Foreign
import Foreign.C

#include "mylib.h"

该c2hs软件包非常适合使用枚举。例如，enum mytype_cons_e使用此程序包为标签创建编组基础结构如下所示：

-- file: MyLib2.chs
{#enum mytype_cons_e as MyTypeCons {}#}

请注意，这会自动从C标头检索定义mylib.h，并创建等效于以下内容的Haskell定义：

-- data MyTypeCons = TYPEDOUBLE | TYPEINT | etc.

并定义所需的Enum实例，以将Haskell构造函数与C侧的整数值进行映射。在这里将我们的概括toEnum和fromEnum帮助者也将很有用：

genToEnum :: (Integral a, Enum b) => a -> b
genToEnum = toEnum . fromIntegral

genFromEnum :: (Integral a, Enum b) => b -> a
genFromEnum = fromIntegral . fromEnum

现在，让我们看一下如何整理数据类型：

data MyType a =
  TypeDouble Double
  | TypeInt Int32
  | TypeVar a 
  | TypeAdd (MyType a) (MyType a)

往返struct mytype_s。一个警告：这些实现假定递归构造函数TypeAdd及其C类类似物type_add从未在C或Haskell端用于创建“循环”。在递归的意义上处理递归的数据结构let x = 0:x将需要不同的方法。

因为struct mytype_s是固定长度的结构，所以您可能会认为它是Storable实例的理想选择，但事实并非如此。由于type_varunion成员中有嵌入式指针，而该成员中有递归指针type_add，因此无法为编写合理的Storable实例MyType。我们可以这样写：

data C_MyType a =
  C_TypeDouble Double
  | C_TypeInt Int32
  | C_TypeVar (Ptr a)
  | C_TypeAdd (Ptr (MyType a)) (Ptr (MyType a))

指针已经明确的地方。当我们将其编组时，我们将假定已经编组了“子”节点，并具有指向它们的指针，可以将它们编组到结构中。对于C_TypeAdd构造函数，我可以这样写：

  -- C_TypeAdd (Ptr (C_MyType a)) (Ptr (C_MyType a))

没关系，因为我们将Ptr在MyTypes和C_MyTypes 之间自由地来回转换s。我决定使用我的定义，因为它消除了两个castPtr调用。

的Storable实例C_MyType如下所示。请注意如何c2hs使我们能够自动查找尺寸，对齐方式和偏移量。否则，我们必须手动计算所有这些。

instance Storable (C_MyType a) where
  sizeOf _ = {#sizeof mytype_s#}
  alignment _ = {#alignof mytype_s#}
  peek p = do
    typ <- genToEnum <$> {#get struct mytype_s->mytype_cons#} p
    case typ of
      TYPEDOUBLE ->
        C_TypeDouble . (\(CDouble x) -> x)
        <$> {#get struct mytype_s->mytype_value.type_double#} p
      TYPEINT    ->
        C_TypeInt    . (\(CInt    x) -> x)
        <$> {#get struct mytype_s->mytype_value.type_int   #} p
      TYPEVAR    ->
        C_TypeVar . castPtr <$> {#get struct mytype_s->mytype_value.type_var#} p
      TYPEADD    -> do
        q1 <- {#get struct mytype_s->mytype_value.type_add.left#} p
        q2 <- {#get struct mytype_s->mytype_value.type_add.right#} p
        return $ C_TypeAdd (castPtr q1) (castPtr q2)
  poke p t = case t of
    C_TypeDouble x -> do
      tag TYPEDOUBLE
      {#set struct mytype_s->mytype_value.type_double#} p (CDouble x)
    C_TypeInt x    -> do
      tag TYPEINT
      {#set struct mytype_s->mytype_value.type_int   #} p (CInt    x)
    C_TypeVar q    -> do
      tag TYPEVAR
      {#set struct mytype_s->mytype_value.type_var   #} p (castPtr q)
    C_TypeAdd q1 q2 -> do
      tag TYPEADD
      {#set struct mytype_s->mytype_value.type_add.left #} p (castPtr q1)
      {#set struct mytype_s->mytype_value.type_add.right#} p (castPtr q2)

    where
      tag = {#set struct mytype_s->mytype_cons#} p . genFromEnum

随着Storable实例C_MyType的方式进行，对于编组功能，真正 MyType看还算干净：

peekMyType :: (Ptr a -> IO a) -> Ptr (MyType a) -> IO (MyType a)
peekMyType peekA p = do
  ct <- peek (castPtr p)
  case ct of
    C_TypeDouble x -> return $ TypeDouble x
    C_TypeInt    x -> return $ TypeInt    x
    C_TypeVar    q -> TypeVar <$> peekA q
    C_TypeAdd q1 q2 -> do
      t1 <- peekMyType peekA q1
      t2 <- peekMyType peekA q2
      return $ TypeAdd t1 t2

newMyType :: (a -> IO (Ptr a)) -> MyType a -> IO (Ptr (MyType a))
newMyType newA t = do
  p <- malloc
  case t of
    TypeDouble x  -> poke p (C_TypeDouble x)
    TypeInt    x  -> poke p (C_TypeInt    x)
    TypeVar    v  -> poke p . C_TypeVar =<< newA v
    TypeAdd t1 t2 -> do
      q1 <- newMyType newA t1
      q2 <- newMyType newA t2
      poke p (C_TypeAdd q1 q2)
  return (castPtr p)  -- case from Ptr C_MyType to Ptr MyType

freeMyType :: (Ptr a -> IO ()) -> Ptr (MyType a) -> IO ()
freeMyType freeA p = do
  ct <- peek (castPtr p)
  case ct of
    C_TypeVar q -> freeA q
    C_TypeAdd q1 q2 -> do
      freeMyType freeA q1
      freeMyType freeA q2
    _ -> return ()  -- no children to free
  free p

请注意我们需要如何为该a类型使用辅助函数。每当我们想做出newMyType的MyType a，我们需要提供量身定制newA的a类型。可以将其设置为类型类，甚至可以为所有实例创建一个实例Storable a，但是我在这里没有做到这一点。

现在，假设我们有一个Haskell函数，该函数使用我们要导出到C的所有这些数据类型：

replaceSymbols :: OrdSymb -> Symbol -> Symbol -> MyType Symbol -> MyType Symbol
replaceSymbols ord sym1 sym2 = go
  where
    go (TypeVar s) | checkSymb s ord sym1 = TypeVar sym2
    go (TypeAdd t1 t2) = TypeAdd (go t1) (go t2)
    go rest = rest

使用先前定义的帮助程序功能：

compareSymb :: Symbol -> Symbol -> OrdSymb
compareSymb (Symbol x) (Symbol y) =
  case compare x y of { EQ -> SEQ; LT -> SLT; GT -> SGT }

checkSymb :: Symbol -> OrdSymb -> Symbol -> Bool
checkSymb x ord y = compareSymb x y == ord

在中，我们还需要其他一些内容MyLib2.chs。首先，我们将使用c2hs定义OrdSymb类型（同样，它会自动生成相关的data OrdSymb）：

{#enum ord_symb as OrdSymb {} deriving (Show, Eq)#}
type C_OrdSymb = CInt

以及从中复制的符号编组代码MyLib1.hs：

newtype Symbol = Symbol String

peekSymbol :: Ptr Symbol -> IO Symbol
peekSymbol ptr = Symbol <$> peekCString (castPtr ptr)

newSymbol :: Symbol -> IO (Ptr Symbol)
newSymbol (Symbol str) = castPtr <$> newCString str

freeSymbol :: Ptr Symbol -> IO ()
freeSymbol = free

然后，我们可以编写以下C包装器：

mylib_replace_symbols :: C_OrdSymb -> Ptr Symbol -> Ptr Symbol
    -> Ptr (MyType Symbol) -> IO (Ptr (MyType Symbol))
mylib_replace_symbols ord psym1 psym2 pt = do
  sym1 <- peekSymbol psym1
  sym2 <- peekSymbol psym2
  t <- peekMyType peekSymbol pt
  let t' = replaceSymbols (genToEnum ord) sym1 sym2 t
  newMyType newSymbol t'

鉴于此操作返回了已分配的数据结构，因此还提供导出函数以释放它是有帮助的：

mylib_free_mytype_symbol :: Ptr (MyType Symbol) -> IO ()
mylib_free_mytype_symbol = freeMyType freeSymbol

然后导出它们：

foreign export ccall mylib_replace_symbols
  :: C_OrdSymb -> Ptr Symbol -> Ptr Symbol
       -> Ptr (MyType Symbol) -> IO (Ptr (MyType Symbol))
foreign export ccall mylib_free_mytype_symbol
  :: Ptr (MyType Symbol) -> IO ()

如果您采用本节中的所有Haskell代码，请从该module MyLib2行开始并将其放入中MyLib2.chs，然后创建/修改以下文件：

// file: mylib.h
#ifndef MYLIB_H
#define MYLIB_H

enum ord_symb {
    SLT = -1,
    SEQ = 0,
    SGT = 1
};
typedef char* symbol;   // NUL-terminated string

typedef struct mytype_s {
    enum mytype_cons_e {
        TYPEDOUBLE,
        TYPEINT,
        TYPEVAR,
        TYPEADD
    } mytype_cons;
    union {
        double type_double;
        int type_int;
        void* type_var;
        struct {
            struct mytype_s *left;
            struct mytype_s *right;
        } type_add;
    } mytype_value;
} mytype;

#endif

和：

// file: example2.c
#include <HsFFI.h>
#include "MyLib2_stub.h"
#include <stdio.h>

#include "mylib.h"

// AST for:   1.0 + foo
mytype node1 = { TYPEDOUBLE, {type_double: 1.0} };
mytype node2 = { TYPEVAR,    {type_var: "foo"} };
mytype root  = { TYPEADD,    {type_add: {&node1, &node2} } };

int main(int argc, char *argv[])
{
    hs_init(&argc, &argv);

    mytype *p1 = mylib_replace_symbols(SEQ, "foo", "bar", &root);
    printf("%s\n",  // should print "bar"
       (char*) p1->mytype_value.type_add.right->mytype_value.type_var);
    mytype *p2 = mylib_replace_symbols(SEQ, "quux", "bar", &root);
    printf("%s\n",  // unchanged -- should still be "foo"
       (char*) p2->mytype_value.type_add.right->mytype_value.type_var);

    mylib_free_mytype_symbol(p1);
    mylib_free_mytype_symbol(p2);

    hs_exit();
    return 0;
}

并将executable example2子句添加到Cabal文件中：

-- file: ffitypes.cabal
name:                 ffitypes
version:              0.1.0.0
cabal-version:        >= 1.22
build-type:           Simple

executable example1
  main-is:            example1.c
  other-modules:      MyLib1
  include-dirs:       .
  includes:           mylib.h
  build-depends:      base
  default-language:   Haskell2010
  cc-options:         -Wall -O
  ghc-options:        -Wall -Wno-incomplete-patterns -O

executable example2
  main-is:            example2.c
  other-modules:      MyLib2
  include-dirs:       .
  includes:           mylib.h
  build-depends:      base
  build-tools:        c2hs
  default-language:   Haskell2010
  cc-options:         -Wall -O
  ghc-options:        -Wall -Wno-incomplete-patterns -O

并将它们全部粘贴到ffitypes目录中，那么您应该能够stack build和stack exec example2。

语言绑定很难！

从上面的代码中可以看出，为Haskell库创建甚至简单的C绑定也需要大量的工作。如果可以的话，为C库创建Haskell绑定只会稍微容易一些。祝你好运！