ffi-help: status to 19 Aug 2017

[Matt Wette <matt.wette@gmail.com>]

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)