From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Matt Wette Newsgroups: gmane.lisp.guile.user,gmane.lisp.guile.devel Subject: Re: ffi-help: status to 19 Aug 2017 Date: Thu, 9 Nov 2017 18:34:57 -0800 Message-ID: <4505B7FB-D7A8-448C-B6E8-CD035C237DC9@gmail.com> References: <25A19914-FADD-46DC-AEFA-F290210C33DF@gmail.com> <878tfffet8.fsf@gnu.org> <0B1CB7F6-A400-487D-BBCA-BE08E75033CA@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 (Mac OS X Mail 10.3 \(3273\)) Content-Type: multipart/mixed; boundary="Apple-Mail=_F4BD192D-A826-43B7-97BE-35C35BF6D74A" X-Trace: blaine.gmane.org 1510281348 29390 195.159.176.226 (10 Nov 2017 02:35:48 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 10 Nov 2017 02:35:48 +0000 (UTC) Cc: Guile User , guile-devel To: Roel Janssen Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Fri Nov 10 03:35:40 2017 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eCzAQ-00078P-0j for guile-user@m.gmane.org; Fri, 10 Nov 2017 03:35:38 +0100 Original-Received: from localhost ([::1]:39851 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eCzAV-0001Jk-C0 for guile-user@m.gmane.org; Thu, 09 Nov 2017 21:35:43 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34544) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eCz9z-0001Hn-A0 for guile-user@gnu.org; Thu, 09 Nov 2017 21:35:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eCz9v-0000mx-IX for guile-user@gnu.org; Thu, 09 Nov 2017 21:35:11 -0500 Original-Received: from mail-pg0-x230.google.com ([2607:f8b0:400e:c05::230]:47686) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eCz9q-0000lZ-JS; Thu, 09 Nov 2017 21:35:03 -0500 Original-Received: by mail-pg0-x230.google.com with SMTP id o7so6315833pgc.4; Thu, 09 Nov 2017 18:35:02 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:message-id:mime-version:subject:date:in-reply-to:cc:to :references; bh=RaIJYAVa9B9XBYbOHoGFxecQe2PlDbSnDUUvQeXO5t0=; b=G93Go5a48b3U6HcyrXt7fFSGr19fa5L3wp/sEd2Rg1gCrWq5cc0lmBA8+KLFQ3Co2Z b2R0R0ND8hCtPZoLHS1CQ9+nltIXeuN2moPbslCXGQXRGxdKGlRH/awMoejft9KGC6by R/Sqho09dAFYGkfAUQmkK8ajGKuMYv5Js8ibky9y3zxIofYM4p2AcNLO3R41dNtK8jUo edO5suUUXctT10/Gx2gUcjdFqCGvHB2XWFHEVTkvNCYH/UaZwk8qLTtrl3UnjKxYftK/ X8jlEHnWYQNGVarvPCJYJKGb2rgW43BPDkN2h4xGrCeZsr4o5feX72twvaSRxUyozWCr E/nA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:message-id:mime-version:subject:date :in-reply-to:cc:to:references; bh=RaIJYAVa9B9XBYbOHoGFxecQe2PlDbSnDUUvQeXO5t0=; b=AApjh4vOhRq+/fPMOfHdVxqJgSuIVG7EzoyyPRa+htDj+UTKSfP+ORf12Q3lWp/8Cs sqCrgJcUDg447l22a4iyH9x9yWnpMF1Q2mXSOK1oRhjmlej5Oie0oXTLw5QyXjYCDDzf 40jGu9/eq8ok4QaDeerlZ85C3cD2/jVkVsyqRsE/s86kAytgqIISPq8Jt6udPgKwOewo szIyWG9HZQriTM0qaOJWkYBaBwcuyh0/JF9dcEw82TDAder3/DJBJIzn3/SaCa5hIEh1 eCX9JkHkdF7tF8f74MqWw59RVUzUc6J90AYOH4ggh0x1hqcHNU/2z+P0BWGtwICNNPlt LwSQ== X-Gm-Message-State: AJaThX5wgImgE1/iLTCTNX5R0aLyVSuFS7vzeHgAoLJVMwUwdiSyxhtD lq0vqYByc2AaZKdHCSOVRTmYIRQ/ X-Google-Smtp-Source: ABhQp+SjC8TUCLm0mtqzvQ0SULhh9iYu81nHrmvR00bhDig2f+QkCO6LhJNRVy0PUGEBK1Apb5UGiw== X-Received: by 10.84.254.13 with SMTP id b13mr2448242plm.363.1510281300978; Thu, 09 Nov 2017 18:35:00 -0800 (PST) Original-Received: from nautilus.championbroadband.com (216-165-229-229.championbroadband.com. [216.165.229.229]) by smtp.gmail.com with ESMTPSA id e70sm13412032pgc.15.2017.11.09.18.34.59 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Thu, 09 Nov 2017 18:35:00 -0800 (PST) In-Reply-To: <0B1CB7F6-A400-487D-BBCA-BE08E75033CA@gmail.com> X-Mailer: Apple Mail (2.3273) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:400e:c05::230 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:14236 gmane.lisp.guile.devel:19378 Archived-At: --Apple-Mail=_F4BD192D-A826-43B7-97BE-35C35BF6D74A Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=us-ascii > On Nov 9, 2017, at 5:00 PM, Matt Wette wrote: >=20 >> On Nov 9, 2017, at 11:10 AM, Roel Janssen wrote: >>> ... >>=20 >> Thanks for creating this! It seems to be very useful and powerful. >>=20 >> 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? >>=20 >> Kind regards, >> Roel Janssen >=20 > 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. =20 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 --Apple-Mail=_F4BD192D-A826-43B7-97BE-35C35BF6D74A Content-Disposition: attachment; filename=htslib.scm Content-Type: application/octet-stream; x-unix-mode=0644; name="htslib.scm" Content-Transfer-Encoding: 7bit ;; 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 --- --Apple-Mail=_F4BD192D-A826-43B7-97BE-35C35BF6D74A--