ffi-help: status to 19 Aug 2017

ffi-help: status to 19 Aug 2017

[Matt Wette]

Hi All,

I am working on a ffi-helper: a program that will read in a C dot-h file and generate a Guile dot-scm file 
which defines a module to provide hooks into the associated C library.  Goal is to release something in
Oct 2017 but that date is likely to slip.

Current shortcomings:
1) Guile does not currently handle some types (e..g, long long, uintptr_t).
2) Guile does not have support for varargs (e.g., printf(char *, ...) ).
   I may take a look at this.  One idea I have is to use '... in the call interface spec
   and use (type . value) pairs in the calls.
3) The bytestructures module does not support function declarations.
4) ... (probably more)

Someone asked to have libgit2 converted and this, and some others, turned out to give visibility
to several limitations and bugs in my C parser.  For one, how #include <foo/bar.h> is interpreted 
is not specified by the language: it is implementation defined, and I had to track down how libgit2 
was including files.  I also had to add some GNUC extensions (e.g., asm, statement-block expressions,
include_next) to the parser and preprocessor.  As one can see from the file listing below, libgit2 
has a large number of files, and declarations.

mwette$ ls include/git2
annotated_commit.h	indexer.h		repository.h
attr.h			inttypes.h		reset.h
blame.h			merge.h			revert.h
blob.h			message.h		revparse.h
branch.h		net.h			revwalk.h
buffer.h		notes.h			signature.h
checkout.h		object.h		stash.h
cherrypick.h		odb.h			status.h
clone.h			odb_backend.h		stdint.h
commit.h		oid.h			strarray.h
common.h		oidarray.h		submodule.h
config.h		pack.h			sys/
cred_helpers.h		patch.h			tag.h
describe.h		pathspec.h		trace.h
diff.h			proxy.h			transaction.h
errors.h		rebase.h		transport.h
filter.h		refdb.h			tree.h
global.h		reflog.h		types.h
graph.h			refs.h			version.h
ignore.h		refspec.h		worktree.h
index.h			remote.h

mwette$ cat libgit2.ffi
(define-ffi-module (libgit2)
  #:include '("git2.h")
  #:inc-filter (lambda (file-spec path-spec)
		 (string-contains path-spec "git2/" 0))
  #:library '("libgit2"))

The following command takes 10.5 seconds on my new macbook pro 
and produces a libgit2.scm file that is 14,546 lines long.

	mwette$ guild compile-ffi libgit2.ffi

The following command takes 66 seconds on my mac (Guile 2.0.13).

	mwette$ guile -c '(use-modules (libgit2))' 

(However, I'm still getting some unresolved references: that's work to go.)
(The compile takes significantly longer using Guile 2.2.)


Here are some excerpts from (100% autogenerated) libgit2.scm:

;; typedef struct git_repository git_repository;
(define-fh-pointer-type git_repository*)

;; typedef struct git_remote git_remote;
(define-fh-pointer-type git_remote*)

