c - Guile 程序错误 "procedure->pointer": Wrong Type Argument in Position 1

Question

因此 Guile 过程“procedure->pointer”采用返回类型、Scheme 函数和参数类型列表，并返回 C 函数指针。

过程->指针:(返回类型、Scheme 函数、参数类型列表)-> C 函数指针

我的问题是，如果我在 C 中定义自定义类型“foo”(通过 typedef 或结构定义)，我如何在 Guile 中注册它以便我可以使用“foo”作为返回类型或参数输入过程->指针？我会向 procedure->pointer 传递一个名为“foo”的符号还是一个名为“foo”的 Scheme 变量？

编辑:我想这样调用:

foo (*c_foo_func)(foo) = scm_procedure_to_pointer(foo, scm_foo_func, scm_list_1(foo));

Answer 1

C typedef 声明

在 C 中，typedef 声明创建同义词，而不是新类型。抬头 发现真实类型的声明。例如，签名 H5Fclose 是

herr_t H5Fclose(hid_t file_id);

类型herr_t 和hid_t 在HDF5 头文件中声明为

typedef int herr_t;
typedef int hid_t;

因此，要创建一个包装 H5Fclose 的 Scheme 过程，请使用

(pointer->procedure int (dynamic-func "H5Fclose" ...) (list int))

或者，可以在 Scheme 中定义相同的同义词:

(define herr_t int)
(define hid_t int)

然后就可以写了

(pointer->procedure herr_t (dynamic-func "H5Fclose" ...) (list hid_t))

通过指针传递结构

在 C 语言中，结构通常通过指针传递给函数或从函数中传递出来。为了 例如，回调的签名传递给 H5Literate 是

herr_t op(hid_t group, const char *name, const H5L_info_t *info, void *op_data);

H5L_info_t 是一种通过指针传递的结构类型。

回调的参数类型在Scheme中的表示是

