[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#26645: [PATCH 6/9] gnu: Add find-package-binding.
From: |
Ludovic Courtès |
Subject: |
bug#26645: [PATCH 6/9] gnu: Add find-package-binding. |
Date: |
Thu, 04 May 2017 22:29:58 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) |
Andy Wingo <address@hidden> skribis:
> * gnu/packages.scm (find-package-binding): New export.
[...]
> +(define (find-package-binding package)
> + "Find the module that exports PACKAGE. Return two values, an interface
> name
> +and a symbol that can be used to import PACKAGE. Signal an error if no
> public variable binds PACKAGE."
> + (define (strip-extension file exts)
> + (or (or-map (lambda (ext)
> + (and (string-suffix? ext file)
> + (substring file 0 (- (string-length file)
> + (string-length ext)))))
> + exts)
> + file))
> + (define (file-name->module-name file)
> + (and (not (absolute-file-name? file))
> + (map string->symbol
> + (string-split (strip-extension file %load-extensions)
> + #\/))))
> + ;; Instead of building a table and always doing a search, first just see if
> + ;; we can use the package's location to find its module and look in that
> + ;; module.
> + (define (global-search)
> + (let search ((modules (all-package-modules)))
> + (match modules
> + (()
> + (raise (condition
> + (&message (message
> + (format #f (_ "address@hidden: binding not
> found")
> + (package-name package)
> + (package-version package)))))))
> + ((mod . modules)
> + (let ((next (lambda () (search modules))))
> + (local-search (module-name mod) mod next))))))
> + (define (local-search module-name iface k)
> + (let lp ((bindings (module-map cons iface)))
> + (match bindings
> + (() (k))
> + (((sym . var) . bindings)
> + (if (eq? (variable-ref var) package)
> + (values module-name sym)
> + (lp bindings))))))
> + (cond
> + ((package-location package)
> + => (lambda (loc)
> + (cond
> + ((file-name->module-name (location-file loc))
> + => (lambda (module-name)
> + (cond
> + ((false-if-exception (resolve-interface module-name))
> + => (lambda (iface)
> + (let ((def (string->symbol (package-name package))))
> + (cond
> + ((and (module-variable iface def)
> + (eq? (module-ref iface def) package))
> + (values module-name def))
> + (else
> + (local-search module-name iface
> global-search))))))
> + (else (global-search)))))
> + (else (global-search)))))
> + (else (global-search))))
I think it would be enough to assume that (package-location package) is
always valid (which is the case by default), and bail out if it’s not.
WDYT?
Otherwise LGTM, thanks!
Ludo’.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- bug#26645: [PATCH 6/9] gnu: Add find-package-binding.,
Ludovic Courtès <=