From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id 0H0OK45AlmJXgAEAbAwnHQ (envelope-from ) for ; Tue, 31 May 2022 18:21:34 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id 2AUGK45AlmKvIAEA9RJhRA (envelope-from ) for ; Tue, 31 May 2022 18:21:34 +0200 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 13DCA35925 for ; Tue, 31 May 2022 18:21:34 +0200 (CEST) Received: from localhost ([::1]:44424 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nw4cf-0004R8-50 for larch@yhetil.org; Tue, 31 May 2022 12:21:33 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43054) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nw4RZ-0006Dm-8V for bug-guix@gnu.org; Tue, 31 May 2022 12:10:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54840) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nw4RY-0002cG-T1 for bug-guix@gnu.org; Tue, 31 May 2022 12:10:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nw4RY-0004P1-NA for bug-guix@gnu.org; Tue, 31 May 2022 12:10:04 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#55499: [PATCH 3/3] squash! profiles: Make all entry fields optional. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Tue, 31 May 2022 16:10:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55499 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 55499@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 55499-submit@debbugs.gnu.org id=B55499.165401339816881 (code B ref 55499); Tue, 31 May 2022 16:10:04 +0000 Received: (at 55499) by debbugs.gnu.org; 31 May 2022 16:09:58 +0000 Received: from localhost ([127.0.0.1]:48733 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nw4RS-0004O7-29 for submit@debbugs.gnu.org; Tue, 31 May 2022 12:09:58 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49682) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nw4RK-0004NC-LN for 55499@debbugs.gnu.org; Tue, 31 May 2022 12:09:53 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:41052) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nw4RF-0002NY-FF; Tue, 31 May 2022 12:09:45 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=zHG6lv3j3qj9u1jTW+jp2e4+mbnFpOAS0kjcgD0CEGQ=; b=UaVcu5gKsIltBrA/7R8n e8h5mpja5285xNhDnXfZV1SCL2/RSsvi86QsyHrhiKdMGXDmBR2jUzDCHTXQNFmcRVYJVQSemRqlI GyhW9VXTASgv8FzSarP9aFP7myRWZRYhxkml0e93B0BPvLAaKFNY1dpJSBBuxj/YijodTmxWoye5M DQWBNlh3I3N9NCIZ2Bon2liuzAVgIkkP18/rkdfD7ILi8YabbFpZ3GLNU/J4zO6w6aMo+R/e+ha4E KtackxtJoPqDxuhHohndHJ0Ik7gc1c2zXFeMLDDojPB6B2cIBbxmxZNedwdDSS81+CZqArBWUTe5a wxbNsYw9OOTufg==; Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=52502 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nw4RE-00067m-UZ; Tue, 31 May 2022 12:09:45 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 31 May 2022 18:09:16 +0200 Message-Id: <20220531160916.21508-4-ludo@gnu.org> X-Mailer: git-send-email 2.36.1 In-Reply-To: <20220531160916.21508-1-ludo@gnu.org> References: <87sfp7kkim.fsf@elephly.net> <20220531160916.21508-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1654014094; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: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:dkim-signature; bh=zHG6lv3j3qj9u1jTW+jp2e4+mbnFpOAS0kjcgD0CEGQ=; b=Gvr++dNyxQg6YBa/e+33NcNDhilSMoQ+Mv2dF+0L4SNQn7Gqh87remhaEIhDu+a78EDXSD WcxUN8ez3WyDqhoqWvJZXEXO8e8YG67EjDwwaeztwR8LxzCtzGAkRMp9t666m9nS91rV2u fo1vFszW2SzI8qQWT9E3ad7UxBSVLp4+gPWOaqjiYQeWahm3g3ZbM9S6u1zw4P89yzwEgU i0yxhAUWaTVcbol7P5MVVrT0UsOkQ27eQjrfpw+TGnx4GtrKxKXRoFvVnqDlsGMrvri/Ox /RxsLfDB0B/QyYkpDbTLIWPyk+9gMvI0vzBLBKnmV64UhrcTe//FVEA/vkVn0A== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1654014094; a=rsa-sha256; cv=none; b=M1dM652um3gkV9+8g05SpFOwH8U27D5bRiTy+mZ/qQFZnSO3xo6VoGX1hxTQSoGttPVYMy 2+jTXJQu9Sok4TXaJT706HtIBiuR140k7sl91Ur6CPM2j12oVCV8z5gTQTCmhaVl0iyRx/ XNvTBCaSqaOvm4JDYCh0ARahOYmQeeH6XFMmMkix1ospbMQXV9WYq0rJRqkHPLL/oy5FDQ Yf4OE0vdi81dqVhJuhYXkUyc7Gqz77pxia11VzNNndi28fT+heFrcjMXiOlF7Qkla6mNYE d09Ybxe9o4GBr1Tq0323TJz7d3ZPuf0uz6JLuxYbaZTNGgek0otccuhFGAhI5g== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=UaVcu5gK; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -3.24 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=UaVcu5gK; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 13DCA35925 X-Spam-Score: -3.24 X-Migadu-Scanner: scn0.migadu.com X-TUID: TvlIjfetsjJh This is meant to be squashed with the previous patch. This makes the 'search-paths' and 'propagated-inputs' fields of each entry optional, shaving a bit more space and reading time, down to 180K instead of 192K. * guix/build/profiles.scm (manifest-sexp->inputs+search-paths)[let-fields]: New macro. Use it. * guix/profiles.scm (manifest->gexp)[optional]: New procedure. Use it. [sexp->manifest-entry]: Rename to... [sexp->manifest-entry/v3]: ... this. --- guix/build/profiles.scm | 28 ++++++++-- guix/profiles.scm | 120 ++++++++++++++++++++++++++-------------- 2 files changed, 100 insertions(+), 48 deletions(-) diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index c4460f624b..2ab76bde74 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -149,6 +149,18 @@ (define (manifest-sexp->inputs+search-paths manifest) "Parse MANIFEST, an sexp as produced by 'manifest->gexp', and return two values: the list of store items of its manifest entries, and the list of search path specifications." + (define-syntax let-fields + (syntax-rules () + ;; Bind the fields NAME of LST to same-named variables in the lexical + ;; scope of BODY. + ((_ lst (name rest ...) body ...) + (let ((name (match (assq 'name lst) + ((_ value) value) + (#f '())))) + (let-fields lst (rest ...) body ...))) + ((_ lst () body ...) + (begin body ...)))) + (match manifest ;this must match 'manifest->gexp' (('manifest ('version 4) ('packages (entries ...))) @@ -156,12 +168,12 @@ (define (manifest-sexp->inputs+search-paths manifest) (inputs '()) (search-paths '())) (match entries - (((name version output item - ('propagated-inputs deps) - ('search-paths paths) _ ...) . rest) - (loop (append rest deps) ;breadth-first traversal - (cons item inputs) - (append paths search-paths))) + (((name version output item fields ...) . rest) + (let ((paths search-paths)) + (let-fields fields (propagated-inputs search-paths properties) + (loop (append rest propagated-inputs) ;breadth-first traversal + (cons item inputs) + (append search-paths paths))))) ((('repeated name version item) . rest) (loop rest inputs search-paths)) (() @@ -214,4 +226,8 @@ (define manifest-file ;; Write 'OUTPUT/etc/profile'. (build-etc/profile output search-paths))) +;;; Local Variables: +;;; eval: (put 'let-fields 'scheme-indent-function 2) +;;; End: + ;;; profile.scm ends here diff --git a/guix/profiles.scm b/guix/profiles.scm index 44ff37e75b..d694ac07da 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -454,6 +454,11 @@ (define (inferior->entry) (define (manifest->gexp manifest) "Return a representation of MANIFEST as a gexp." + (define (optional name value) + (if (null? value) + #~() + #~((#$name #$value)))) + (define (entry->gexp entry) ;; Maintain in state monad a vhash of visited entries, indexed by their ;; item, usually package objects (we cannot use the entry itself as an @@ -477,24 +482,22 @@ (define (entry->gexp entry) (return (match entry (($ name version output (? string? path) - (_deps ...) (search-paths ...) _ (properties ...)) + (_ ...) (search-paths ...) _ (properties ...)) #~(#$name #$version #$output #$path - (propagated-inputs #$deps) - (search-paths #$(map search-path-specification->sexp - search-paths)) - #$@(if (null? properties) - #~() - #~((properties . #$properties))))) + #$@(optional 'propagated-inputs deps) + #$@(optional 'search-paths + (map search-path-specification->sexp + search-paths)) + #$@(optional 'properties properties))) (($ name version output package (_deps ...) (search-paths ...) _ (properties ...)) #~(#$name #$version #$output (ungexp package (or output "out")) - (propagated-inputs #$deps) - (search-paths #$(map search-path-specification->sexp - search-paths)) - #$@(if (null? properties) - #~() - #~((properties . #$properties)))))))))))) + #$@(optional 'propagated-inputs deps) + #$@(optional 'search-paths + (map search-path-specification->sexp + search-paths)) + #$@(optional 'properties properties)))))))))) (match manifest (($ (entries ...)) @@ -542,6 +545,40 @@ (define (infer-dependency item parent) (item item) (parent parent)))) + (define* (sexp->manifest-entry/v3 sexp #:optional (parent (delay #f))) + (match sexp + ((name version output path + ('propagated-inputs deps) + ('search-paths search-paths) + extra-stuff ...) + ;; For each of DEPS, keep a promise pointing to ENTRY. + (letrec* ((deps* (map (cut sexp->manifest-entry/v3 <> (delay entry)) + deps)) + (entry (manifest-entry + (name name) + (version version) + (output output) + (item path) + (dependencies deps*) + (search-paths (map sexp->search-path-specification + search-paths)) + (parent parent) + (properties (or (assoc-ref extra-stuff 'properties) + '()))))) + entry)))) + + (define-syntax let-fields + (syntax-rules () + ;; Bind the fields NAME of LST to same-named variables in the lexical + ;; scope of BODY. + ((_ lst (name rest ...) body ...) + (let ((name (match (assq 'name lst) + ((_ value) value) + (#f '())))) + (let-fields lst (rest ...) body ...))) + ((_ lst () body ...) + (begin body ...)))) + (define* (sexp->manifest-entry sexp #:optional (parent (delay #f))) (match sexp (('repeated name version path) @@ -556,32 +593,29 @@ (define* (sexp->manifest-entry sexp #:optional (parent (delay #f))) sexp))) ((_ . entry) (return entry))))) - ((name version output path - ('propagated-inputs deps) - ('search-paths search-paths) - extra-stuff ...) - (mlet* %state-monad - ((entry -> #f) - (deps* (mapm %state-monad - (cut sexp->manifest-entry <> (delay entry)) - deps)) - (visited (current-state)) - (key -> (list name version path))) - (set! entry ;XXX: emulate 'letrec*' - (manifest-entry - (name name) - (version version) - (output output) - (item path) - (dependencies deps*) - (search-paths (map sexp->search-path-specification - search-paths)) - (parent parent) - (properties (or (assoc-ref extra-stuff 'properties) - '())))) - (mbegin %state-monad - (set-current-state (vhash-cons key entry visited)) - (return entry)))))) + ((name version output path fields ...) + (let-fields fields (propagated-inputs search-paths properties) + (mlet* %state-monad + ((entry -> #f) + (deps (mapm %state-monad + (cut sexp->manifest-entry <> (delay entry)) + propagated-inputs)) + (visited (current-state)) + (key -> (list name version path))) + (set! entry ;XXX: emulate 'letrec*' + (manifest-entry + (name name) + (version version) + (output output) + (item path) + (dependencies deps) + (search-paths (map sexp->search-path-specification + search-paths)) + (parent parent) + (properties properties))) + (mbegin %state-monad + (set-current-state (vhash-cons key entry visited)) + (return entry))))))) (match sexp (('manifest ('version 0) @@ -649,9 +683,7 @@ (define* (sexp->manifest-entry sexp #:optional (parent (delay #f))) ;; Version 3 represents DEPS as full-blown manifest entries. (('manifest ('version 3 minor-version ...) ('packages (entries ...))) - (manifest (run-with-state - (mapm %state-monad sexp->manifest-entry entries) - vlist-null))) + (manifest (map sexp->manifest-entry/v3 entries))) ;; Version 4 deduplicates repeated entries, as can happen with deep ;; propagated input trees. @@ -2368,4 +2400,8 @@ (define (user-friendly-profile profile) %known-shorthand-profiles) profile)) +;;; Local Variables: +;;; eval: (put 'let-fields 'scheme-indent-function 2) +;;; End: + ;;; profiles.scm ends here -- 2.36.1