Commits

evhan  committed 9e954b4 Merge with conflicts

Merge branch 'object-owner' into development

Conflicts:
git.scm

  • Participants
  • Parent commits d6f6580, 588502a

Comments (0)

Files changed (3)

File git-exports.scm

  blob-content
  blob-id
  blob-length
+ blob-repository
  blob?
  branch
  branch-delete
  commit-parent-id
  commit-parentcount
  commit-parents
+ commit-repository
  commit-time
  commit-time-offset
  commit-tree
  index-entry-ino
  index-entry-mode
  index-entry-mtime
+ index-entry-owner
  index-entry-path
  index-entry-size
  index-entry-stage
  note
  note-id
  note-message
+ note-repository
  notes
  notes-fold
  object-id
- object-owner
  object-sha
  object-type
  object=?
  odb-hash
  odb-object-data
  odb-object-id
+ odb-object-owner
  odb-object-size
  odb-object-type
  odb-object?
  reference-name
  reference-remote?
  reference-rename
+ reference-repository
  reference-resolve
  reference-target
  reference-target-set!
  remote-pushurl
  remote-pushurl-set!
  remote-refspecs
+ remote-repository
  remote-stats
  remote-update-fetchhead-set!
  remote-update-tips
  tag-message
  tag-name
  tag-peel
+ tag-repository
  tag-tagger
  tag-target
  tag?
  tree-entry->object
  tree-entry-id
  tree-entry-name
+ tree-entry-owner
  tree-entry-type
  tree-entry?
  tree-entrycount
  tree-fold
  tree-id
  tree-ref
+ tree-repository
  tree?)
           (only git-lolevel git-error)
           (only posix current-directory regular-file?)
           (only files normalize-pathname make-pathname)