;; extern git_repository *git_remote_owner(const git_remote *remote);
(define git_remote_owner
  (let ((~f (ffi:pointer->procedure
              '*
              (dynamic-func "git_remote_owner" (dynamic-link))
              (list '*))))
    (lambda (remote)
      (let ((~remote (unwrap-git_remote* remote)))
        (wrap-git_repository* (~f ~remote))))))
(export git_remote_owner)

;; typedef enum {
;;   GIT_REF_INVALID = 0,
;;   GIT_REF_OID = 1,
;;   GIT_REF_SYMBOLIC = 2,
;;   GIT_REF_LISTALL = GIT_REF_OID | GIT_REF_SYMBOLIC,
;; } git_ref_t;
(define-fh-enum git_ref_t
  '((GIT_REF_INVALID . 0)
    (GIT_REF_OID . 1)
    (GIT_REF_SYMBOLIC . 2)
    (GIT_REF_LISTALL . 3))
  )

;; typedef struct git_remote_callbacks git_remote_callbacks;
;; struct git_remote_callbacks {
;;   unsigned int version;
;;   /**
;;   	 * Textual progress from the remote. Text send over the
;;   	 * progress side-band will be passed to this function (this is
;;   	 * the 'counting objects' output).
;;   	 */
;;   git_transport_message_cb sideband_progress;
;;   /**
;;   	 * Completion is called when different parts of the download
;;   	 * process are done (currently unused).
;;   	 */
;;   int (*completion)(git_remote_completion_type type, void *data);
;;   /**
;;   	 * This will be called if the remote host requires
;;   	 * authentication in order to connect to it.
;;   	 *
;;   	 * Returning GIT_PASSTHROUGH will make libgit2 behave as
;;   	 * though this field isn't set.
;;   	 */
;;   git_cred_acquire_cb credentials;
;;   /**
;;   	 * If cert verification fails, this will be called to let the
;;   	 * user make the final decision of whether to allow the
;;   	 * connection to proceed. Returns 1 to allow the connection, 0
;;   	 * to disallow it or a negative value to indicate an error.
;;   	 */
;;   git_transport_certificate_check_cb certificate_check;
;;   /**
;;   	 * During the download of new data, this will be regularly
;;   	 * called with the current count of progress done by the
;;   	 * indexer.
;;   	 */
;;   git_transfer_progress_cb transfer_progress;
;;   /**
;;   	 * Each time a reference is updated locally, this function
;;   	 * will be called with information about it.
;;   	 */
;;   int (*update_tips)(const char *refname, const git_oid *a, const git_oid *
;;       b, void *data);
;;   /**
;;   	 * Function to call with progress information during pack
;;   	 * building. Be aware that this is called inline with pack
;;   	 * building operations, so performance may be affected.
;;   	 */
;;   git_packbuilder_progress pack_progress;
;;   /**
;;   	 * Function to call with progress information during the
;;   	 * upload portion of a push. Be aware that this is called
;;   	 * inline with pack building operations, so performance may be
;;   	 * affected.
;;   	 */
;;   git_push_transfer_progress push_transfer_progress;
;;   /**
;;   	 * Called for each updated reference on push. If `status` is
;;   	 * not `NULL`, the update was rejected by the remote server
;;   	 * and `status` contains the reason given.
;;   	 */
;;   int (*push_update_reference)(const char *refname, const char *status, 
;;       void *data);
;;   /**
;;   	 * Called once between the negotiation step and the upload. It
;;   	 * provides information about what updates will be performed.
;;   	 */
;;   git_push_negotiation push_negotiation;
;;   /**
;;   	 * Create the transport to use for this operation. Leave NULL
;;   	 * to auto-detect.
;;   	 */
;;   git_transport_cb transport;
;;   /**
;;   	 * This will be passed to each of the callbacks in this struct
;;   	 * as the last parameter.
;;   	 */
;;   void *payload;
;; };
(define git_remote_callbacks-desc
  (bs:struct
    (list `(version ,unsigned-int)
          `(sideband_progress
             ,git_transport_message_cb-desc)
          `(completion ,(bs:pointer intptr_t))
          `(credentials ,git_cred_acquire_cb-desc)
          `(certificate_check
             ,git_transport_certificate_check_cb-desc)
          `(transfer_progress
             ,git_transfer_progress_cb-desc)
          `(update_tips ,(bs:pointer intptr_t))
          `(pack_progress ,git_packbuilder_progress-desc)
          `(push_transfer_progress
             ,git_push_transfer_progress-desc)
          `(push_update_reference ,(bs:pointer intptr_t))
          `(push_negotiation ,git_push_negotiation-desc)
          `(transport ,git_transport_cb-desc)
          `(payload ,(bs:pointer intptr_t)))))
(export git_remote_callbacks-desc)
(define-fh-compound-type/p git_remote_callbacks git_remote_callbacks-desc)
(define struct-git_remote_callbacks git_remote_callbacks)

;; extern int git_reference_create_matching(git_reference **out, 
;;     git_repository *repo, const char *name, const git_oid *id, int force, 
;;     const git_oid *current_id, const char *log_message);
(define git_reference_create_matching
  (let ((~f (ffi:pointer->procedure
              ffi:int
              (dynamic-func
                "git_reference_create_matching"
                (dynamic-link))
              (list '* '* '* '* ffi:int '* '*))))
    (lambda (out repo name id force current_id log_message)
      (let ((~out (unwrap~pointer out))
            (~repo (unwrap-git_repository* repo))
            (~name (unwrap~pointer name))
            (~id (unwrap-git_oid* id))
            (~force (unwrap~fixed force))
            (~current_id (unwrap-git_oid* current_id))
            (~log_message (unwrap~pointer log_message)))
        (~f ~out
            ~repo
            ~name
            ~id
            ~force
            ~current_id
            ~log_message)))))
(export git_reference_create_matching)

ffi-help: #:use-ffi-module

[Matt Wette]

Hi All,

I am working on a ffi-helper: a program that will read in a C dot-h file and generate a Guile dot-scm file 
which defines a module to provide hooks into the associated C library.  Goal is to release something 
around Apr 2018.

With the helper interfaces are with ffi-modules.  A module is a set of C includes and C libraries.  The Scheme
interface code encapsulated in a Guile module.  If a C type is defined in the set of C includes, you will see it
in the associated Guile module.  If a C type is defined outside the set of includes, and is not included in a 
use-ffi-module declaration, then the type is expanded.  So, the ffi-module declaration has expressions to 
indicate which files should be include in the set defining the module.

Here is a ffi-module declaration for the gobject:

  mwette$ cat gobject.ffi 
  ;; gobject.ffi				-*- Scheme -*-

  (define-ffi-module (gobject)
    #:use-ffi-module (glib)
    #:pkg-config "gobject-2.0"
    #:include '("glib-object.h")
    #:inc-filter (lambda (file-spec path-spec)
  		 (string-contains path-spec "gobject/" 0))
    )

  ;; --- last line ---

To convert a dot-ffi module to dot-scm you use guild:
  mwette$ guild compile-ffi gobject.ffi

Currently not handled: varargs, long double, some function types, ...
I have some ideas for handling varargs.

But otherwise I'm getting things to compile:

  mwette$ wc {cairo,gdbm,gio,glib,gobject,libgit2,sqlite3}.ffi
      25      65     657 cairo.ffi
      14      45     371 gdbm.ffi
      10      27     218 gio.ffi
      19      47     509 glib.ffi
      11      27     265 gobject.ffi
      14      35     403 libgit2.ffi
      12      34     339 sqlite3.ffi

  mwette$ wc {cairo,gdbm,gio,glib,gobject,libgit2,sqlite3}.scm
    6629   16556  221347 cairo.scm
     747    2067   23093 gdbm.scm
   42884  109771 1554684 gio.scm
   28275   74979  887380 glib.scm
   10417   26654  349534 gobject.scm
   15702   45142  524011 libgit2.scm
    4980   14389  168532 sqlite3.scm

  mwette$ ls -l {cairo,gdbm,gio,glib,gobject,libgit2,sqlite3}.scm.go
  -rw-r--r--  1 mwette  staff   657197 Sep  7 20:15 cairo.scm.go
  -rw-r--r--  1 mwette  staff   105509 Sep  7 20:15 gdbm.scm.go
  -rw-r--r--  1 mwette  staff  7313669 Sep  7 20:07 gio.scm.go
  -rw-r--r--  1 mwette  staff  3168869 Sep  7 19:03 glib.scm.go
  -rw-r--r--  1 mwette  staff  1672685 Sep  7 18:43 gobject.scm.go
  -rw-r--r--  1 mwette  staff  2018653 Sep  7 20:17 libgit2.scm.go
  -rw-r--r--  1 mwette  staff   766205 Sep  7 20:17 sqlite3.scm.go

Matt

Re: ffi-help: #:use-ffi-module

[Matt Wette]

> On Sep 7, 2017, at 8:32 PM, Matt Wette <matt.wette@gmail.com> wrote:
> 
> 
> Hi All,
> 
> I am working on a ffi-helper: a program that will read in a C dot-h file and generate a Guile dot-scm file 
> which defines a module to provide hooks into the associated C library.  Goal is to release something 
> around Apr 2018.
> 

I should mention that the compound type system uses the slick bytestructures Scheme package 
developed by TaylanUB: https://github.com/TaylanUB/scheme-bytestructures

Re: ffi-help: status to 19 Aug 2017

[Roel Janssen]

Matt Wette writes:

> Hi All,
>
> I am working on a ffi-helper: a program that will read in a C dot-h file and generate a Guile dot-scm file 
> which defines a module to provide hooks into the associated C library.  Goal is to release something in
> Oct 2017 but that date is likely to slip.
>
> Current shortcomings:
> 1) Guile does not currently handle some types (e..g, long long, uintptr_t).
> 2) Guile does not have support for varargs (e.g., printf(char *, ...) ).
>    I may take a look at this.  One idea I have is to use '... in the call interface spec
>    and use (type . value) pairs in the calls.
> 3) The bytestructures module does not support function declarations.
> 4) ... (probably more)
>
> Someone asked to have libgit2 converted and this, and some others, turned out to give visibility
> to several limitations and bugs in my C parser.  For one, how #include <foo/bar.h> is interpreted 
> is not specified by the language: it is implementation defined, and I had to track down how libgit2 
> was including files.  I also had to add some GNUC extensions (e.g., asm, statement-block expressions,
> include_next) to the parser and preprocessor.  As one can see from the file listing below, libgit2 
> has a large number of files, and declarations.
>
> ...

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

Re: ffi-help: status to 19 Aug 2017

[Matt Wette]

> On Nov 9, 2017, at 11:10 AM, Roel Janssen <roel@gnu.org> wrote:
> 
> 
> Matt Wette writes:
> 
>> Hi All,
>> 
>> I am working on a ffi-helper: a program that will read in a C dot-h file and generate a Guile dot-scm file 
>> which defines a module to provide hooks into the associated C library.  Goal is to release something in
>> Oct 2017 but that date is likely to slip.
>> 
>> Current shortcomings:
>> 1) Guile does not currently handle some types (e..g, long long, uintptr_t).
>> 2) Guile does not have support for varargs (e.g., printf(char *, ...) ).
>>   I may take a look at this.  One idea I have is to use '... in the call interface spec
>>   and use (type . value) pairs in the calls.
>> 3) The bytestructures module does not support function declarations.
>> 4) ... (probably more)
>> 
>> Someone asked to have libgit2 converted and this, and some others, turned out to give visibility
>> to several limitations and bugs in my C parser.  For one, how #include <foo/bar.h> is interpreted 
>> is not specified by the language: it is implementation defined, and I had to track down how libgit2 
>> was including files.  I also had to add some GNUC extensions (e.g., asm, statement-block expressions,
>> include_next) to the parser and preprocessor.  As one can see from the file listing below, libgit2 
>> has a large number of files, and declarations.
>> 
>> ...
> 
> 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.


mwette$ git clone -b c99dev git://git.savannah.nongnu.org/nyacc.git nyacc
Cloning into 'nyacc'...
remote: Counting objects: 5927, done.
mwette$ cd nyacc
mwette$ cd examples
mwette$ source env.sh
mwette$ cd ffi
mwette$ cp TMPL.ffi htslib.ffi
mwette$ vi htslib.ffi
mwette$ cat htslib.ffi
;; htslib.ffi				-*- Scheme -*-

(define-ffi-module (ffi htslib)
  #:pkg-config "htslib"
  #:include '("htslib/hts.h")
  #:inc-filter (lambda (file-spec path-spec)
                 (string-contains path-spec "htslib/" 0))
  )

;; --- last line ---
mwette$ guild compile ffi/htslib.fif
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /var/tmp/yy/nyacc/examples/scripts/compile-ffi.scm
    ...
;;; compiled .../c99/ffi-help.scm.go
TODO: fix gen-lookup-proc: it's including imported symbols
;;; scripts/compile-ffi.scm:119:8: warning: possibly unbound variable `compile'
;;; compiled /Users/mwette/.cache/guile/ccache/2.2-LE-8-3.A/private/var/tmp/yy/nyacc/examples/scripts/compile-ffi.scm.go
ffi-help: WARNING: the FFI helper is experimental
/opt/local/include/htslib/hts.h:774: parse failed at state 313, on input "U"
(unknown):1: C99 parse error
*** compile-ffi: parse failed

The offending line is the following, which seems to indicate my lexer is not reading "LLU" constants. I will check.

    v = ((v & 0x00000000FFFFFFFFLLU) << 32) | (v >> 32);

Had the above worked, then you should be able to `(use-modules (ffi htslib))':

mwette$ guile
GNU Guile 2.2.2
Copyright (C) 1995-2017 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (use-modules (ffi htslib))
ERROR: no code for module (ffi htslib)

Re: ffi-help: status to 19 Aug 2017

[Matt Wette]

[-- 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 ---

Re: ffi-help: status to 19 Aug 2017

[Matt Wette]

> On Nov 9, 2017, at 11:10 AM, Roel Janssen <roel@gnu.org> wrote:
> 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?
> 

And not sure I answered this question as intended.  The `guild' command looks for a scm file with 
basename of the first argument in a subdirectory scripts/ in LOAD_PATH.  So `guild compile-ffi foo.ffi'
will execute `scripts/compile-ffi.scm' with argument `foo.ffi'.

Matt

Re: ffi-help: status to 19 Aug 2017

[Stefan Israelsson Tampe]

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

I'm trying out the ffi help stuff.

1. It looks like 1.234f numeric constants is not lexed
2. characters constants can be included in #if preprocessor steps it looks,
3. character constants seam to follow L?'(\\.|[^\\'])+'

Regards
Stefan

references:
https://www.lysator.liu.se/c/ANSI-C-grammar-l.html
https://gcc.gnu.org/onlinedocs/cpp/If.html#If

On Fri, Nov 10, 2017 at 3:39 AM, Matt Wette <matt.wette@gmail.com> wrote:

>
> > On Nov 9, 2017, at 11:10 AM, Roel Janssen <roel@gnu.org> wrote:
> > 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?
> >
>
> And not sure I answered this question as intended.  The `guild' command
> looks for a scm file with
> basename of the first argument in a subdirectory scripts/ in LOAD_PATH.
> So `guild compile-ffi foo.ffi'
> will execute `scripts/compile-ffi.scm' with argument `foo.ffi'.
>
> Matt
>
>
>
>

[-- Attachment #2: Type: text/html, Size: 1918 bytes --]

Re: ffi-help: status to 19 Aug 2017

[Matt Wette]

> On Nov 10, 2017, at 3:04 PM, Stefan Israelsson Tampe <stefan.itampe@gmail.com> wrote:
> 
> I'm trying out the ffi help stuff.
> 
> 1. It looks like 1.234f numeric constants is not lexed
> 2. characters constants can be included in #if preprocessor steps it looks,
> 3. character constants seam to follow L?'(\\.|[^\\'])+'

I believe these are fixed in commit fb03d613.  Thanks. I was not using the C readers in the CPP lexer.

Matt

Re: ffi-help: status to 19 Aug 2017

[Ricardo Wurmus]

Roel Janssen <roel@gnu.org> writes:

> 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?

That sounds exciting!  Guile bindings for htslib?  That would be great!

-- 
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net