From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:47023) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d6NP1-0005pN-EZ for guix-patches@gnu.org; Thu, 04 May 2017 16:31:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d6NOw-0004zX-Hl for guix-patches@gnu.org; Thu, 04 May 2017 16:31:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:56711) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d6NOw-0004zR-Dp for guix-patches@gnu.org; Thu, 04 May 2017 16:31:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d6NOw-0004gR-38 for guix-patches@gnu.org; Thu, 04 May 2017 16:31:02 -0400 Subject: bug#26645: [PATCH 6/9] gnu: Add find-package-binding. Resent-Message-ID: From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) References: <20170424205923.27726-1-wingo@igalia.com> <20170424205923.27726-6-wingo@igalia.com> Date: Thu, 04 May 2017 22:29:58 +0200 In-Reply-To: <20170424205923.27726-6-wingo@igalia.com> (Andy Wingo's message of "Mon, 24 Apr 2017 22:59:20 +0200") Message-ID: <87lgqc9xh5.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Andy Wingo Cc: 26645@debbugs.gnu.org Andy Wingo skribis: > * gnu/packages.scm (find-package-binding): New export. [...] > +(define (find-package-binding package) > + "Find the module that exports PACKAGE. Return two values, an interfac= e 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 s= ee if > + ;; we can use the package's location to find its module and look in th= at > + ;; module. > + (define (global-search) > + (let search ((modules (all-package-modules))) > + (match modules > + (() > + (raise (condition > + (&message (message > + (format #f (_ "~a@~a: 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) > + =3D> (lambda (loc) > + (cond > + ((file-name->module-name (location-file loc)) > + =3D> (lambda (module-name) > + (cond > + ((false-if-exception (resolve-interface module-name)) > + =3D> (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=E2=80=99s n= ot. WDYT? Otherwise LGTM, thanks! Ludo=E2=80=99.