-          (only lolevel record-instance-slot number-of-bytes move-memory! tag-pointer)
+          (only lolevel record-instance-slot number-of-bytes move-memory!)
           (rename (only data-structures o) (o compose))
           (prefix (except git-lolevel git-error) git-)
           (rename (only chicken make-blob)
 (define-syntax define-git-record-type
   (let ((s+ symbol-append))
     (lambda (e . c)
-      (let* ((name (caadr e))
-             (attr (cdadr e))
-             (free (cdddr e))
-             (printer (caddr e))
-             (make (s+ 'make- name))
-             (%make (s+ '%make- name))
+      (let* ((name      (cadr e))
+             (spec      (caddr e))
+             (printer   (cadddr e))
+             (free      (cddddr e))
+             (slots     (cdar spec))
+             (attrs     (cdr spec))
+             (make      (s+ 'make- name))
+             (%make     (s+ '%make- name))
              (->pointer (s+ name '->pointer))
              (pointer-> (s+ 'pointer-> name)))
         `(begin
-           (define-record ,name >pointer) ; XXX this is lazy
+           (define-record ,name >pointer ,@slots)
            (define ,%make ,make)
            (define-record-printer (,name ,name out)
              (display ,printer out))
-           (define (,pointer-> ptr)
+           (define (,pointer-> ,@slots ptr)
              (and-let* ((ptr)
-                        (obj (,%make ptr)))
+                        (obj (,%make ptr ,@slots)))
                ,(if (null? free)
                     'obj
                     `(set-finalizer! obj
                         (else
                          `(define (,getter obj)
                             (,(s+ 'git- getter) (,->pointer obj)))))))
-                  attr))))))
+                  attrs))))))
 
-(define ((pointer-tagger t) p) (and p (tag-pointer p t)))
 (define ((git-record-attribute-setter f) r v) (f (object->pointer r) v))
+(define ((set-owner m f) o) (m o (f o)))
+(define ((preserve-owner m f) o) (m (object-owner o) (f o)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;;
 
 ;; OIDs are allocated/freed by git-lolevel.scm.
-(define-git-record-type
-  (oid)
+(define-git-record-type oid
+  ((oid))
   (format "#<oid ~S>" (oid->string oid 7)))
 
-;; All git record types consist of a single field, the object pointer.
+;; The first slot in all Git record types is the object pointer.
 (define (object->pointer obj) (record-instance-slot obj 0))
 
+;; If an object has an owner, it's in the second slot.
+(define (object-owner obj) (record-instance-slot obj 1))
+
 ;; The type symbol of the given object as reported by Git, or #f.
 ;; Only valid for the Commit, Tree, Blob & Tag types.
 (define (object-type obj)
         ((reference? obj) (reference-name obj))
         (else (git-error '->reference-name "Not a valid reference" obj))))
 
-(define (pointer->object ptr)
+(define (pointer->object repo ptr)
   (case (git-object-type ptr)
-    ((blob)   (pointer->blob ptr))
-    ((commit) (pointer->commit ptr))
-    ((tag)    (pointer->tag ptr))
-    ((tree)   (pointer->tree ptr))
+    ((blob)   (pointer->blob repo ptr))
+    ((commit) (pointer->commit repo ptr))
+    ((tag)    (pointer->tag repo ptr))
+    ((tree)   (pointer->tree repo ptr))
     (else     (git-error 'pointer->object "Not a valid object pointer" ptr))))
 
-(define (merge-base r a b)
+(define (merge-base repo a b)
   (pointer->commit
+   repo
    (git-commit-lookup
-    (repository->pointer r)
+    (repository->pointer repo)
     (pointer->oid
      (git-merge-base
-      (repository->pointer r)
+      (repository->pointer repo)
       (oid->pointer a)
       (oid->pointer b))))))
 
 ;;; Signatures
 ;;;
 
-(define-git-record-type
-  (signature name email)
+(define-git-record-type signature
+  ((signature) name email)
   (format "#<signature \"~A <~A>\">" (signature-name signature) (signature-email signature))
   (git-signature-free))
 
 ;;; Repositories
 ;;;
 
-(define-git-record-type
-  (repository is-empty is-bare path workdir head-orphan head-detached)
+(define-git-record-type repository
+  ((repository) is-empty is-bare path workdir head-orphan head-detached)
   (format "#<repository ~S>" (repository-path repository))
   (git-repository-free))
 
 (define (repository-ref repo ref #!optional (type 'any))
   (condition-case
     (pointer->object
+     repo
      (git-object-lookup
       (repository->pointer repo)
       (->oid->pointer ref)
 (define (create-repository #!optional (path (current-directory)) bare)
   (pointer->repository (git-repository-init path bare)))
 
-(define object-owner (compose pointer->repository git-object-owner object->pointer))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Revspec
 
   (condition-case
     ;; Try a single revision first.
     (let ((revspec (git-revparse-single (repository->pointer repo) str)))
-      (values (pointer->object revspec) #f))
+      (values (pointer->object repo revspec) #f))
     ((git)
      (condition-case
        ;; If str didn't specify a single revision, try parsing it as a range.
        (let ((revspec (git-revparse (repository->pointer repo) str)))
-         (values (pointer->object (git-revspec-from revspec))
-                 (pointer->object (git-revspec-to revspec))))
+         (values (pointer->object repo (git-revspec-from revspec))
+                 (pointer->object repo (git-revspec-to revspec))))
        ((git)
         ;; Neither a single revision nor a range, return falses.
         ;; XXX Error here?
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; References
 
-(define-git-record-type
-  (reference type name delete)
+(define-git-record-type reference
+  ((reference repository) type name delete)
   (format "#<reference ~S>" (reference-name reference))
   (git-reference-free))
 
-(define repository-head   (compose pointer->reference git-repository-head repository->pointer))
-(define reference-resolve (compose pointer->reference git-reference-resolve reference->pointer))
+(define repository-head   (set-owner pointer->reference (compose git-repository-head repository->pointer)))
+(define reference-resolve (preserve-owner pointer->reference (compose git-reference-resolve reference->pointer)))
 
 (define reference-branch? (compose git-reference-is-branch reference->pointer))
 (define reference-remote? (compose git-reference-is-remote reference->pointer))
     (pointer->oid oid*)))
 
 (define (reference repo name)
-  (pointer->reference (git-reference-lookup (repository->pointer repo) name)))
+  (pointer->reference repo (git-reference-lookup (repository->pointer repo) name)))
 
 (define (references-fold kons knil repo #!optional (type 'all))
   (let ((state knil))
      (lambda (name)
        (set! state
          (kons (pointer->reference
+                repo
                 (git-reference-lookup
                  (repository->pointer repo)
                  name))
 (define (create-reference repo #!key name target symbolic force)
   (let ((repo* (repository->pointer repo)))
     (pointer->reference
+     repo
      (if (not symbolic)
          ;; Direct references are created by OID.
          (git-reference-create repo* name (->oid->pointer target) force)
    (->oid->pointer target)))
 
 (define (reference-rename ref name #!optional force)
-  (pointer->reference (git-reference-rename (reference->pointer ref) name force)))
+  (pointer->reference
+   (reference-repository ref)
+   (git-reference-rename (reference->pointer ref) name force)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Trees
 
-(define-git-record-type
-  (tree id entrycount)
+(define-git-record-type tree
+  ((tree repository) id entrycount)
   (format "#<tree ~S>" (oid->string (tree-id tree) 7))
   (git-tree-free))
 
-(define-git-record-type
-  (tree-entry id name type)
+(define-git-record-type tree-entry
+  ((tree-entry owner) id name type)
   (format "#<tree-entry ~S>" (tree-entry-name tree-entry))
   (git-tree-entry-free))
 
 (define (tree repo ref)
   (pointer->tree
+   repo
    (git-tree-lookup
     (repository->pointer repo)
     (->oid->pointer ref))))
 
 (define (tree-ref tree key)
   (pointer->tree-entry
+   tree
    (let ((tree* (tree->pointer tree)))
      ;; dup the resulting entry so it's under our control w.r.t. GC.
      (cond ((number? key)
            (else
             (git-error 'tree-ref "Invalid key" key))))))
 
-(define (tree-entry->object repo entry)
-  (pointer->object
-   (git-tree-entry-to-object
-    (repository->pointer repo)
-    (tree-entry->pointer entry))))
+(define tree-entry->object
+  (case-lambda
+    ((entry)
+     (let ((owner (tree-entry-owner entry)))
+       (if (tree? owner)
+           (tree-entry->object (tree-repository owner) entry)
+           (git-error 'tree-entry->object "Can't determine owning repository" entry))))
+    ((repo entry)
+     (pointer->object
+      repo
+      (git-tree-entry-to-object
+       (repository->pointer repo)
+       (tree-entry->pointer entry))))))
 
 (define (create-tree repo #!optional (index (index-open repo)))
   (pointer->tree
+   repo
    (git-tree-lookup
     (repository->pointer repo)
     (git-index-write-tree (index->pointer index)))))
      (tree->pointer tree)
      (lambda (path entry*)
        (set! state
-         (kons path (pointer->tree-entry (git-tree-entry-dup entry*)) state)))
+         (kons path (pointer->tree-entry tree (git-tree-entry-dup entry*)) state)))
      mode)
     state))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Tree Builders
 
-(define-git-record-type
-  (tree-builder clear)
+(define-git-record-type tree-builder
+  ((tree-builder) clear)
   "#<tree-builder>"
   (git-tree-builder-free))
 
 
 (define (tree-builder-ref tb path)
   (and-let* ((entry* (git-tree-builder-get (tree-builder->pointer tb) path)))
-    (pointer->tree-entry (tag-pointer (git-tree-entry-dup entry*) tb))))
+    (pointer->tree-entry tb (git-tree-entry-dup entry*))))
 
-(define (tree-builder-insert builder obj path attributes)
+(define (tree-builder-insert tb obj path attributes)
   (pointer->tree-entry
+   tb
    (git-tree-entry-dup
     (git-tree-builder-insert
-     (tree-builder->pointer builder)
+     (tree-builder->pointer tb)
      path
      (->oid->pointer obj)
      attributes))))
 
 (define (tree-builder-write repo tb)
   (pointer->tree
+   repo
    (git-tree-lookup
     (repository->pointer repo)
     (git-tree-builder-write
 ;; Branches
 
 (define (branch repo name #!optional (type 'all))
-  (pointer->reference (git-branch-lookup (repository->pointer repo) name type)))
+  (pointer->reference repo (git-branch-lookup (repository->pointer repo) name type)))
 
 ;; I'm changing branch-move to branch-rename here, perhaps gratuitously.
 ;; I'm just so sick of typing `git branch rename foo bar` and having
 ;; git whine at me, consider this payback.
 (define (branch-rename ref name #!optional force)
-  (pointer->reference (git-branch-move (reference->pointer ref) name force)))
+  (pointer->reference
+   (reference-repository ref)
+   (git-branch-move (reference->pointer ref) name force)))
 
 ;; XXX Returns a reference.
 (define (create-branch repo #!key name target force)
   (pointer->reference
+   repo
    (git-branch-create
     (repository->pointer repo)
     name
      (lambda (name type)
        (set! state
          (kons (pointer->reference
+                repo
                 (git-branch-lookup
                  (repository->pointer repo)
                  name
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Commits
 
-(define-git-record-type
-  (commit id message message-encoding time time-offset parentcount)
+(define-git-record-type commit
+  ((commit repository) id message message-encoding time time-offset parentcount)
   (format "#<commit ~S>" (oid->string (commit-id commit) 7))
   (git-commit-free))
 
-(define commit-tree      (compose pointer->tree git-commit-tree commit->pointer))
+(define commit-tree      (preserve-owner pointer->tree (compose git-commit-tree commit->pointer)))
 (define commit-tree-id   (compose pointer->oid git-oid-cpy git-commit-tree-id commit->pointer))
 (define commit-parent-id (compose pointer->oid git-oid-cpy git-commit-parent-id commit->pointer))
 (define commit-author    (compose pointer->signature git-signature-dup git-commit-author commit->pointer))
 
 (define (commit-parent cmt #!optional (n 0))
   (condition-case
-    (pointer->commit (git-commit-parent (commit->pointer cmt) n))
+    (pointer->commit
+     (commit-repository cmt)
+     (git-commit-parent (commit->pointer cmt) n))
     ((git) #f)))
 
-(define (commit-parents c)
-  (let ((n (commit-parentcount c)))
-    (let lp ((i 0)
-             (p '()))
-      (if (= i n)
-          (reverse p)
-          (lp (+ i 1)
-              (cons (commit-parent c i) p))))))
-
 (define (commit-ancestor cmt #!optional (n 1))
   (condition-case
-    (pointer->commit (git-commit-nth-gen-ancestor (commit->pointer cmt) n))
+    (pointer->commit
+     (commit-repository cmt)
+     (git-commit-nth-gen-ancestor (commit->pointer cmt) n))
     ((git) #f)))
 
+(define (commit-parents c)
+  (let ((n (commit-parentcount c)))
+    (do ((i 0 (+ i 1))
+         (p '() (cons (commit-parent c i) p)))
+        ((= i n)
+         (reverse p)))))
+
 (define (commit repo ref)
   (pointer->commit
+   repo
    (git-commit-lookup
     (repository->pointer repo)
     (->oid->pointer ref))))
          ((git) (k '())))
        (let loop ((state knil))
          (loop (kons (pointer->commit
+                      repo
                       (git-commit-lookup
                        repo*
                        (condition-case
 
 (define (create-commit repo #!key message author (committer author) (tree (create-tree repo)) (reference #f) (parents '()))
   (pointer->commit
+   repo
    (git-commit-lookup
     (repository->pointer repo)
     (git-commit-create
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Blobs
 
-(define-git-record-type
-  (blob id rawsize rawcontent is-binary)
+(define-git-record-type blob
+  ((blob repository) id rawsize rawcontent is-binary)
   (format "#<blob ~S>" (oid->string (blob-id blob) 7))
   (git-blob-free))
 
 
 (define (blob repo ref)
   (pointer->blob
+   repo
    (git-blob-lookup
     (repository->pointer repo)
     (->oid->pointer ref))))
 (define (create-blob repo source)
   (let ((repo* (repository->pointer repo)))
     (pointer->blob
+     repo
      (git-blob-lookup
       repo*
       (cond ((blob? source)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Index
 
-(define-git-record-type
-  (index entrycount read write clear)
+(define-git-record-type index
+  ((index) entrycount read write clear)
   "#<index>"
   (git-index-free))
 
-(define-git-record-type
-  (index-entry dev oid ino mode uid gid size stage flags extended path)
+(define-git-record-type index-entry
+  ((index-entry owner) dev oid ino mode uid gid size stage flags extended path)
   (format "#<index-entry ~S>" (index-entry-path index-entry)))
 
 (define index-entry-ctime (compose git-index-time-seconds git-index-entry-mtime index-entry->pointer))
   (git-index-remove (index->pointer ix) ref 0))
 
 (define (index-ref ix key)
-  (let ((ix* (index->pointer ix))
-        (tag (pointer-tagger ix)))
+  (let ((ix* (index->pointer ix)))
     (pointer->index-entry
+     ix
      (cond ((number? key)
-            (tag (git-index-get-byindex ix* key)))
+            (git-index-get-byindex ix* key))
            ((string? key)
-            (tag (git-index-get-bypath ix* key 0)))
+            (git-index-get-bypath ix* key 0))
            (else
             (git-error 'index-ref "Invalid key" key))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Notes
 
-(define-git-record-type
-  (note message oid)
+(define-git-record-type note
+  ((note repository) message oid)
   "#<note>"
   (git-note-free))
 
 (define (note repo object #!optional reference)
   (pointer->note
+   repo
    (git-note-read
     (repository->pointer repo)
     reference
      force)
     ;; ... Then retrieve it by reading it from the target object.
     (pointer->note
+     repo
      (git-note-read
       repo*
       reference
                reference
                (lambda (bid* oid*)
                  (set! state
-                   (kons (pointer->note (git-note-read repo* reference oid*)) state))))
+                   (kons (pointer->note repo (git-note-read repo* reference oid*)) state))))
               state))))))
 
 (define (notes repo #!optional reference)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ODB
 
-(define-git-record-type
-  (odb)
+(define-git-record-type odb
+  ((odb))
   "#<odb>"
   (git-odb-free))
 
-(define-git-record-type
-  (odb-object id size type)
+(define-git-record-type odb-object
+  ((odb-object owner) id size type)
   "#<odb-object>"
   (git-odb-object-free))
 
 
 (define (odb-read odb obj)
   (pointer->odb-object
+   odb
    (git-odb-read
     (odb->pointer odb)
     (->oid->pointer obj))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Tags
 
-(define-git-record-type
-  (tag id name message)
+(define-git-record-type tag
+  ((tag repository) id name message)
   (format "#<tag ~S>" (tag-name tag))
   (git-tag-free))
 
 (define (tag repo ref)
   (pointer->tag
+   repo
    (git-tag-lookup
     (repository->pointer repo)
     (->oid->pointer ref))))
      (lambda (name oid*)
        (set! state
          (kons (pointer->tag
+                repo
                 (git-tag-lookup
                  (repository->pointer repo)
                  oid*))
 (define (tags repo)
   (tags-fold cons '() repo))
 
-(define tag-peel   (compose pointer->object git-tag-peel tag->pointer))
-(define tag-target (compose pointer->object git-tag-target tag->pointer))
+(define tag-peel   (preserve-owner pointer->object (compose git-tag-peel tag->pointer)))
+(define tag-target (preserve-owner pointer->object (compose git-tag-target tag->pointer)))
 (define tag-tagger (compose pointer->signature git-signature-dup git-tag-tagger tag->pointer))
 
 (define (tag-delete tag)
 
 (define (create-tag repo #!key target name message tagger force)
   (pointer->tag
+   repo
    (git-tag-lookup
     (repository->pointer repo)
     (git-tag-create
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Diffs
 
-(define-git-record-type
-  (diff-file oid mode path size flags)
+(define-git-record-type diff-file
+  ((diff-file owner) oid mode path size flags)
   (format "#<diff-file ~S>" (diff-file-path diff-file)))
 
 ;; The `diff-delta` record type is renamed to just `diff`.
-(define-git-record-type
-  (diff-delta old-file new-file status similarity)
+(define-git-record-type diff-delta
+  ((diff-delta owner) old-file new-file status similarity)
   (format "#<diff ~S>" (diff-file-path (diff-new-file diff-delta))))
 
 (define diff?           diff-delta?)
 (define diff-status     diff-delta-status)
 (define diff-similarity diff-delta-similarity)
-(define diff-old-file   (compose pointer->diff-file diff-delta-old-file))
-(define diff-new-file   (compose pointer->diff-file diff-delta-new-file))
+(define diff-old-file   (set-owner pointer->diff-file diff-delta-old-file))
+(define diff-new-file   (set-owner pointer->diff-file diff-delta-new-file))
 
 (define (diff-path diff)
   (diff-file-path
 ;; Adds a refcount to the diff-list, to delay GC until all its
 ;; diff-deltas are unreachable.
 (define (build-diff-list diffs)
-  (let ((acc '())
-        (tag (pointer-tagger diffs)))
+  (let ((acc '()))
     (git-diff-foreach
      (lambda (delta* progress)
-       (set! acc (cons (pointer->diff-delta (tag delta*)) acc)))
+       (set! acc (cons (pointer->diff-delta diffs delta*) acc)))
      diffs)
     acc))
 
 ;;; Remotes
 ;;;
 
-(define-git-record-type
-  (remote name url pushurl connect connected disconnect update-tips update-fetchhead stop save)
+(define-git-record-type remote
+  ((remote repository) name url pushurl connect connected disconnect update-tips update-fetchhead stop save)
   (format "#<remote ~S (~a)>"
           (remote-name remote)
           (if (remote-connected? remote) "connected" "disconnected"))
   (git-remote-free))
 
-(define-git-record-type
-  (refspec src dst string direction force)
+(define-git-record-type refspec
+  ((refspec remote) src dst string direction force)
   (format "#<refspec ~S ~S>" (refspec-src refspec) (refspec-dst refspec)))
 
-(define-git-record-type
-  (transfer-progress total-objects indexed-objects received-objects received-bytes)
+(define-git-record-type transfer-progress
+  ((transfer-progress remote) total-objects indexed-objects received-objects received-bytes)
   "#<transfer-progress>")
 
 (define refspec-source refspec-src)
 (define remote-update-fetchhead-set! (git-record-attribute-setter git-remote-update-fetchhead))
 
 (define (remote-refspecs rem)
-  (let ((tag (compose pointer->refspec (pointer-tagger rem))))
-    (let lp ((i 0)
-             (a '()))
-      (cond ((git-remote-get-refspec (remote->pointer rem) i) =>
-             (lambda (refspec)
-               (lp (fx+ i 1)
-                   (cons (tag refspec) a))))
-            (else a)))))
+  (let lp ((i 0)
+           (a '()))
+    (cond ((git-remote-get-refspec (remote->pointer rem) i) =>
+           (lambda (refspec)
+             (lp (fx+ i 1)
+                 (cons (pointer->refspec rem refspec) a))))
+          (else a))))
 
 (define (remote repo name)
-  (pointer->remote (git-remote-load (repository->pointer repo) name)))
+  (pointer->remote repo (git-remote-load (repository->pointer repo) name)))
 
 (define (remotes repo)
   (map (lambda (name) (remote repo name))
 
 (define (remote-stats rem)
   (pointer->transfer-progress
-   (tag-pointer (git-remote-stats (remote->pointer rem)) rem)))
-
-(define (remote-download rem #!optional callback)
-  (if (remote-connected? rem)
-      (git-remote-download
-       (remote->pointer rem)
-       (and callback (compose callback pointer->transfer-progress)))
-      (dynamic-wind
-       (lambda ()
-         (remote-connect rem))
-       (lambda ()
-         (remote-download rem callback)
-         (remote-update-tips rem)
-         (remote-stats rem))
-       (lambda ()
-         (remote-disconnect rem)))))
+   rem
+   (git-remote-stats (remote->pointer rem))))
+
+(define remote-download
+  (let ((make-remote-download-callback
+         (lambda (rem fn)
+           (and fn (lambda (tp*)
+                     (fn (pointer->transfer-progress rem tp*)))))))
+    (lambda (rem #!optional fn)
+      (if (remote-connected? rem)
+          (git-remote-download
+           (remote->pointer rem)
+           (make-remote-download-callback rem fn))
+          (dynamic-wind
+           (lambda ()
+             (remote-connect rem))
+           (lambda ()
+             (remote-download rem (make-remote-download-callback rem fn))
+             (remote-update-tips rem)
+             (remote-stats rem))
+           (lambda ()
+             (remote-disconnect rem)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Configs
 
-(define-git-record-type
-  (config)
+(define-git-record-type config
+  ((config))
   "#<config>"
   (git-config-free))
 
-(define-git-record-type
-  (config-entry name value level)
+(define-git-record-type config-entry
+  ((config-entry) name value level)
   (format "#<config-entry ~S>" (config-entry-name config-entry)))
 
 (define (config-path #!optional (type 'user))

File tests/run.scm

            (test-assert "tree-builder-ref" (tree-builder-ref tb file))
            (test "tree-entry-name" file (tree-entry-name e))
            (test-assert "tree-entry-id" (oid? (tree-entry-id e)))
-           (test-assert "tree-entry->object" (blob? (tree-entry->object repo e)))
+           (test-assert "tree-entry->object (tree-builder, repo)" (blob? (tree-entry->object repo e)))
+           (test-error "tree-entry->object (tree-builder, no repo)" (tree-entry->object e))
            (test "tree-entry-type" 'blob (tree-entry-type e))))
        (drop-right files 1)
        (drop-right content 1))
            (test-assert "tree-entry?" (tree-entry? e))
            (test-assert "tree-entry-id" (oid? (tree-entry-id e)))
            (test "tree-entry-name" file (tree-entry-name e))
-           (test-assert "tree-entry->object" (blob? (tree-entry->object repo e)))
+           (test-assert "tree-entry->object (repo)" (blob? (tree-entry->object repo e)))
+           (test-assert "tree-entry->object (no repo)" (blob? (tree-entry->object e)))
            (test "tree-entry-type" 'blob (tree-entry-type e))))
        files
        content))))