unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
From: Matt Wette <matt.wette@gmail.com>
To: Roel Janssen <roel@gnu.org>
Cc: Guile User <guile-user@gnu.org>, guile-devel <guile-devel@gnu.org>
Subject: Re: ffi-help: status to 19 Aug 2017
Date: Thu, 9 Nov 2017 18:34:57 -0800	[thread overview]
Message-ID: <4505B7FB-D7A8-448C-B6E8-CD035C237DC9@gmail.com> (raw)
In-Reply-To: <0B1CB7F6-A400-487D-BBCA-BE08E75033CA@gmail.com>

[-- Attachment #1: Type: text/plain, Size: 804 bytes --]


> On Nov 9, 2017, at 5:00 PM, Matt Wette <matt.wette@gmail.com> wrote:
> 
>> On Nov 9, 2017, at 11:10 AM, Roel Janssen <roel@gnu.org> wrote:
>>> ...
>> 
>> Thanks for creating this!  It seems to be very useful and powerful.
>> 
>> I wanted to try ffi-helper on htslib, but I am confused on how to get
>> started.  Where does the "compile-ffi" subcommand for "guild" come from?
>> 
>> Kind regards,
>> Roel Janssen
> 
> See the following, but I'm seeing a parse error so may be a bug in my C99 parser.  And not sure "hts.h" is the only include you need.

I got it to compile-ffi.  Still a few warnings I need to chase down.  
I made a couple fixes (and added examples/ffi/htslib.ffi) and pushed to my repo on savannah.

Also, htslib.scm is attached.  It is 1700 lines only.

Matt


[-- Attachment #2: htslib.scm --]
[-- Type: application/octet-stream, Size: 50509 bytes --]

;; generated with `guild compile-ffi ffi/htslib.ffi'

(define-module (ffi htslib)
  #:use-module (system ffi-help-rt)
  #:use-module ((system foreign) #:prefix ffi:)
  #:use-module (bytestructures guile)
  )
(define link-lib (dynamic-link "libhts"))

;; enum htsLogLevel {
;;   HTS_LOG_OFF,
;;   HTS_LOG_ERROR,
;;   HTS_LOG_WARNING = 3,
;;   HTS_LOG_INFO,
;;   HTS_LOG_DEBUG,
;;   HTS_LOG_TRACE,
;; };
(define enum-htsLogLevel-enum-nvl
  '((HTS_LOG_OFF . 0)
    (HTS_LOG_ERROR . 1)
    (HTS_LOG_WARNING . 3)
    (HTS_LOG_INFO . 4)
    (HTS_LOG_DEBUG . 5)
    (HTS_LOG_TRACE . 6))
  )
(define enum-htsLogLevel-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-htsLogLevel-enum-nvl))
(define-public (unwrap-enum-htsLogLevel n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-htsLogLevel-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-htsLogLevel v)
  (assq-ref enum-htsLogLevel-enum-vnl v))

;; void hts_set_log_level(enum htsLogLevel level);
(define ~hts_set_log_level
  (delay (fh-link-proc
           "hts_set_log_level"
           ffi:void
           (list ffi:int)
           link-lib)))
(define (hts_set_log_level level)
  (let ((~level (unwrap-enum level)))
    ((force ~hts_set_log_level) ~level)))
(export hts_set_log_level)

;; enum htsLogLevel hts_get_log_level();
(define ~hts_get_log_level
  (delay (fh-link-proc
           "hts_get_log_level"
           ffi:int
           (list)
           link-lib)))
(define (hts_get_log_level)
  (let () (wrap-enum ((force ~hts_get_log_level)))))
(export hts_get_log_level)

;; extern int hts_verbose;
(define hts_verbose
  (let* ((addr #f)
         (memoize-addr
           (lambda ()
             (unless
               addr
               (set! addr
                 (make-bytestructure
                   (ffi:pointer->bytevector
                     (dynamic-pointer "hts_verbose" (dynamic-link))
                     (ffi:sizeof '*))
                   0
                   (bs:pointer int)))))))
    (case-lambda
      (() (memoize-addr) (bytestructure-ref addr '*)))))
(export hts_verbose)

;; void hts_log(enum htsLogLevel severity, const char *context, const char *
;;     format, ...);
;; ... failed.

;; typedef struct BGZF BGZF;
(define-public BGZF-desc 'void)
(define-public BGZF*-desc (bs:pointer BGZF-desc))
(define-fh-pointer-type BGZF* BGZF*-desc BGZF*? make-BGZF*)
(export BGZF* BGZF*? make-BGZF*)

;; typedef struct __kstring_t {
;;   size_t l, m;
;;   char *s;
;; } kstring_t;
;; == kstring_t =>
(define-public kstring_t-desc
  (bs:struct
    (list `(m ,size_t)
          `(l ,size_t)
          `(s ,(bs:pointer int8)))))
(define-fh-compound-type kstring_t kstring_t-desc kstring_t? make-kstring_t)
(export kstring_t kstring_t? make-kstring_t)
(define-public kstring_t*-desc
  (bs:pointer kstring_t-desc))
(define-fh-pointer-type kstring_t* kstring_t*-desc kstring_t*? make-kstring_t*
 )
(export kstring_t* kstring_t*? make-kstring_t*)
(ref<->deref!
  kstring_t*
  make-kstring_t*
  kstring_t
  make-kstring_t)
;; == struct-__kstring_t =>
(define-public struct-__kstring_t-desc
  kstring_t-desc)
(define-fh-compound-type struct-__kstring_t struct-__kstring_t-desc 
 struct-__kstring_t? make-struct-__kstring_t)
(export struct-__kstring_t struct-__kstring_t? make-struct-__kstring_t)
(define-public struct-__kstring_t*-desc
  kstring_t*-desc)
(define-fh-pointer-type struct-__kstring_t* struct-__kstring_t*-desc 
 struct-__kstring_t*? make-struct-__kstring_t*)
(export struct-__kstring_t* struct-__kstring_t*? make-struct-__kstring_t*)
(ref<->deref!
  struct-__kstring_t*
  make-struct-__kstring_t*
  struct-__kstring_t
  make-struct-__kstring_t)

;; enum htsFormatCategory {
;;   unknown_category,
;;   sequence_data,
;;   variant_data,
;;   index_file,
;;   region_list,
;;   category_maximum = 32767,
;; };
(define enum-htsFormatCategory-enum-nvl
  '((unknown_category . 0)
    (sequence_data . 1)
    (variant_data . 2)
    (index_file . 3)
    (region_list . 4)
    (category_maximum . 32767))
  )
(define enum-htsFormatCategory-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-htsFormatCategory-enum-nvl))
(define-public (unwrap-enum-htsFormatCategory n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-htsFormatCategory-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-htsFormatCategory v)
  (assq-ref enum-htsFormatCategory-enum-vnl v))

;; enum htsExactFormat {
;;   unknown_format,
;;   binary_format,
;;   text_format,
;;   sam,
;;   bam,
;;   bai,
;;   cram,
;;   crai,
;;   vcf,
;;   bcf,
;;   csi,
;;   gzi,
;;   tbi,
;;   bed,
;;   htsget,
;;   json = htsget,
;;   format_maximum = 32767,
;; };
(define enum-htsExactFormat-enum-nvl
  '((unknown_format . 0)
    (binary_format . 1)
    (text_format . 2)
    (sam . 3)
    (bam . 4)
    (bai . 5)
    (cram . 6)
    (crai . 7)
    (vcf . 8)
    (bcf . 9)
    (csi . 10)
    (gzi . 11)
    (tbi . 12)
    (bed . 13)
    (htsget . 14)
    (json . 14)
    (format_maximum . 32767))
  )
(define enum-htsExactFormat-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-htsExactFormat-enum-nvl))
(define-public (unwrap-enum-htsExactFormat n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-htsExactFormat-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-htsExactFormat v)
  (assq-ref enum-htsExactFormat-enum-vnl v))