(list int '* '* '*)

函数 make-c-struct 和 parse-c-struct ( reference ) 创建和读取结构指针。他们需要知道的布局 struct，以列表的形式给出，其中包含结构成员的类型。

按值传递结构

Guile 也支持按值传递结构，尽管它不是 记录在案。函数 pointer->procedure 和 过程->指针 ( reference ) 采用返回和参数类型。表示传递的结构 按值，使用包含结构成员类型的列表。

Scheme 中结构值的操作仍然使用 make-c-struct 和 parse-c-struct(结构值是 自动转换为指针并返回)。

例子

以下示例演示如何将 Scheme 过程传递给 C 函数 H5Literate。它是“迭代”的翻译 Groups w/H5Literate” 来自 HDF5 C Examples。

示例数据文件 h5ex_g_iterate.h5 需要在工作目录中。

需要大量代码来复制类型和常量 HDF5 header ，但实际程序很短(在 非常结束)。

(use-modules
 (system foreign)
 (rnrs bytevectors))

(define libhdf5 (dynamic-link "libhdf5"))

;; HDF5 typedefs

;; typedef int herr_t;
(define herr_t int)
;; typedef int hid_t;
(define hid_t int)

;; typedef enum H5_index_t {
;;     H5_INDEX_UNKNOWN = -1,      /* Unknown index type                   */
;;     H5_INDEX_NAME,              /* Index on names                       */
;;     H5_INDEX_CRT_ORDER,         /* Index on creation order              */
;;     H5_INDEX_N                  /* Number of indices defined            */
;; } H5_index_t;
(define H5_index_t int)
(define H5_INDEX_NAME 0)

;; typedef enum {
;;     H5_ITER_UNKNOWN = -1,       /* Unknown order */
;;     H5_ITER_INC,                /* Increasing order */
;;     H5_ITER_DEC,                /* Decreasing order */
;;     H5_ITER_NATIVE,             /* No particular order, whatever is fastest */
;;     H5_ITER_N                   /* Number of iteration orders */
;; } H5_iter_order_t;
(define H5_iter_order_t int)
(define H5_ITER_NATIVE 2)

;; typedef herr_t (*H5L_iterate_t)(hid_t group, const char *name, const H5L_info_t *info,
;;     void *op_data);
(define H5L_iterate_t '*)

;; typedef uint64_t haddr_t;
(define haddr_t uint64)

;; typedef enum H5O_type_t {
;;     H5O_TYPE_UNKNOWN = -1,      /* Unknown object type          */
;;     H5O_TYPE_GROUP,             /* Object is a group            */
;;     H5O_TYPE_DATASET,           /* Object is a dataset          */
;;     H5O_TYPE_NAMED_DATATYPE,    /* Object is a named data type  */
;;     H5O_TYPE_NTYPES             /* Number of different object types (must be last!) */
;; } H5O_type_t;
(define H5O_type_t int)
(define H5O_TYPE_GROUP 0)
(define H5O_TYPE_DATASET 1)
(define H5O_TYPE_NAMED_DATATYPE 2)

;; time_t is long on POSIX systems
(define time_t long)

;; typedef unsigned long long      hsize_t;
;; (system foreign) doesn't have long long, use uint64 and cross our fingers
(define hsize_t uint64)

;; typedef struct H5O_hdr_info_t {
;;     unsigned version;           /* Version number of header format in file */
;;     unsigned nmesgs;            /* Number of object header messages */
;;     unsigned nchunks;           /* Number of object header chunks */
;;     unsigned flags;             /* Object header status flags */
;;     struct {
;;         hsize_t total;          /* Total space for storing object header in file */
;;         hsize_t meta;           /* Space within header for object header metadata information */
;;         hsize_t mesg;           /* Space within header for actual message information */
;;         hsize_t free;           /* Free space within object header */
;;     } space;
;;     struct {
;;         uint64_t present;       /* Flags to indicate presence of message type in header */
;;         uint64_t shared;        /* Flags to indicate message type is shared in header */
;;     } mesg;
;; } H5O_hdr_info_t;
(define H5O_hdr_info_t
  (list
   unsigned-int
   unsigned-int
   unsigned-int
   unsigned-int
   (list
    hsize_t
    hsize_t
    hsize_t
    hsize_t)
   (list
    uint64
    uint64)))

;; typedef struct H5_ih_info_t {
;;     hsize_t     index_size;     /* btree and/or list */
;;     hsize_t     heap_size;
;; } H5_ih_info_t;
(define H5_ih_info_t
  (list
   hsize_t
   hsize_t))

;; typedef struct H5O_info_t {
;;     unsigned long       fileno;         /* File number that object is located in */
;;     haddr_t             addr;           /* Object address in file       */
;;     H5O_type_t          type;           /* Basic object type (group, dataset, etc.) */
;;     unsigned            rc;             /* Reference count of object    */
;;     time_t              atime;          /* Access time                  */
;;     time_t              mtime;          /* Modification time            */
;;     time_t              ctime;          /* Change time                  */
;;     time_t              btime;          /* Birth time                   */
;;     hsize_t             num_attrs;      /* # of attributes attached to object */
;;     H5O_hdr_info_t      hdr;            /* Object header information */
;;     /* Extra metadata storage for obj & attributes */
;;     struct {
;;         H5_ih_info_t   obj;             /* v1/v2 B-tree & local/fractal heap for groups, B-tree for chunked datasets */
;;         H5_ih_info_t   attr;            /* v2 B-tree & heap for attributes */
;;     } meta_size;
;; } H5O_info_t;
(define H5O_info_t
  (list
   unsigned-long
   haddr_t
   H5O_type_t
   unsigned-int
   time_t
   time_t
   time_t
   time_t
   hsize_t
   H5O_hdr_info_t
   (list
    H5_ih_info_t
    H5_ih_info_t)))
(define (make-H5O_info_t)
  "Returns a pointer to a zero-initialized H50_info_t struct."
  (bytevector->pointer (make-bytevector (sizeof H5O_info_t) 0)))
(define (parse-H5O_info_t foreign)
  (parse-c-struct foreign H5O_info_t))
(define (H5O_info_t-type vals)
  (list-ref vals 2))

;; HDF5 constants

;; #define H5F_ACC_RDONLY  (H5CHECK 0x0000u)
(define H5F_ACC_RDONLY 0)

;; #define H5P_DEFAULT     (hid_t)0
(define H5P_DEFAULT 0)

;; HDF5 functions

;; hid_t
;; H5Fopen(const char *filename, unsigned flags, hid_t fapl_id);
(define H5Fopen
  (pointer->procedure
   hid_t
   (dynamic-func "H5Fopen" libhdf5)
   (list '* unsigned-int hid_t)))

;; herr_t
;; H5Literate(hid_t grp_id, H5_index_t idx_type, H5_iter_order_t order,
;;     hsize_t *idx_p, H5L_iterate_t op, void *op_data);
(define H5Literate
  (pointer->procedure
   herr_t
   (dynamic-func "H5Literate" libhdf5)
   (list hid_t H5_index_t H5_iter_order_t '* H5L_iterate_t '*)))

;; herr_t
;; H5Fclose(hid_t file_id);
(define H5Fclose
  (pointer->procedure
   herr_t
   (dynamic-func "H5Fclose" libhdf5)
   (list hid_t)))

;; herr_t
;; H5Oget_info_by_name(hid_t loc_id, const char *name, H5O_info_t *oinfo, hid_t lapl_id);
(define H5Oget_info_by_name
  (pointer->procedure
   herr_t
   (dynamic-func "H5Oget_info_by_name" libhdf5)
   (list hid_t '* '* hid_t)))

(define FILE "h5ex_g_iterate.h5")

(define (main)
  (let ((status 0)
        (file (H5Fopen (string->pointer FILE) H5F_ACC_RDONLY H5P_DEFAULT)))
    (display "Objects in root group:\n")
    (set! status (H5Literate file H5_INDEX_NAME H5_ITER_NATIVE %null-pointer
                             op_func_ptr %null-pointer))
    (set! status (H5Fclose file))
    0))

;; Operator function. Prints the name and type of the object
;; being examined.
;;
;; C signature:
;; herr_t op_func (hid_t loc_id, const char *name, const H5L_info_t *info,
;;             void *operator_data)
(define (op_func loc_id name info operator_data)
  (let ((status 0)
        (name-str (pointer->string name))
        (infobuf (make-H5O_info_t)))
    (set! status (H5Oget_info_by_name loc_id name infobuf H5P_DEFAULT))
    (let ((type (H5O_info_t-type (parse-H5O_info_t infobuf))))
      (cond
       ((= type H5O_TYPE_GROUP)
        (format #t "  Group: ~a\n" name-str))
       ((= type H5O_TYPE_DATASET)
        (format #t "  Dataset: ~a\n" name-str))
       ((= type H5O_TYPE_NAMED_DATATYPE)
        (format #t "  Datatype: ~a\n" name-str))
       (else
        (format #t "  Unknown: ~a\n" name-str))))
    0))

(define op_func_ptr (procedure->pointer herr_t op_func (list hid_t '* '* '*)))

(main)