From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id IPLiN0m9N2E8eAAAgWs5BA (envelope-from ) for ; Tue, 07 Sep 2021 21:28:09 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id qI2RM0m9N2F7CQAAbx9fmQ (envelope-from ) for ; Tue, 07 Sep 2021 19:28:09 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 7DEC2118B5 for ; Tue, 7 Sep 2021 21:28:09 +0200 (CEST) Received: from localhost ([::1]:50252 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mNglM-0006Ix-LO for larch@yhetil.org; Tue, 07 Sep 2021 15:28:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37488) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mNglG-0006F5-QS for guix-patches@gnu.org; Tue, 07 Sep 2021 15:28:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46275) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mNglG-0005yc-JO for guix-patches@gnu.org; Tue, 07 Sep 2021 15:28:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mNglG-0005kB-Ah for guix-patches@gnu.org; Tue, 07 Sep 2021 15:28:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 07 Sep 2021 19:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50286 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Maxime Devos Cc: iskarian@mgsn.dev, 50286@debbugs.gnu.org Received: via spool by 50286-submit@debbugs.gnu.org id=B50286.163104286922043 (code B ref 50286); Tue, 07 Sep 2021 19:28:02 +0000 Received: (at 50286) by debbugs.gnu.org; 7 Sep 2021 19:27:49 +0000 Received: from localhost ([127.0.0.1]:57818 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mNgl2-0005jQ-8v for submit@debbugs.gnu.org; Tue, 07 Sep 2021 15:27:48 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49516) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mNgkz-0005jD-SO for 50286@debbugs.gnu.org; Tue, 07 Sep 2021 15:27:46 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34516) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mNgks-0005kZ-Dm; Tue, 07 Sep 2021 15:27:38 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=35382 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mNgks-000173-5Y; Tue, 07 Sep 2021 15:27:38 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= References: <0b61652d751633f78e876a27be88ed14e47527b6.camel@telenet.be> <87o89681br.fsf@gnu.org> Date: Tue, 07 Sep 2021 21:27:35 +0200 In-Reply-To: <87o89681br.fsf@gnu.org> ("Ludovic =?UTF-8?Q?Court=C3=A8s?="'s message of "Mon, 06 Sep 2021 12:07:04 +0200") Message-ID: <875yvc4254.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1631042889; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:resent-cc:resent-from:resent-sender: resent-message-id:in-reply-to:in-reply-to:references:references: list-id:list-help:list-unsubscribe:list-subscribe:list-post; bh=1BfXYTffxfEM6jPxHGxgpwk9viYxrk054QnJZJQsuDw=; b=NNHH8nqrU4WYYnPE5GiCZdSyr8gDCuHyeehg/Tk8Vn5QnRDQEkLXR0ZNN9JCoE+EYHTdXD RCOJAnwp3yerAJ+K1LOUj6ruwnGhxjN1yq/nJpJcrVNKO1KNEIa0K3t2XR9hkntgqcJw0n Cl/8Xxz86YOQMaXlrvX9JiftKvFV4PBIEcarRXxO/UNauLcqvp/V9JuHXUJSmafLSwc4wU L3+Qjk7liqWu/E2amo0OCrdJQpCZB0y+ix+mLQ9Z/14+/H8wt2ZuMDZqOfkd/v9apeomfF gv5K8UzNez0+bE1NkJeape/vOP8JAZNKOTMNR2qvKWQPJFzGDweMBEgeI6Om5w== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1631042889; a=rsa-sha256; cv=none; b=HlY6ZO6JaiP8FboK+a+MbZ5BQYT4p265loKHenogJnfIzzAbba7ZgoByE/C/o1fkgXt+ub vA8od/GoVAodTkgcsKmkbGX39WBREWDNs5+nJcX1tyjQ2Huv7YLKjlXqH5ee/9Ob8Lydp4 75nl851+wWaaWMI7ci3tL626czbm62+PjSwPJudphGuOKc5WAR1vvdSu+/tOureGpoKXV0 1gXt8LHsv6JfZDiQ8jFJBC8FhUPmX5hAOcXnMUqsvVIA8dXzzL25UVJK6GtT5+r0m+BWm9 xcUj73mSSoir8XM+yvsjv/EY01/JZqJFHbdA1xHwWVQMy5CsYNALTMjrVvLTnA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -1.41 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 7DEC2118B5 X-Spam-Score: -1.41 X-Migadu-Scanner: scn0.migadu.com X-TUID: obLLKSqAJBeQ --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Maxime & Sarah, Ludovic Court=C3=A8s skribis: > Hmm, thinking out loud, what about this: use the same trick as you did, > but replace =E2=80=98define-public=E2=80=99 instead of =E2=80=98let=E2=80= =99 & co., so as to be less > intrusive. > > (define-syntax-parameter current-definition-location > (identifier-syntax #f)) > > (define-syntax define-public* > (syntax-rules () > ((_ prototype body) > (define-public prototype > (syntax-parameterize ((current-definition-location > (identifier-syntax (current-source-locati= on)))) > body))))) > > Since there=E2=80=99s code that assumes =E2=80=98package-location=E2=80= =99 returns the location > of the (package =E2=80=A6) sexp, we could add a =E2=80=98definition-locat= ion=E2=80=99 field in > , defaulting to =E2=80=98current-definition-location=E2=80=99, o= r tweak > =E2=80=98location=E2=80=99 to include both. Below is an attempt at doing this. As discussed on IRC, the first patch switches the =E2=80=98location=E2=80=99 field to a more compact format that= may reduce load time by a tiny bit, though it=E2=80=99s hard to measure. The second p= atch introduces an extra field for the definition location; that means that records now occupy an extra word, which is not great, but unfortunately OTOH location is slightly smaller. Example: --8<---------------cut here---------------start------------->8--- scheme@(guile-user)> ,use(gnu packages base) scheme@(guile-user)> ,use(gnu packages accessibility) scheme@(guile-user)> ,use(guix) scheme@(guile-user)> (package-location footswitch) $1 =3D #< file: "gnu/packages/accessibility.scm" line: 257 column= : 4> scheme@(guile-user)> (package-definition-location footswitch) $2 =3D #< file: "gnu/packages/accessibility.scm" line: 254 column= : 0> scheme@(guile-user)> (package-location hello) $3 =3D #< file: "gnu/packages/base.scm" line: 79 column: 2> scheme@(guile-user)> (package-definition-location hello) $4 =3D #< file: "gnu/packages/base.scm" line: 78 column: 0> --8<---------------cut here---------------end--------------->8--- Thoughts? Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-packages-Store-location-field-as-a-literal-vector.patch Content-Description: the patch >From 758ca5c95b97f3fd2b08a2828e21c45a86393d59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 7 Sep 2021 18:04:21 +0200 Subject: [PATCH 1/2] packages: Store 'location' field as a literal vector. This is slightly more efficient than storing an alist in terms of .go file size (< 1% smaller) and load time. * guix/packages.scm (current-location-vector): New macro. (sanitize-location): New procedure. ()[location]: Change 'default' and add 'sanitize'. (package-location): New procedure. --- guix/packages.scm | 38 ++++++++++++++++++++++++++++++++++---- 1 file changed, 34 insertions(+), 4 deletions(-) diff --git a/guix/packages.scm b/guix/packages.scm index c825f427d8..01de50ebd7 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -360,6 +360,30 @@ name of its URI." ;; . (fold delete %supported-systems '("mips64el-linux"))) +(define-syntax current-location-vector + (lambda (s) + "Like 'current-source-location' but expand to a literal vector with +one-indexed line numbers." + ;; Storing a literal vector in .go files is more efficient than storing an + ;; alist: less initialization code, fewer relocations, etc. + (syntax-case s () + ((_) + (match (syntax-source s) + (#f #f) + (properties + (let ((file (assq-ref properties 'filename)) + (line (assq-ref properties 'line)) + (column (assq-ref properties 'column))) + (and file line column + #`#(#,file #,(+ 1 line) #,column))))))))) + +(define-inlinable (sanitize-location loc) + ;; Convert LOC to a vector or to #f. + (cond ((vector? loc) loc) + ((not loc) loc) + (else (vector (location-file loc) + (location-line loc) + (location-column loc))))) ;; A package. (define-record-type* @@ -404,10 +428,9 @@ name of its URI." (properties package-properties (default '())) ; alist for anything else - (location package-location - (default (and=> (current-source-location) - source-properties->location)) - (innate))) + (location package-location-vector + (default (current-location-vector)) + (innate) (sanitize sanitize-location))) (set-record-type-printer! (lambda (package port) @@ -425,6 +448,13 @@ name of its URI." package) 16))))) +(define (package-location package) + "Return the source code location of PACKAGE as a record, or #f if +it is not known." + (match (package-location-vector package) + (#f #f) + (#(file line column) (location file line column)))) + (define-syntax-rule (package/inherit p overrides ...) "Like (package (inherit P) OVERRIDES ...), except that the same transformation is done to the package P's replacement, if any. P must be a bare -- 2.33.0 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-packages-Add-package-definition-location.patch Content-Description: the second one >From bc2d7144bb9ef0ea74f9ef5922d568291818de32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 7 Sep 2021 21:19:11 +0200 Subject: [PATCH 2/2] packages: Add 'package-definition-location'. Suggested by Maxime Devos . * guix/packages.scm (current-definition-location-vector): New syntax parameter. (define-public*): New macro. ()[definition-location]: New field. (package-definition-location): New procedure. * tests/packages.scm ("package-definition-location"): New test. --- guix/packages.scm | 42 +++++++++++++++++++++++++++++++++++++++++- tests/packages.scm | 11 +++++++++++ 2 files changed, 52 insertions(+), 1 deletion(-) diff --git a/guix/packages.scm b/guix/packages.scm index 01de50ebd7..2f70ec9c64 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -52,6 +52,7 @@ #:re-export (%current-system %current-target-system search-path-specification) ;for convenience + #:replace ((define-public* . define-public)) #:export (content-hash content-hash? content-hash-algorithm @@ -99,6 +100,7 @@ package-supported-systems package-properties package-location + package-definition-location hidden-package hidden-package? package-superseded @@ -385,6 +387,31 @@ one-indexed line numbers." (location-line loc) (location-column loc))))) +(define-syntax-parameter current-definition-location-vector + ;; Location of the encompassing 'define-public'. + (const #f)) + +(define-syntax define-public* + (lambda (s) + "Like 'define-public' but set 'current-definition-location' for the +lexical scope of its body." + (define location + (match (syntax-source s) + (#f #f) + (properties + (let ((line (assq-ref properties 'line)) + (column (assq-ref properties 'column))) + ;; Don't repeat the file name since it's redundant with 'location'. + (and line column + #`#(#,(+ 1 line) #,column)))))) + + (syntax-case s () + ((_ prototype body ...) + #`(define-public prototype + (syntax-parameterize ((current-definition-location-vector + (lambda (s) #,location))) + body ...)))))) + ;; A package. (define-record-type* package make-package @@ -430,7 +457,10 @@ one-indexed line numbers." (location package-location-vector (default (current-location-vector)) - (innate) (sanitize sanitize-location))) + (innate) (sanitize sanitize-location)) + (definition-location package-definition-location-vector + (default (current-definition-location-vector)) + (innate))) (set-record-type-printer! (lambda (package port) @@ -455,6 +485,16 @@ it is not known." (#f #f) (#(file line column) (location file line column)))) +(define (package-definition-location package) + "Like 'package-location', but return the location of the definition +itself--i.e., that of the enclosing 'define-public' form, if any, or #f." + (match (package-definition-location-vector package) + (#f #f) + (#(line column) + (match (package-location-vector package) + (#f #f) + (#(file _ _) (location file line column)))))) + (define-syntax-rule (package/inherit p overrides ...) "Like (package (inherit P) OVERRIDES ...), except that the same transformation is done to the package P's replacement, if any. P must be a bare diff --git a/tests/packages.scm b/tests/packages.scm index 2a290bc353..3756877270 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -236,6 +236,17 @@ (eq? item new))) (null? (manifest-transaction-remove tx))))))) +(test-assert "package-definition-location" + (let ((location (package-location hello)) + (definition (package-definition-location hello))) + ;; Check for the usual layout of (define-public hello (package ...)). + (and (string=? (location-file location) + (location-file definition)) + (= 0 (location-column definition)) + (= 2 (location-column location)) + (= (location-line definition) + (- (location-line location) 1))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- 2.33.0 --=-=-=--