;; enum htsCompression {
;;   no_compression,
;;   gzip,
;;   bgzf,
;;   custom,
;;   compression_maximum = 32767,
;; };
(define enum-htsCompression-enum-nvl
  '((no_compression . 0)
    (gzip . 1)
    (bgzf . 2)
    (custom . 3)
    (compression_maximum . 32767))
  )
(define enum-htsCompression-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-htsCompression-enum-nvl))
(define-public (unwrap-enum-htsCompression n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-htsCompression-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-htsCompression v)
  (assq-ref enum-htsCompression-enum-vnl v))

;; typedef struct htsFormat {
;;   enum htsFormatCategory category;
;;   enum htsExactFormat format;
;;   struct {
;;     short major, minor;
;;   } version;
;;   enum htsCompression compression;
;;   short compression_level; /* currently unused*/
;;   void *specific; /* format specific options; see struct hts_opt.*/
;; } htsFormat;
;; == htsFormat =>
(define-public htsFormat-desc
  (bs:struct
    (list `(category ,int)
          `(format ,int)
          `(version
             ,(bs:struct
                (list `(minor ,short) `(major ,short))))
          `(compression ,int)
          `(compression_level ,short)
          `(specific ,(bs:pointer 'void)))))
(define-fh-compound-type htsFormat htsFormat-desc htsFormat? make-htsFormat)
(export htsFormat htsFormat? make-htsFormat)
(define-public htsFormat*-desc
  (bs:pointer htsFormat-desc))
(define-fh-pointer-type htsFormat* htsFormat*-desc htsFormat*? make-htsFormat*
 )
(export htsFormat* htsFormat*? make-htsFormat*)
(ref<->deref!
  htsFormat*
  make-htsFormat*
  htsFormat
  make-htsFormat)
;; == struct-htsFormat =>
(define-public struct-htsFormat-desc
  htsFormat-desc)
(define-fh-compound-type struct-htsFormat struct-htsFormat-desc 
 struct-htsFormat? make-struct-htsFormat)
(export struct-htsFormat struct-htsFormat? make-struct-htsFormat)
(define-public struct-htsFormat*-desc
  htsFormat*-desc)
(define-fh-pointer-type struct-htsFormat* struct-htsFormat*-desc 
 struct-htsFormat*? make-struct-htsFormat*)
(export struct-htsFormat* struct-htsFormat*? make-struct-htsFormat*)
(ref<->deref!
  struct-htsFormat*
  make-struct-htsFormat*
  struct-htsFormat
  make-struct-htsFormat)

;; typedef struct {
;;   uint32_t is_bin : 1, is_write : 1, is_be : 1, is_cram : 1, is_bgzf : 1, 
;;       dummy : 27;
;;   int64_t lineno;
;;   kstring_t line;
;;   char *fn, *fn_aux;
;;   union {
;;     BGZF *bgzf;
;;     struct cram_fd *cram;
;;     struct hFILE *hfile;
;;   } fp;
;;   htsFormat format;
;; } htsFile;
(define-public htsFile-desc
  (bs:struct
    (list `(dummy ,uint64 27)
          `(is_bgzf ,uint64 1)
          `(is_cram ,uint64 1)
          `(is_be ,uint64 1)
          `(is_write ,uint64 1)
          `(is_bin ,uint64 1)
          `(lineno ,int32)
          `(line ,kstring_t-desc)
          `(fn_aux ,(bs:pointer int8))
          `(fn ,(bs:pointer int8))
          `(fp ,(bs:union
                  (list `(bgzf ,BGZF*-desc)
                        `(cram ,(bs:pointer 'void))
                        `(hfile ,(bs:pointer 'void)))))
          `(format ,htsFormat-desc))))
(define-fh-compound-type htsFile htsFile-desc htsFile? make-htsFile)
(export htsFile htsFile? make-htsFile)
(define-public htsFile*-desc
  (bs:pointer htsFile-desc))
(define-fh-pointer-type htsFile* htsFile*-desc htsFile*? make-htsFile*)
(export htsFile* htsFile*? make-htsFile*)
(ref<->deref!
  htsFile*
  make-htsFile*
  htsFile
  make-htsFile)

;; typedef struct {
;;   struct hts_tpool *pool; /* The shared thread pool itself*/
;;   int qsize; /* Size of I/O queue to use for this fp*/
;; } htsThreadPool;
(define-public htsThreadPool-desc
  (bs:struct
    (list `(pool ,(bs:pointer 'void)) `(qsize ,int))))
(define-fh-compound-type htsThreadPool htsThreadPool-desc htsThreadPool? 
 make-htsThreadPool)
(export htsThreadPool htsThreadPool? make-htsThreadPool)
(define-public htsThreadPool*-desc
  (bs:pointer htsThreadPool-desc))
(define-fh-pointer-type htsThreadPool* htsThreadPool*-desc htsThreadPool*? 
 make-htsThreadPool*)
(export htsThreadPool* htsThreadPool*? make-htsThreadPool*)
(ref<->deref!
  htsThreadPool*
  make-htsThreadPool*
  htsThreadPool
  make-htsThreadPool)

;; enum sam_fields {
;;   SAM_QNAME = 0x00000001,
;;   SAM_FLAG = 0x00000002,
;;   SAM_RNAME = 0x00000004,
;;   SAM_POS = 0x00000008,
;;   SAM_MAPQ = 0x00000010,
;;   SAM_CIGAR = 0x00000020,
;;   SAM_RNEXT = 0x00000040,
;;   SAM_PNEXT = 0x00000080,
;;   SAM_TLEN = 0x00000100,
;;   SAM_SEQ = 0x00000200,
;;   SAM_QUAL = 0x00000400,
;;   SAM_AUX = 0x00000800,
;;   SAM_RGAUX = 0x00001000,
;; };
(define enum-sam_fields-enum-nvl
  '((SAM_QNAME . 1)
    (SAM_FLAG . 2)
    (SAM_RNAME . 4)
    (SAM_POS . 8)
    (SAM_MAPQ . 16)
    (SAM_CIGAR . 32)
    (SAM_RNEXT . 64)
    (SAM_PNEXT . 128)
    (SAM_TLEN . 256)
    (SAM_SEQ . 512)
    (SAM_QUAL . 1024)
    (SAM_AUX . 2048)
    (SAM_RGAUX . 4096))
  )
(define enum-sam_fields-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-sam_fields-enum-nvl))
(define-public (unwrap-enum-sam_fields n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-sam_fields-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-sam_fields v)
  (assq-ref enum-sam_fields-enum-vnl v))

;; enum hts_fmt_option {
;;   CRAM_OPT_DECODE_MD,
;;   CRAM_OPT_PREFIX,
;;   CRAM_OPT_VERBOSITY,
;;   CRAM_OPT_SEQS_PER_SLICE,
;;   CRAM_OPT_SLICES_PER_CONTAINER,
;;   CRAM_OPT_RANGE,
;;   CRAM_OPT_VERSION,
;;   CRAM_OPT_EMBED_REF,
;;   CRAM_OPT_IGNORE_MD5,
;;   CRAM_OPT_REFERENCE,
;;   CRAM_OPT_MULTI_SEQ_PER_SLICE,
;;   CRAM_OPT_NO_REF,
;;   CRAM_OPT_USE_BZIP2,
;;   CRAM_OPT_SHARED_REF,
;;   CRAM_OPT_NTHREADS,
;;   CRAM_OPT_THREAD_POOL,
;;   CRAM_OPT_USE_LZMA,
;;   CRAM_OPT_USE_RANS,
;;   CRAM_OPT_REQUIRED_FIELDS,
;;   CRAM_OPT_LOSSY_NAMES,
;;   CRAM_OPT_BASES_PER_SLICE,
;;   HTS_OPT_COMPRESSION_LEVEL = 100,
;;   HTS_OPT_NTHREADS,
;;   HTS_OPT_THREAD_POOL,
;;   HTS_OPT_CACHE_SIZE,
;;   HTS_OPT_BLOCK_SIZE,
;; };
(define enum-hts_fmt_option-enum-nvl
  '((CRAM_OPT_DECODE_MD . 0)
    (CRAM_OPT_PREFIX . 1)
    (CRAM_OPT_VERBOSITY . 2)
    (CRAM_OPT_SEQS_PER_SLICE . 3)
    (CRAM_OPT_SLICES_PER_CONTAINER . 4)
    (CRAM_OPT_RANGE . 5)
    (CRAM_OPT_VERSION . 6)
    (CRAM_OPT_EMBED_REF . 7)
    (CRAM_OPT_IGNORE_MD5 . 8)
    (CRAM_OPT_REFERENCE . 9)
    (CRAM_OPT_MULTI_SEQ_PER_SLICE . 10)
    (CRAM_OPT_NO_REF . 11)
    (CRAM_OPT_USE_BZIP2 . 12)
    (CRAM_OPT_SHARED_REF . 13)
    (CRAM_OPT_NTHREADS . 14)
    (CRAM_OPT_THREAD_POOL . 15)
    (CRAM_OPT_USE_LZMA . 16)
    (CRAM_OPT_USE_RANS . 17)
    (CRAM_OPT_REQUIRED_FIELDS . 18)
    (CRAM_OPT_LOSSY_NAMES . 19)
    (CRAM_OPT_BASES_PER_SLICE . 20)
    (HTS_OPT_COMPRESSION_LEVEL . 100)
    (HTS_OPT_NTHREADS . 101)
    (HTS_OPT_THREAD_POOL . 102)
    (HTS_OPT_CACHE_SIZE . 103)
    (HTS_OPT_BLOCK_SIZE . 104))
  )
(define enum-hts_fmt_option-enum-vnl
  (map (lambda (pair) (cons (cdr pair) (car pair)))
       enum-hts_fmt_option-enum-nvl))
(define-public (unwrap-enum-hts_fmt_option n)
  (cond
   ((symbol? n)
    (or (assq-ref enum-hts_fmt_option-enum-nvl n) (error "bad arg")))
   ((integer? n) n)
   (else (error "bad arg"))))
(define-public (wrap-enum-hts_fmt_option v)
  (assq-ref enum-hts_fmt_option-enum-vnl v))

;; typedef struct hts_opt {
;;   char *arg; /* string form, strdup()ed*/
;;   enum hts_fmt_option opt; /* tokenised key*/
;;   union {
;;     int i;
;;     char *s;
;;   } val;
;;   struct hts_opt *next;
;; } hts_opt;
;; == hts_opt =>
(define-public hts_opt-desc
  (bs:struct
    (list `(arg ,(bs:pointer int8))
          `(opt ,int)
          `(val ,(bs:union
                   (list `(i ,int) `(s ,(bs:pointer int8)))))
          `(next ,(bs:pointer 'void)))))
(define-fh-compound-type hts_opt hts_opt-desc hts_opt? make-hts_opt)
(export hts_opt hts_opt? make-hts_opt)
(define-public hts_opt*-desc
  (bs:pointer hts_opt-desc))
(define-fh-pointer-type hts_opt* hts_opt*-desc hts_opt*? make-hts_opt*)
(export hts_opt* hts_opt*? make-hts_opt*)
(ref<->deref!
  hts_opt*
  make-hts_opt*
  hts_opt
  make-hts_opt)
;; == struct-hts_opt =>
(define-public struct-hts_opt-desc hts_opt-desc)
(define-fh-compound-type struct-hts_opt struct-hts_opt-desc struct-hts_opt? 
 make-struct-hts_opt)
(export struct-hts_opt struct-hts_opt? make-struct-hts_opt)
(define-public struct-hts_opt*-desc
  hts_opt*-desc)
(define-fh-pointer-type struct-hts_opt* struct-hts_opt*-desc struct-hts_opt*? 
 make-struct-hts_opt*)
(export struct-hts_opt* struct-hts_opt*? make-struct-hts_opt*)
(ref<->deref!
  struct-hts_opt*
  make-struct-hts_opt*
  struct-hts_opt
  make-struct-hts_opt)

;; int hts_opt_add(hts_opt **opts, const char *c_arg);
(define ~hts_opt_add
  (delay (fh-link-proc
           "hts_opt_add"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_opt_add opts c_arg)
  (let ((~opts (unwrap~pointer opts))
        (~c_arg (unwrap~pointer c_arg)))
    ((force ~hts_opt_add) ~opts ~c_arg)))
(export hts_opt_add)

;; int hts_opt_apply(htsFile *fp, hts_opt *opts);
(define ~hts_opt_apply
  (delay (fh-link-proc
           "hts_opt_apply"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_opt_apply fp opts)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~opts ((fht-unwrap hts_opt*) opts)))
    ((force ~hts_opt_apply) ~fp ~opts)))
(export hts_opt_apply)

;; void hts_opt_free(hts_opt *opts);
(define ~hts_opt_free
  (delay (fh-link-proc
           "hts_opt_free"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (hts_opt_free opts)
  (let ((~opts ((fht-unwrap hts_opt*) opts)))
    ((force ~hts_opt_free) ~opts)))
(export hts_opt_free)

;; int hts_parse_format(htsFormat *opt, const char *str);
(define ~hts_parse_format
  (delay (fh-link-proc
           "hts_parse_format"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_parse_format opt str)
  (let ((~opt ((fht-unwrap htsFormat*) opt))
        (~str (unwrap~pointer str)))
    ((force ~hts_parse_format) ~opt ~str)))
(export hts_parse_format)

;; int hts_parse_opt_list(htsFormat *opt, const char *str);
(define ~hts_parse_opt_list
  (delay (fh-link-proc
           "hts_parse_opt_list"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_parse_opt_list opt str)
  (let ((~opt ((fht-unwrap htsFormat*) opt))
        (~str (unwrap~pointer str)))
    ((force ~hts_parse_opt_list) ~opt ~str)))
(export hts_parse_opt_list)

;; extern const unsigned char seq_nt16_table[256];
(define seq_nt16_table
  (let* ((addr #f)
         (memoize-addr
           (lambda ()
             (unless
               addr
               (set! addr
                 (make-bytestructure
                   (ffi:pointer->bytevector
                     (dynamic-pointer "seq_nt16_table" (dynamic-link))
                     (ffi:sizeof '*))
                   0
                   (bs:pointer (bs:vector 256 uint8))))))))
    (case-lambda
      (() (memoize-addr) (bytestructure-ref addr '*)))))
(export seq_nt16_table)

;; extern const char seq_nt16_str[];
(define seq_nt16_str
  (let* ((addr #f)
         (memoize-addr
           (lambda ()
             (unless
               addr
               (set! addr
                 (make-bytestructure
                   (ffi:pointer->bytevector
                     (dynamic-pointer "seq_nt16_str" (dynamic-link))
                     (ffi:sizeof '*))
                   0
                   (bs:pointer (bs:pointer int8))))))))
    (case-lambda
      (() (memoize-addr) (bytestructure-ref addr '*)))))
(export seq_nt16_str)

;; extern const int seq_nt16_int[];
(define seq_nt16_int
  (let* ((addr #f)
         (memoize-addr
           (lambda ()
             (unless
               addr
               (set! addr
                 (make-bytestructure
                   (ffi:pointer->bytevector
                     (dynamic-pointer "seq_nt16_int" (dynamic-link))
                     (ffi:sizeof '*))
                   0
                   (bs:pointer (bs:pointer int))))))))
    (case-lambda
      (() (memoize-addr) (bytestructure-ref addr '*)))))
(export seq_nt16_int)

;; const char *hts_version(void);
(define ~hts_version
  (delay (fh-link-proc
           "hts_version"
           ffi-void*
           (list)
           link-lib)))
(define (hts_version)
  (let () ((force ~hts_version))))
(export hts_version)

;; int hts_detect_format(struct hFILE *fp, htsFormat *fmt);
(define ~hts_detect_format
  (delay (fh-link-proc
           "hts_detect_format"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_detect_format fp fmt)
  (let ((~fp (unwrap~pointer fp))
        (~fmt ((fht-unwrap htsFormat*) fmt)))
    ((force ~hts_detect_format) ~fp ~fmt)))
(export hts_detect_format)

;; char *hts_format_description(const htsFormat *format);
(define ~hts_format_description
  (delay (fh-link-proc
           "hts_format_description"
           ffi-void*
           (list ffi-void*)
           link-lib)))
(define (hts_format_description format)
  (let ((~format ((fht-unwrap htsFormat*) format)))
    ((force ~hts_format_description) ~format)))
(export hts_format_description)

;; htsFile *hts_open(const char *fn, const char *mode);
(define ~hts_open
  (delay (fh-link-proc
           "hts_open"
           ffi-void*
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_open fn mode)
  (let ((~fn (unwrap~pointer fn))
        (~mode (unwrap~pointer mode)))
    ((fht-wrap htsFile*)
     ((force ~hts_open) ~fn ~mode))))
(export hts_open)

;; htsFile *hts_open_format(const char *fn, const char *mode, const htsFormat *
;;     fmt);
(define ~hts_open_format
  (delay (fh-link-proc
           "hts_open_format"
           ffi-void*
           (list ffi-void* ffi-void* ffi-void*)
           link-lib)))
(define (hts_open_format fn mode fmt)
  (let ((~fn (unwrap~pointer fn))
        (~mode (unwrap~pointer mode))
        (~fmt ((fht-unwrap htsFormat*) fmt)))
    ((fht-wrap htsFile*)
     ((force ~hts_open_format) ~fn ~mode ~fmt))))
(export hts_open_format)

;; htsFile *hts_hopen(struct hFILE *fp, const char *fn, const char *mode);
(define ~hts_hopen
  (delay (fh-link-proc
           "hts_hopen"
           ffi-void*
           (list ffi-void* ffi-void* ffi-void*)
           link-lib)))
(define (hts_hopen fp fn mode)
  (let ((~fp (unwrap~pointer fp))
        (~fn (unwrap~pointer fn))
        (~mode (unwrap~pointer mode)))
    ((fht-wrap htsFile*)
     ((force ~hts_hopen) ~fp ~fn ~mode))))
(export hts_hopen)

;; int hts_close(htsFile *fp);
(define ~hts_close
  (delay (fh-link-proc
           "hts_close"
           ffi:int
           (list ffi-void*)
           link-lib)))
(define (hts_close fp)
  (let ((~fp ((fht-unwrap htsFile*) fp)))
    ((force ~hts_close) ~fp)))
(export hts_close)

;; const htsFormat *hts_get_format(htsFile *fp);
(define ~hts_get_format
  (delay (fh-link-proc
           "hts_get_format"
           ffi-void*
           (list ffi-void*)
           link-lib)))
(define (hts_get_format fp)
  (let ((~fp ((fht-unwrap htsFile*) fp)))
    ((fht-wrap htsFormat*)
     ((force ~hts_get_format) ~fp))))
(export hts_get_format)

;; const char *hts_format_file_extension(const htsFormat *format);
(define ~hts_format_file_extension
  (delay (fh-link-proc
           "hts_format_file_extension"
           ffi-void*
           (list ffi-void*)
           link-lib)))
(define (hts_format_file_extension format)
  (let ((~format ((fht-unwrap htsFormat*) format)))
    ((force ~hts_format_file_extension) ~format)))
(export hts_format_file_extension)

;; int hts_set_opt(htsFile *fp, enum hts_fmt_option opt, ...);
;; ... failed.

;; int hts_getline(htsFile *fp, int delimiter, kstring_t *str);
(define ~hts_getline
  (delay (fh-link-proc
           "hts_getline"
           ffi:int
           (list ffi-void* ffi:int ffi-void*)
           link-lib)))
(define (hts_getline fp delimiter str)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~delimiter (unwrap~fixed delimiter))
        (~str ((fht-unwrap kstring_t*) str)))
    ((force ~hts_getline) ~fp ~delimiter ~str)))
(export hts_getline)

;; char **hts_readlines(const char *fn, int *_n);
(define ~hts_readlines
  (delay (fh-link-proc
           "hts_readlines"
           ffi-void*
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_readlines fn _n)
  (let ((~fn (unwrap~pointer fn))
        (~_n (unwrap~pointer _n)))
    ((force ~hts_readlines) ~fn ~_n)))
(export hts_readlines)

;; char **hts_readlist(const char *fn, int is_file, int *_n);
(define ~hts_readlist
  (delay (fh-link-proc
           "hts_readlist"
           ffi-void*
           (list ffi-void* ffi:int ffi-void*)
           link-lib)))
(define (hts_readlist fn is_file _n)
  (let ((~fn (unwrap~pointer fn))
        (~is_file (unwrap~fixed is_file))
        (~_n (unwrap~pointer _n)))
    ((force ~hts_readlist) ~fn ~is_file ~_n)))
(export hts_readlist)

;; int hts_set_threads(htsFile *fp, int n);
(define ~hts_set_threads
  (delay (fh-link-proc
           "hts_set_threads"
           ffi:int
           (list ffi-void* ffi:int)
           link-lib)))
(define (hts_set_threads fp n)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~n (unwrap~fixed n)))
    ((force ~hts_set_threads) ~fp ~n)))
(export hts_set_threads)

;; int hts_set_thread_pool(htsFile *fp, htsThreadPool *p);
(define ~hts_set_thread_pool
  (delay (fh-link-proc
           "hts_set_thread_pool"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_set_thread_pool fp p)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~p ((fht-unwrap htsThreadPool*) p)))
    ((force ~hts_set_thread_pool) ~fp ~p)))
(export hts_set_thread_pool)

;; void hts_set_cache_size(htsFile *fp, int n);
(define ~hts_set_cache_size
  (delay (fh-link-proc
           "hts_set_cache_size"
           ffi:void
           (list ffi-void* ffi:int)
           link-lib)))
(define (hts_set_cache_size fp n)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~n (unwrap~fixed n)))
    ((force ~hts_set_cache_size) ~fp ~n)))
(export hts_set_cache_size)

;; int hts_set_fai_filename(htsFile *fp, const char *fn_aux);
(define ~hts_set_fai_filename
  (delay (fh-link-proc
           "hts_set_fai_filename"
           ffi:int
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_set_fai_filename fp fn_aux)
  (let ((~fp ((fht-unwrap htsFile*) fp))
        (~fn_aux (unwrap~pointer fn_aux)))
    ((force ~hts_set_fai_filename) ~fp ~fn_aux)))
(export hts_set_fai_filename)

;; int hts_check_EOF(htsFile *fp);
(define ~hts_check_EOF
  (delay (fh-link-proc
           "hts_check_EOF"
           ffi:int
           (list ffi-void*)
           link-lib)))
(define (hts_check_EOF fp)
  (let ((~fp ((fht-unwrap htsFile*) fp)))
    ((force ~hts_check_EOF) ~fp)))
(export hts_check_EOF)

;; typedef struct __hts_idx_t hts_idx_t;
(define-public hts_idx_t-desc 'void)
(define-public hts_idx_t*-desc (bs:pointer hts_idx_t-desc))
(define-fh-pointer-type hts_idx_t* hts_idx_t*-desc hts_idx_t*? make-hts_idx_t*
 )
(export hts_idx_t* hts_idx_t*? make-hts_idx_t*)

;; typedef struct {
;;   uint64_t u, v;
;; } hts_pair64_t;
(define-public hts_pair64_t-desc
  (bs:struct (list `(v ,uint64) `(u ,uint64))))
(define-fh-compound-type hts_pair64_t hts_pair64_t-desc hts_pair64_t? 
 make-hts_pair64_t)
(export hts_pair64_t hts_pair64_t? make-hts_pair64_t)
(define-public hts_pair64_t*-desc
  (bs:pointer hts_pair64_t-desc))
(define-fh-pointer-type hts_pair64_t* hts_pair64_t*-desc hts_pair64_t*? 
 make-hts_pair64_t*)
(export hts_pair64_t* hts_pair64_t*? make-hts_pair64_t*)
(ref<->deref!
  hts_pair64_t*
  make-hts_pair64_t*
  hts_pair64_t
  make-hts_pair64_t)

;; typedef int hts_readrec_func(BGZF *fp, void *data, void *r, int *tid, int *
;;     beg, int *end);
(define ~hts_readrec_func
  (delay (fh-link-proc
           "hts_readrec_func"
           ffi:int
           (list ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*)
           link-lib)))
(define (hts_readrec_func fp data r tid beg end)
  (let ((~fp ((fht-unwrap BGZF*) fp))
        (~data (unwrap~pointer data))
        (~r (unwrap~pointer r))
        (~tid (unwrap~pointer tid))
        (~beg (unwrap~pointer beg))
        (~end (unwrap~pointer end)))
    ((force ~hts_readrec_func)
     ~fp
     ~data
     ~r
     ~tid
     ~beg
     ~end)))
(export hts_readrec_func)

;; typedef struct {
;;   uint32_t read_rest : 1, finished : 1, is_cram : 1, dummy : 29;
;;   int tid, beg, end, n_off, i;
;;   int curr_tid, curr_beg, curr_end;
;;   uint64_t curr_off;
;;   hts_pair64_t *off;
;;   hts_readrec_func *readrec;
;;   struct {
;;     int n, m;
;;     int *a;
;;   } bins;
;; } hts_itr_t;
(define-public hts_itr_t-desc
  (bs:struct
    (list `(dummy ,uint64 29)
          `(is_cram ,uint64 1)
          `(finished ,uint64 1)
          `(read_rest ,uint64 1)
          `(i ,int)
          `(n_off ,int)
          `(end ,int)
          `(beg ,int)
          `(tid ,int)
          `(curr_end ,int)
          `(curr_beg ,int)
          `(curr_tid ,int)
          `(curr_off ,uint64)
          `(off ,hts_pair64_t*-desc)
          `(readrec ,(bs:pointer 'void))
          `(bins ,(bs:struct
                    (list `(m ,int) `(n ,int) `(a ,(bs:pointer int))))))))
(define-fh-compound-type hts_itr_t hts_itr_t-desc hts_itr_t? make-hts_itr_t)
(export hts_itr_t hts_itr_t? make-hts_itr_t)
(define-public hts_itr_t*-desc
  (bs:pointer hts_itr_t-desc))
(define-fh-pointer-type hts_itr_t* hts_itr_t*-desc hts_itr_t*? make-hts_itr_t*
 )
(export hts_itr_t* hts_itr_t*? make-hts_itr_t*)
(ref<->deref!
  hts_itr_t*
  make-hts_itr_t*
  hts_itr_t
  make-hts_itr_t)

;; hts_idx_t *hts_idx_init(int n, int fmt, uint64_t offset0, int min_shift, int
;;      n_lvls);
(define ~hts_idx_init
  (delay (fh-link-proc
           "hts_idx_init"
           ffi-void*
           (list ffi:int ffi:int ffi:uint64 ffi:int ffi:int)
           link-lib)))
(define (hts_idx_init n fmt offset0 min_shift n_lvls)
  (let ((~n (unwrap~fixed n))
        (~fmt (unwrap~fixed fmt))
        (~offset0 (unwrap~fixed offset0))
        (~min_shift (unwrap~fixed min_shift))
        (~n_lvls (unwrap~fixed n_lvls)))
    ((fht-wrap hts_idx_t*)
     ((force ~hts_idx_init)
      ~n
      ~fmt
      ~offset0
      ~min_shift
      ~n_lvls))))
(export hts_idx_init)

;; void hts_idx_destroy(hts_idx_t *idx);
(define ~hts_idx_destroy
  (delay (fh-link-proc
           "hts_idx_destroy"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (hts_idx_destroy idx)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx)))
    ((force ~hts_idx_destroy) ~idx)))
(export hts_idx_destroy)

;; int hts_idx_push(hts_idx_t *idx, int tid, int beg, int end, uint64_t offset
;;     , int is_mapped);
(define ~hts_idx_push
  (delay (fh-link-proc
           "hts_idx_push"
           ffi:int
           (list ffi-void*
                 ffi:int
                 ffi:int
                 ffi:int
                 ffi:uint64
                 ffi:int)
           link-lib)))
(define (hts_idx_push idx tid beg end offset is_mapped)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~tid (unwrap~fixed tid))
        (~beg (unwrap~fixed beg))
        (~end (unwrap~fixed end))
        (~offset (unwrap~fixed offset))
        (~is_mapped (unwrap~fixed is_mapped)))
    ((force ~hts_idx_push)
     ~idx
     ~tid
     ~beg
     ~end
     ~offset
     ~is_mapped)))
(export hts_idx_push)

;; void hts_idx_finish(hts_idx_t *idx, uint64_t final_offset);
(define ~hts_idx_finish
  (delay (fh-link-proc
           "hts_idx_finish"
           ffi:void
           (list ffi-void* ffi:uint64)
           link-lib)))
(define (hts_idx_finish idx final_offset)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~final_offset (unwrap~fixed final_offset)))
    ((force ~hts_idx_finish) ~idx ~final_offset)))
(export hts_idx_finish)

;; int hts_idx_save(const hts_idx_t *idx, const char *fn, int fmt);
(define ~hts_idx_save
  (delay (fh-link-proc
           "hts_idx_save"
           ffi:int
           (list ffi-void* ffi-void* ffi:int)
           link-lib)))
(define (hts_idx_save idx fn fmt)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~fn (unwrap~pointer fn))
        (~fmt (unwrap~fixed fmt)))
    ((force ~hts_idx_save) ~idx ~fn ~fmt)))
(export hts_idx_save)

;; int hts_idx_save_as(const hts_idx_t *idx, const char *fn, const char *fnidx
;;     , int fmt);
(define ~hts_idx_save_as
  (delay (fh-link-proc
           "hts_idx_save_as"
           ffi:int
           (list ffi-void* ffi-void* ffi-void* ffi:int)
           link-lib)))
(define (hts_idx_save_as idx fn fnidx fmt)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~fn (unwrap~pointer fn))
        (~fnidx (unwrap~pointer fnidx))
        (~fmt (unwrap~fixed fmt)))
    ((force ~hts_idx_save_as) ~idx ~fn ~fnidx ~fmt)))
(export hts_idx_save_as)

;; hts_idx_t *hts_idx_load(const char *fn, int fmt);
(define ~hts_idx_load
  (delay (fh-link-proc
           "hts_idx_load"
           ffi-void*
           (list ffi-void* ffi:int)
           link-lib)))
(define (hts_idx_load fn fmt)
  (let ((~fn (unwrap~pointer fn))
        (~fmt (unwrap~fixed fmt)))
    ((fht-wrap hts_idx_t*)
     ((force ~hts_idx_load) ~fn ~fmt))))
(export hts_idx_load)

;; hts_idx_t *hts_idx_load2(const char *fn, const char *fnidx);
(define ~hts_idx_load2
  (delay (fh-link-proc
           "hts_idx_load2"
           ffi-void*
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_idx_load2 fn fnidx)
  (let ((~fn (unwrap~pointer fn))
        (~fnidx (unwrap~pointer fnidx)))
    ((fht-wrap hts_idx_t*)
     ((force ~hts_idx_load2) ~fn ~fnidx))))
(export hts_idx_load2)

;; uint8_t *hts_idx_get_meta(hts_idx_t *idx, uint32_t *l_meta);
(define ~hts_idx_get_meta
  (delay (fh-link-proc
           "hts_idx_get_meta"
           ffi-void*
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_idx_get_meta idx l_meta)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~l_meta (unwrap~pointer l_meta)))
    ((force ~hts_idx_get_meta) ~idx ~l_meta)))
(export hts_idx_get_meta)

;; int hts_idx_set_meta(hts_idx_t *idx, uint32_t l_meta, uint8_t *meta, int 
;;     is_copy);
(define ~hts_idx_set_meta
  (delay (fh-link-proc
           "hts_idx_set_meta"
           ffi:int
           (list ffi-void* ffi:uint32 ffi-void* ffi:int)
           link-lib)))
(define (hts_idx_set_meta idx l_meta meta is_copy)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~l_meta (unwrap~fixed l_meta))
        (~meta (unwrap~pointer meta))
        (~is_copy (unwrap~fixed is_copy)))
    ((force ~hts_idx_set_meta)
     ~idx
     ~l_meta
     ~meta
     ~is_copy)))
(export hts_idx_set_meta)

;; int hts_idx_get_stat(const hts_idx_t *idx, int tid, uint64_t *mapped, 
;;     uint64_t *unmapped);
(define ~hts_idx_get_stat
  (delay (fh-link-proc
           "hts_idx_get_stat"
           ffi:int
           (list ffi-void* ffi:int ffi-void* ffi-void*)
           link-lib)))
(define (hts_idx_get_stat idx tid mapped unmapped)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~tid (unwrap~fixed tid))
        (~mapped (unwrap~pointer mapped))
        (~unmapped (unwrap~pointer unmapped)))
    ((force ~hts_idx_get_stat)
     ~idx
     ~tid
     ~mapped
     ~unmapped)))
(export hts_idx_get_stat)

;; uint64_t hts_idx_get_n_no_coor(const hts_idx_t *idx);
(define ~hts_idx_get_n_no_coor
  (delay (fh-link-proc
           "hts_idx_get_n_no_coor"
           ffi:uint64
           (list ffi-void*)
           link-lib)))
(define (hts_idx_get_n_no_coor idx)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx)))
    ((force ~hts_idx_get_n_no_coor) ~idx)))
(export hts_idx_get_n_no_coor)

;; long long hts_parse_decimal(const char *str, char **strend, int flags);
(define ~hts_parse_decimal
  (delay (fh-link-proc
           "hts_parse_decimal"
           ffi:long
           (list ffi-void* ffi-void* ffi:int)
           link-lib)))
(define (hts_parse_decimal str strend flags)
  (let ((~str (unwrap~pointer str))
        (~strend (unwrap~pointer strend))
        (~flags (unwrap~fixed flags)))
    ((force ~hts_parse_decimal) ~str ~strend ~flags)))
(export hts_parse_decimal)

;; const char *hts_parse_reg(const char *str, int *beg, int *end);
(define ~hts_parse_reg
  (delay (fh-link-proc
           "hts_parse_reg"
           ffi-void*
           (list ffi-void* ffi-void* ffi-void*)
           link-lib)))
(define (hts_parse_reg str beg end)
  (let ((~str (unwrap~pointer str))
        (~beg (unwrap~pointer beg))
        (~end (unwrap~pointer end)))
    ((force ~hts_parse_reg) ~str ~beg ~end)))
(export hts_parse_reg)

;; hts_itr_t *hts_itr_query(const hts_idx_t *idx, int tid, int beg, int end, 
;;     hts_readrec_func *readrec);
(define ~hts_itr_query
  (delay (fh-link-proc
           "hts_itr_query"
           ffi-void*
           (list ffi-void*
                 ffi:int
                 ffi:int
                 ffi:int
                 ffi-void*)
           link-lib)))
(define (hts_itr_query idx tid beg end readrec)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~tid (unwrap~fixed tid))
        (~beg (unwrap~fixed beg))
        (~end (unwrap~fixed end))
        (~readrec
          ((make-fctn-param-unwrapper
             ffi:int
             (list ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*))
           readrec)))
    ((fht-wrap hts_itr_t*)
     ((force ~hts_itr_query)
      ~idx
      ~tid
      ~beg
      ~end
      ~readrec))))
(export hts_itr_query)

;; void hts_itr_destroy(hts_itr_t *iter);
(define ~hts_itr_destroy
  (delay (fh-link-proc
           "hts_itr_destroy"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (hts_itr_destroy iter)
  (let ((~iter ((fht-unwrap hts_itr_t*) iter)))
    ((force ~hts_itr_destroy) ~iter)))
(export hts_itr_destroy)

;; typedef int (*hts_name2id_f)(void *, const char *);
(define-public hts_name2id_f-desc
  (bs:pointer
    (delay (fh:function ffi:int (list ffi-void* ffi-void*))))
  )
(define-fh-function*-type
  hts_name2id_f
  hts_name2id_f-desc
  hts_name2id_f?
  make-hts_name2id_f)
(export hts_name2id_f hts_name2id_f? make-hts_name2id_f)

;; typedef const char *(*hts_id2name_f)(void *, int);
(define-public hts_id2name_f-desc
  (bs:pointer
    (delay (fh:function ffi-void* (list ffi-void* ffi:int))))
  )
(define-fh-function*-type
  hts_id2name_f
  hts_id2name_f-desc
  hts_id2name_f?
  make-hts_id2name_f)
(export hts_id2name_f hts_id2name_f? make-hts_id2name_f)

;; typedef hts_itr_t *hts_itr_query_func(const hts_idx_t *idx, int tid, int beg
;;     , int end, hts_readrec_func *readrec);
(define ~hts_itr_query_func
  (delay (fh-link-proc
           "hts_itr_query_func"
           ffi-void*
           (list ffi-void*
                 ffi:int
                 ffi:int
                 ffi:int
                 ffi-void*)
           link-lib)))
(define (hts_itr_query_func idx tid beg end readrec)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~tid (unwrap~fixed tid))
        (~beg (unwrap~fixed beg))
        (~end (unwrap~fixed end))
        (~readrec
          ((make-fctn-param-unwrapper
             ffi:int
             (list ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*))
           readrec)))
    ((fht-wrap hts_itr_t*)
     ((force ~hts_itr_query_func)
      ~idx
      ~tid
      ~beg
      ~end
      ~readrec))))
(export hts_itr_query_func)

;; hts_itr_t *hts_itr_querys(const hts_idx_t *idx, const char *reg, 
;;     hts_name2id_f getid, void *hdr, hts_itr_query_func *itr_query, 
;;     hts_readrec_func *readrec);
(define ~hts_itr_querys
  (delay (fh-link-proc
           "hts_itr_querys"
           ffi-void*
           (list ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*)
           link-lib)))
(define (hts_itr_querys
         idx
         reg
         getid
         hdr
         itr_query
         readrec)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~reg (unwrap~pointer reg))
        (~getid ((fht-unwrap hts_name2id_f) getid))
        (~hdr (unwrap~pointer hdr))
        (~itr_query
          ((make-fctn-param-unwrapper
             ffi-void*
             (list ffi-void*
                   ffi:int
                   ffi:int
                   ffi:int
                   ffi-void*))
           itr_query))
        (~readrec
          ((make-fctn-param-unwrapper
             ffi:int
             (list ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*
                   ffi-void*))
           readrec)))
    ((fht-wrap hts_itr_t*)
     ((force ~hts_itr_querys)
      ~idx
      ~reg
      ~getid
      ~hdr
      ~itr_query
      ~readrec))))
(export hts_itr_querys)

;; int hts_itr_next(BGZF *fp, hts_itr_t *iter, void *r, void *data);
(define ~hts_itr_next
  (delay (fh-link-proc
           "hts_itr_next"
           ffi:int
           (list ffi-void* ffi-void* ffi-void* ffi-void*)
           link-lib)))
(define (hts_itr_next fp iter r data)
  (let ((~fp ((fht-unwrap BGZF*) fp))
        (~iter ((fht-unwrap hts_itr_t*) iter))
        (~r (unwrap~pointer r))
        (~data (unwrap~pointer data)))
    ((force ~hts_itr_next) ~fp ~iter ~r ~data)))
(export hts_itr_next)

;; const char **hts_idx_seqnames(const hts_idx_t *idx, int *n, hts_id2name_f 
;;     getid, void *hdr); /* free only the array, not the values*/
(define ~hts_idx_seqnames
  (delay (fh-link-proc
           "hts_idx_seqnames"
           ffi-void*
           (list ffi-void* ffi-void* ffi-void* ffi-void*)
           link-lib)))
(define (hts_idx_seqnames idx n getid hdr)
  (let ((~idx ((fht-unwrap hts_idx_t*) idx))
        (~n (unwrap~pointer n))
        (~getid ((fht-unwrap hts_id2name_f) getid))
        (~hdr (unwrap~pointer hdr)))
    ((force ~hts_idx_seqnames) ~idx ~n ~getid ~hdr)))
(export hts_idx_seqnames)

;; int hts_file_type(const char *fname);
(define ~hts_file_type
  (delay (fh-link-proc
           "hts_file_type"
           ffi:int
           (list ffi-void*)
           link-lib)))
(define (hts_file_type fname)
  (let ((~fname (unwrap~pointer fname)))
    ((force ~hts_file_type) ~fname)))
(export hts_file_type)

;; typedef struct errmod_t errmod_t;
(define-public errmod_t-desc 'void)
(define-public errmod_t*-desc (bs:pointer errmod_t-desc))
(define-fh-pointer-type errmod_t* errmod_t*-desc errmod_t*? make-errmod_t*)
(export errmod_t* errmod_t*? make-errmod_t*)

;; errmod_t *errmod_init(double depcorr);
(define ~errmod_init
  (delay (fh-link-proc
           "errmod_init"
           ffi-void*
           (list ffi:double)
           link-lib)))
(define (errmod_init depcorr)
  (let ((~depcorr (unwrap~float depcorr)))
    ((fht-wrap errmod_t*)
     ((force ~errmod_init) ~depcorr))))
(export errmod_init)

;; void errmod_destroy(errmod_t *em);
(define ~errmod_destroy
  (delay (fh-link-proc
           "errmod_destroy"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (errmod_destroy em)
  (let ((~em ((fht-unwrap errmod_t*) em)))
    ((force ~errmod_destroy) ~em)))
(export errmod_destroy)

;; int errmod_cal(const errmod_t *em, int n, int m, uint16_t *bases, float *q)
;;     ;
(define ~errmod_cal
  (delay (fh-link-proc
           "errmod_cal"
           ffi:int
           (list ffi-void*
                 ffi:int
                 ffi:int
                 ffi-void*
                 ffi-void*)
           link-lib)))
(define (errmod_cal em n m bases q)
  (let ((~em ((fht-unwrap errmod_t*) em))
        (~n (unwrap~fixed n))
        (~m (unwrap~fixed m))
        (~bases (unwrap~pointer bases))
        (~q (unwrap~pointer q)))
    ((force ~errmod_cal) ~em ~n ~m ~bases ~q)))
(export errmod_cal)

;; typedef struct probaln_par_t {
;;   float d, e;
;;   int bw;
;; } probaln_par_t;
;; == probaln_par_t =>
(define-public probaln_par_t-desc
  (bs:struct
    (list `(e ,float) `(d ,float) `(bw ,int))))
(define-fh-compound-type probaln_par_t probaln_par_t-desc probaln_par_t? 
 make-probaln_par_t)
(export probaln_par_t probaln_par_t? make-probaln_par_t)
(define-public probaln_par_t*-desc
  (bs:pointer probaln_par_t-desc))
(define-fh-pointer-type probaln_par_t* probaln_par_t*-desc probaln_par_t*? 
 make-probaln_par_t*)
(export probaln_par_t* probaln_par_t*? make-probaln_par_t*)
(ref<->deref!
  probaln_par_t*
  make-probaln_par_t*
  probaln_par_t
  make-probaln_par_t)
;; == struct-probaln_par_t =>
(define-public struct-probaln_par_t-desc
  probaln_par_t-desc)
(define-fh-compound-type struct-probaln_par_t struct-probaln_par_t-desc 
 struct-probaln_par_t? make-struct-probaln_par_t)
(export struct-probaln_par_t struct-probaln_par_t? make-struct-probaln_par_t)
(define-public struct-probaln_par_t*-desc
  probaln_par_t*-desc)
(define-fh-pointer-type struct-probaln_par_t* struct-probaln_par_t*-desc 
 struct-probaln_par_t*? make-struct-probaln_par_t*)
(export struct-probaln_par_t* struct-probaln_par_t*? 
 make-struct-probaln_par_t*)
(ref<->deref!
  struct-probaln_par_t*
  make-struct-probaln_par_t*
  struct-probaln_par_t
  make-struct-probaln_par_t)

;; int probaln_glocal(const uint8_t *ref, int l_ref, const uint8_t *query, int 
;;     l_query, const uint8_t *iqual, const probaln_par_t *c, int *state, 
;;     uint8_t *q);
(define ~probaln_glocal
  (delay (fh-link-proc
           "probaln_glocal"
           ffi:int
           (list ffi-void*
                 ffi:int
                 ffi-void*
                 ffi:int
                 ffi-void*
                 ffi-void*
                 ffi-void*
                 ffi-void*)
           link-lib)))
(define (probaln_glocal
         ref
         l_ref
         query
         l_query
         iqual
         c
         state
         q)
  (let ((~ref (unwrap~pointer ref))
        (~l_ref (unwrap~fixed l_ref))
        (~query (unwrap~pointer query))
        (~l_query (unwrap~fixed l_query))
        (~iqual (unwrap~pointer iqual))
        (~c ((fht-unwrap probaln_par_t*) c))
        (~state (unwrap~pointer state))
        (~q (unwrap~pointer q)))
    ((force ~probaln_glocal)
     ~ref
     ~l_ref
     ~query
     ~l_query
     ~iqual
     ~c
     ~state
     ~q)))
(export probaln_glocal)

;; typedef struct hts_md5_context hts_md5_context;
(define-public hts_md5_context-desc 'void)
(define-public hts_md5_context*-desc (bs:pointer hts_md5_context-desc))
(define-fh-pointer-type hts_md5_context* hts_md5_context*-desc 
 hts_md5_context*? make-hts_md5_context*)
(export hts_md5_context* hts_md5_context*? make-hts_md5_context*)

;; hts_md5_context *hts_md5_init(void);
(define ~hts_md5_init
  (delay (fh-link-proc
           "hts_md5_init"
           ffi-void*
           (list)
           link-lib)))
(define (hts_md5_init)
  (let ()
    ((fht-wrap hts_md5_context*)
     ((force ~hts_md5_init)))))
(export hts_md5_init)

;; void hts_md5_update(hts_md5_context *ctx, const void *data, unsigned long 
;;     size);
(define ~hts_md5_update
  (delay (fh-link-proc
           "hts_md5_update"
           ffi:void
           (list ffi-void* ffi-void* ffi:unsigned-long)
           link-lib)))
(define (hts_md5_update ctx data size)
  (let ((~ctx ((fht-unwrap hts_md5_context*) ctx))
        (~data (unwrap~pointer data))
        (~size (unwrap~fixed size)))
    ((force ~hts_md5_update) ~ctx ~data ~size)))
(export hts_md5_update)

;; void hts_md5_final(unsigned char *digest, hts_md5_context *ctx);
(define ~hts_md5_final
  (delay (fh-link-proc
           "hts_md5_final"
           ffi:void
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_md5_final digest ctx)
  (let ((~digest (unwrap~pointer digest))
        (~ctx ((fht-unwrap hts_md5_context*) ctx)))
    ((force ~hts_md5_final) ~digest ~ctx)))
(export hts_md5_final)

;; void hts_md5_reset(hts_md5_context *ctx);
(define ~hts_md5_reset
  (delay (fh-link-proc
           "hts_md5_reset"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (hts_md5_reset ctx)
  (let ((~ctx ((fht-unwrap hts_md5_context*) ctx)))
    ((force ~hts_md5_reset) ~ctx)))
(export hts_md5_reset)

;; void hts_md5_hex(char *hex, const unsigned char *digest);
(define ~hts_md5_hex
  (delay (fh-link-proc
           "hts_md5_hex"
           ffi:void
           (list ffi-void* ffi-void*)
           link-lib)))
(define (hts_md5_hex hex digest)
  (let ((~hex (unwrap~pointer hex))
        (~digest (unwrap~pointer digest)))
    ((force ~hts_md5_hex) ~hex ~digest)))
(export hts_md5_hex)

;; void hts_md5_destroy(hts_md5_context *ctx);
(define ~hts_md5_destroy
  (delay (fh-link-proc
           "hts_md5_destroy"
           ffi:void
           (list ffi-void*)
           link-lib)))
(define (hts_md5_destroy ctx)
  (let ((~ctx ((fht-unwrap hts_md5_context*) ctx)))
    ((force ~hts_md5_destroy) ~ctx)))
(export hts_md5_destroy)

;; access to enum symbols and #define'd constants:
(define ffi-htslib-symbol-val
  (let ((sym-tab
          '((HTS_LOG_OFF . 0)
            (HTS_LOG_ERROR . 1)
            (HTS_LOG_WARNING . 3)
            (HTS_LOG_INFO . 4)
            (HTS_LOG_DEBUG . 5)
            (HTS_LOG_TRACE . 6)
            (unknown_category . 0)
            (sequence_data . 1)
            (variant_data . 2)
            (index_file . 3)
            (region_list . 4)
            (category_maximum . 32767)
            (unknown_format . 0)
            (binary_format . 1)
            (text_format . 2)
            (sam . 3)
            (bam . 4)
            (bai . 5)
            (cram . 6)
            (crai . 7)
            (vcf . 8)
            (bcf . 9)
            (csi . 10)
            (gzi . 11)
            (tbi . 12)
            (bed . 13)
            (htsget . 14)
            (json . 14)
            (format_maximum . 32767)
            (no_compression . 0)
            (gzip . 1)
            (bgzf . 2)
            (custom . 3)
            (compression_maximum . 32767)
            (SAM_QNAME . 1)
            (SAM_FLAG . 2)
            (SAM_RNAME . 4)
            (SAM_POS . 8)
            (SAM_MAPQ . 16)
            (SAM_CIGAR . 32)
            (SAM_RNEXT . 64)
            (SAM_PNEXT . 128)
            (SAM_TLEN . 256)
            (SAM_SEQ . 512)
            (SAM_QUAL . 1024)
            (SAM_AUX . 2048)
            (SAM_RGAUX . 4096)
            (CRAM_OPT_DECODE_MD . 0)
            (CRAM_OPT_PREFIX . 1)
            (CRAM_OPT_VERBOSITY . 2)
            (CRAM_OPT_SEQS_PER_SLICE . 3)
            (CRAM_OPT_SLICES_PER_CONTAINER . 4)
            (CRAM_OPT_RANGE . 5)
            (CRAM_OPT_VERSION . 6)
            (CRAM_OPT_EMBED_REF . 7)
            (CRAM_OPT_IGNORE_MD5 . 8)
            (CRAM_OPT_REFERENCE . 9)
            (CRAM_OPT_MULTI_SEQ_PER_SLICE . 10)
            (CRAM_OPT_NO_REF . 11)
            (CRAM_OPT_USE_BZIP2 . 12)
            (CRAM_OPT_SHARED_REF . 13)
            (CRAM_OPT_NTHREADS . 14)
            (CRAM_OPT_THREAD_POOL . 15)
            (CRAM_OPT_USE_LZMA . 16)
            (CRAM_OPT_USE_RANS . 17)
            (CRAM_OPT_REQUIRED_FIELDS . 18)
            (CRAM_OPT_LOSSY_NAMES . 19)
            (CRAM_OPT_BASES_PER_SLICE . 20)
            (HTS_OPT_COMPRESSION_LEVEL . 100)
            (HTS_OPT_NTHREADS . 101)
            (HTS_OPT_THREAD_POOL . 102)
            (HTS_OPT_CACHE_SIZE . 103)
            (HTS_OPT_BLOCK_SIZE . 104)
            (HTS_FMT_CSI . 0)
            (HTS_FMT_BAI . 1)
            (HTS_FMT_TBI . 2)
            (HTS_FMT_CRAI . 3)
            (HTS_PARSE_THOUSANDS_SEP . 1)
            (FT_UNKN . 0)
            (FT_GZ . 1)
            (FT_VCF . 2))))
    (lambda (k) (assq-ref sym-tab k))))
(export ffi-htslib-symbol-val)

(define (unwrap-enum obj)
  (cond ((number? obj) obj)
        ((symbol? obj) (ffi-htslib-symbol-val obj))
        ((fh-object? obj) (struct-ref obj 0))
        (else (error "type mismatch"))))

(define ffi-htslib-types
  '((pointer . "BGZF") "BGZF" (struct . "__kstring_t") (pointer . "kstring_t")
    "kstring_t" (struct . "htsFormat") (pointer . "htsFormat") "htsFormat" 
    (pointer . "htsFile") "htsFile" (pointer . "htsThreadPool") 
    "htsThreadPool" (struct . "hts_opt") (pointer . "hts_opt") "hts_opt" 
    (pointer . "hts_idx_t") "hts_idx_t" (pointer . "hts_pair64_t") 
    "hts_pair64_t" (pointer . "hts_itr_t") "hts_itr_t" "hts_name2id_f" 
    "hts_id2name_f" (pointer . "errmod_t") "errmod_t" (struct . 
    "probaln_par_t") (pointer . "probaln_par_t") "probaln_par_t" (pointer . 
    "hts_md5_context") "hts_md5_context"))
(export ffi-htslib-types)

;; TODO: add renamer

;; --- last line ---

  reply	other threads:[~2017-11-10  2:34 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <D30BE676-0171-4E8F-8CD0-B40A74B08850@gmail.com>
2017-08-19 15:30 ` ffi-help: status to 19 Aug 2017 Matt Wette
2017-09-08  3:32   ` ffi-help: #:use-ffi-module Matt Wette
2017-09-08  3:40     ` Matt Wette
2017-11-09 19:10   ` ffi-help: status to 19 Aug 2017 Roel Janssen
2017-11-10  1:00     ` Matt Wette
2017-11-10  2:34       ` Matt Wette [this message]
2017-11-10  2:39     ` Matt Wette
2017-11-10 23:04       ` Stefan Israelsson Tampe
2017-11-11  4:38         ` Matt Wette
2017-11-14 18:06     ` Ricardo Wurmus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=4505B7FB-D7A8-448C-B6E8-CD035C237DC9@gmail.com \
    --to=matt.wette@gmail.com \
    --cc=guile-devel@gnu.org \
    --cc=guile-user@gnu.org \
    --cc=roel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).