guix build: Move transformation options to (guix transformations).

* guix/transformations.scm: New file.
* tests/scripts-build.scm: Rename to...
* tests/transformations.scm: ... this.
* Makefile.am (MODULES): Add 'guix/transformations.scm'.
(SCM_TESTS): Adjust to rename.
* guix/scripts/build.scm (numeric-extension?)
(tarball-base-name, <downloaded-file>, download-to-store*)
(compile-downloaded-file, package-with-source)
(transform-package-source, evaluate-replacement-specs)
(transform-package-inputs, transform-package-inputs/graft)
(%not-equal, package-git-url, evaluate-git-replacement-specs)
(transform-package-source-branch, transform-package-source-commit)
(transform-package-source-git-url, package-dependents/spec)
(package-toolchain-rewriting, transform-package-toolchain)
(transform-package-with-debug-info, transform-package-tests)
(%transformations, transformation-procedure, %transformation-options)
(show-transformation-options-help, options->transformation)
(package-transformations): Move to (guix transformations).
* guix/scripts/environment.scm: Adjust accordingly.
* guix/scripts/graph.scm: Likewise.
* guix/scripts/install.scm: Likewise.
* guix/scripts/pack.scm: Likewise.
* guix/scripts/package.scm: Likewise.
* guix/scripts/upgrade.scm: Likewise.
* po/guix/POTFILES.in: Add 'guix/transformations.scm'.

11 files changed, 625 insertions, 558 deletions

diff --git a/Makefile.am b/Makefile.am
index f3eb681a2b..e7053ee4f4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -105,6 +105,7 @@ MODULES =					\
   guix/derivations.scm				\
   guix/grafts.scm				\
   guix/repl.scm					\
+  guix/transformations.scm			\
   guix/inferior.scm				\
   guix/describe.scm				\
   guix/quirks.scm				\
@@ -456,7 +457,6 @@ SCM_TESTS =					\
   tests/pypi.scm				\
   tests/records.scm				\
   tests/scripts.scm				\
-  tests/scripts-build.scm			\
   tests/search-paths.scm			\
   tests/services.scm				\
   tests/services/linux.scm			\
@@ -473,6 +473,7 @@ SCM_TESTS =					\
   tests/syscalls.scm				\
   tests/system.scm				\
   tests/texlive.scm				\
+  tests/transformations.scm			\
   tests/ui.scm					\
   tests/union.scm				\
   tests/upstream.scm				\
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 4b86047587..e9de97c881 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -31,11 +31,6 @@
 
   #:use-module (guix utils)
 
-  ;; Use the procedure that destructures "NAME-VERSION" forms.
-  #:use-module ((guix build utils)
-                #:select ((package-name->name+version
-                           . hyphen-package-name->name+version)))
-
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix profiles)
@@ -52,21 +47,15 @@
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
-  #:autoload   (guix download) (download-to-store)
-  #:autoload   (guix git-download) (git-reference? git-reference-url)
-  #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module ((guix progress) #:select (current-terminal-columns))
   #:use-module ((guix build syscalls) #:select (terminal-columns))
+  #:use-module (guix transformations)
   #:export (%standard-build-options
             set-build-options-from-command-line
             set-build-options-from-command-line*
             show-build-options-help
 
-            %transformation-options
-            options->transformation
-            manifest-entry-with-transformations
-
             guix-build
             register-root
             register-root*))
@@ -151,546 +140,6 @@ found.  Return #f if no build log was found."
 (define register-root*
   (store-lift register-root))
 
-(define (numeric-extension? file-name)
-  "Return true if FILE-NAME ends with digits."
-  (string-every char-set:hex-digit (file-extension file-name)))
-
-(define (tarball-base-name file-name)
-  "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar
-extensions."
-  ;; TODO: Factorize.
-  (cond ((not (file-extension file-name))
-         file-name)
-        ((numeric-extension? file-name)
-         file-name)
-        ((string=? (file-extension file-name) "tar")
-         (file-sans-extension file-name))
-        ((file-extension file-name)
-         =>
-         (match-lambda
-           ("scm" file-name)
-           (else  (tarball-base-name (file-sans-extension file-name)))))
-        (else
-         file-name)))
-
-
-;; Files to be downloaded.
-(define-record-type <downloaded-file>
-  (downloaded-file uri recursive?)
-  downloaded-file?
-  (uri        downloaded-file-uri)
-  (recursive? downloaded-file-recursive?))
-
-(define download-to-store*
-  (store-lift download-to-store))
-
-(define-gexp-compiler (compile-downloaded-file (file <downloaded-file>)
-                                               system target)
-  "Download FILE and return the result as a store item."
-  (match file
-    (($ <downloaded-file> uri recursive?)
-     (download-to-store* uri #:recursive? recursive?))))
-
-(define* (package-with-source p uri #:optional version)
-  "Return a package based on P but with its source taken from URI.  Extract
-the new package's version number from URI."
-  (let ((base (tarball-base-name (basename uri))))
-    (let-values (((_ version*)
-                  (hyphen-package-name->name+version base)))
-      (package (inherit p)
-               (version (or version version*
-                            (package-version p)))
-
-               ;; Use #:recursive? #t to allow for directories.
-               (source (downloaded-file uri #t))))))
-
-
-;;;
-;;; Transformations.
-;;;
-
-(define (transform-package-source sources)
-  "Return a transformation procedure that replaces package sources with the
-matching URIs given in SOURCES."
-  (define new-sources
-    (map (lambda (uri)
-           (match (string-index uri #\=)
-             (#f
-              ;; Determine the package name and version from URI.
-              (call-with-values
-                  (lambda ()
-                    (hyphen-package-name->name+version
-                     (tarball-base-name (basename uri))))
-                (lambda (name version)
-                  (list name version uri))))
-             (index
-              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
-              (call-with-values
-                  (lambda ()
-                    (package-name->name+version (string-take uri index)))
-                (lambda (name version)
-                  (list name version
-                        (string-drop uri (+ 1 index))))))))
-         sources))
-
-  (lambda (obj)
-    (let loop ((sources  new-sources)
-               (result   '()))
-      (match obj
-        ((? package? p)
-         (match (assoc-ref sources (package-name p))
-           ((version source)
-            (package-with-source p source version))
-           (#f
-            p)))
-        (_
-         obj)))))
-
-(define (evaluate-replacement-specs specs proc)
-  "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
-of package spec/procedure pairs as expected by 'package-input-rewriting/spec'.
-PROC is called with the package to be replaced and its replacement according
-to SPECS.  Raise an error if an element of SPECS uses invalid syntax, or if a
-package it refers to could not be found."
-  (define not-equal
-    (char-set-complement (char-set #\=)))
-
-  (map (lambda (spec)
-         (match (string-tokenize spec not-equal)
-           ((spec new)
-            (cons spec
-                  (let ((new (specification->package new)))
-                    (lambda (old)
-                      (proc old new)))))
-           (x
-            (leave (G_ "invalid replacement specification: ~s~%") spec))))
-       specs))
-
-(define (transform-package-inputs replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile=guile@2.1\" meaning that, any dependency on a package
-called \"guile\" must be replaced with a dependency on a version 2.1 of
-\"guile\"."
-  (let* ((replacements (evaluate-replacement-specs replacement-specs
-                                                   (lambda (old new)
-                                                     new)))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-inputs/graft replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
-current 'gnutls' package, after which version 3.5.4 is grafted onto them."
-  (define (set-replacement old new)
-    (package (inherit old) (replacement new)))
-
-  (let* ((replacements (evaluate-replacement-specs replacement-specs
-                                                   set-replacement))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define %not-equal
-  (char-set-complement (char-set #\=)))
-
-(define (package-git-url package)
-  "Return the URL of the Git repository for package, or raise an error if
-the source of PACKAGE is not fetched from a Git repository."
-  (let ((source (package-source package)))
-    (cond ((and (origin? source)
-                (git-reference? (origin-uri source)))
-           (git-reference-url (origin-uri source)))
-          ((git-checkout? source)
-           (git-checkout-url source))
-          (else
-           (leave (G_ "the source of ~a is not a Git reference~%")
-                  (package-full-name package))))))
-
-(define (evaluate-git-replacement-specs specs proc)
-  "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
-of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
-replacement package.  Raise an error if an element of SPECS uses invalid
-syntax, or if a package it refers to could not be found."
-  (map (lambda (spec)
-         (match (string-tokenize spec %not-equal)
-           ((spec branch-or-commit)
-            (define (replace old)
-              (let* ((source (package-source old))
-                     (url    (package-git-url old)))
-                (proc old url branch-or-commit)))
-
-            (cons spec replace))
-           (x
-            (leave (G_ "invalid replacement specification: ~s~%") spec))))
-       specs))
-
-(define (transform-package-source-branch replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile-next=stable-3.0\" meaning that packages are built using
-'guile-next' from the latest commit on its 'stable-3.0' branch."
-  (define (replace old url branch)
-    (package
-      (inherit old)
-      (version (string-append "git." (string-map (match-lambda
-                                                   (#\/ #\-)
-                                                   (chr chr))
-                                                 branch)))
-      (source (git-checkout (url url) (branch branch)
-                            (recursive? #t)))))
-
-  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
-                                                       replace))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-source-commit replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile-next=cabba9e\" meaning that packages are built using
-'guile-next' from commit 'cabba9e'."
-  (define (replace old url commit)
-    (package
-      (inherit old)
-      (version (if (and (> (string-length commit) 1)
-                        (string-prefix? "v" commit)
-                        (char-set-contains? char-set:digit
-                                            (string-ref commit 1)))
-                   (string-drop commit 1)        ;looks like a tag like "v1.0"
-                   (string-append "git."
-                                  (if (< (string-length commit) 7)
-                                      commit
-                                      (string-take commit 7)))))
-      (source (git-checkout (url url) (commit commit)
-                            (recursive? #t)))))
-
-  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
-                                                       replace))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-source-git-url replacement-specs)
-  "Return a procedure that, when passed a package, replaces its dependencies
-according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of strings like
-\"guile-json=https://gitthing.com/…\" meaning that packages are built using
-a checkout of the Git repository at the given URL."
-  (define replacements
-    (map (lambda (spec)
-           (match (string-tokenize spec %not-equal)
-             ((spec url)
-              (cons spec
-                    (lambda (old)
-                      (package
-                        (inherit old)
-                        (source (git-checkout (url url)
-                                              (recursive? #t)))))))
-             (_
-              (leave (G_ "~a: invalid Git URL replacement specification~%")
-                     spec))))
-         replacement-specs))
-
-  (define rewrite
-    (package-input-rewriting/spec replacements))
-
-  (lambda (obj)
-    (if (package? obj)
-        (rewrite obj)
-        obj)))
-
-(define (package-dependents/spec top bottom)
-  "Return the list of dependents of BOTTOM, a spec string, that are also
-dependencies of TOP, a package."
-  (define-values (name version)
-    (package-name->name+version bottom))
-
-  (define dependent?
-    (mlambda (p)
-      (and (package? p)
-           (or (and (string=? name (package-name p))
-                    (or (not version)
-                        (version-prefix? version (package-version p))))
-               (match (bag-direct-inputs (package->bag p))
-                 (((labels dependencies . _) ...)
-                  (any dependent? dependencies)))))))
-
-  (filter dependent? (package-closure (list top))))
-
-(define (package-toolchain-rewriting p bottom toolchain)
-  "Return a procedure that, when passed a package that's either BOTTOM or one
-of its dependents up to P so, changes it so it is built with TOOLCHAIN.
-TOOLCHAIN must be an input list."
-  (define rewriting-property
-    (gensym " package-toolchain-rewriting"))
-
-  (match (package-dependents/spec p bottom)
-    (()                                           ;P does not depend on BOTTOM
-     identity)
-    (set
-     ;; SET is the list of packages "between" P and BOTTOM (included) whose
-     ;; toolchain needs to be changed.
-     (package-mapping (lambda (p)
-                        (if (or (assq rewriting-property
-                                      (package-properties p))
-                                (not (memq p set)))
-                            p
-                            (let ((p (package-with-c-toolchain p toolchain)))
-                              (package/inherit p
-                                (properties `((,rewriting-property . #t)
-                                              ,@(package-properties p)))))))
-                      (lambda (p)
-                        (or (assq rewriting-property (package-properties p))
-                            (not (memq p set))))
-                      #:deep? #t))))
-
-(define (transform-package-toolchain replacement-specs)
-  "Return a procedure that, when passed a package, changes its toolchain or
-that of its dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is
-a list of strings like \"fftw=gcc-toolchain@10\" meaning that the package to
-the left of the equal sign must be built with the toolchain to the right of
-the equal sign."
-  (define split-on-commas
-    (cute string-tokenize <> (char-set-complement (char-set #\,))))
-
-  (define (specification->input spec)
-    (let ((package (specification->package spec)))
-      (list (package-name package) package)))
-
-  (define replacements
-    (map (lambda (spec)
-           (match (string-tokenize spec %not-equal)
-             ((spec (= split-on-commas toolchain))
-              (cons spec (map specification->input toolchain)))
-             (_
-              (leave (G_ "~a: invalid toolchain replacement specification~%")
-                     spec))))
-         replacement-specs))
-
-  (lambda (obj)
-    (if (package? obj)
-        (or (any (match-lambda
-                   ((bottom . toolchain)
-                    ((package-toolchain-rewriting obj bottom toolchain) obj)))
-                 replacements)
-            obj)
-        obj)))
-
-(define (transform-package-with-debug-info specs)
-  "Return a procedure that, when passed a package, set its 'replacement' field
-to the same package but with #:strip-binaries? #f in its 'arguments' field."
-  (define (non-stripped p)
-    (package
-      (inherit p)
-      (arguments
-       (substitute-keyword-arguments (package-arguments p)
-         ((#:strip-binaries? _ #f) #f)))))
-
-  (define (package-with-debug-info p)
-    (if (member "debug" (package-outputs p))
-        p
-        (let loop ((p p))
-          (match (package-replacement p)
-            (#f
-             (package
-               (inherit p)
-               (replacement (non-stripped p))))
-            (next
-             (package
-               (inherit p)
-               (replacement (loop next))))))))
-
-  (define rewrite
-    (package-input-rewriting/spec (map (lambda (spec)
-                                         (cons spec package-with-debug-info))
-                                       specs)))
-
-  (lambda (obj)
-    (if (package? obj)
-        (rewrite obj)
-        obj)))
-
-(define (transform-package-tests specs)
-  "Return a procedure that, when passed a package, sets #:tests? #f in its
-'arguments' field."
-  (define (package-without-tests p)
-    (package/inherit p
-      (arguments
-       (substitute-keyword-arguments (package-arguments p)
-         ((#:tests? _ #f) #f)))))
-
-  (define rewrite
-    (package-input-rewriting/spec (map (lambda (spec)
-                                         (cons spec package-without-tests))
-                                       specs)))
-
-  (lambda (obj)
-    (if (package? obj)
-        (rewrite obj)
-        obj)))
-
-(define %transformations
-  ;; Transformations that can be applied to things to build.  The car is the
-  ;; key used in the option alist, and the cdr is the transformation
-  ;; procedure; it is called with two arguments: the store, and a list of
-  ;; things to build.
-  `((with-source . ,transform-package-source)
-    (with-input  . ,transform-package-inputs)
-    (with-graft  . ,transform-package-inputs/graft)
-    (with-branch . ,transform-package-source-branch)
-    (with-commit . ,transform-package-source-commit)
-    (with-git-url . ,transform-package-source-git-url)
-    (with-c-toolchain . ,transform-package-toolchain)
-    (with-debug-info . ,transform-package-with-debug-info)
-    (without-tests . ,transform-package-tests)))
-
-(define (transformation-procedure key)
-  "Return the transformation procedure associated with KEY, a symbol such as
-'with-source', or #f if there is none."
-  (any (match-lambda
-         ((k . proc)
-          (and (eq? k key) proc)))
-       %transformations))
-
-(define %transformation-options
-  ;; The command-line interface to the above transformations.
-  (let ((parser (lambda (symbol)
-                  (lambda (opt name arg result . rest)
-                    (apply values
-                           (alist-cons symbol arg result)
-                           rest)))))
-    (list (option '("with-source") #t #f
-                  (parser 'with-source))
-          (option '("with-input") #t #f
-                  (parser 'with-input))
-          (option '("with-graft") #t #f
-                  (parser 'with-graft))
-          (option '("with-branch") #t #f
-                  (parser 'with-branch))
-          (option '("with-commit") #t #f
-                  (parser 'with-commit))
-          (option '("with-git-url") #t #f
-                  (parser 'with-git-url))
-          (option '("with-c-toolchain") #t #f
-                  (parser 'with-c-toolchain))
-          (option '("with-debug-info") #t #f
-                  (parser 'with-debug-info))
-          (option '("without-tests") #t #f
-                  (parser 'without-tests)))))
-
-(define (show-transformation-options-help)
-  (display (G_ "
-      --with-source=[PACKAGE=]SOURCE
-                         use SOURCE when building the corresponding package"))
-  (display (G_ "
-      --with-input=PACKAGE=REPLACEMENT
-                         replace dependency PACKAGE by REPLACEMENT"))
-  (display (G_ "
-      --with-graft=PACKAGE=REPLACEMENT
-                         graft REPLACEMENT on packages that refer to PACKAGE"))
-  (display (G_ "
-      --with-branch=PACKAGE=BRANCH
-                         build PACKAGE from the latest commit of BRANCH"))
-  (display (G_ "
-      --with-commit=PACKAGE=COMMIT
-                         build PACKAGE from COMMIT"))
-  (display (G_ "
-      --with-git-url=PACKAGE=URL
-                         build PACKAGE from the repository at URL"))
-  (display (G_ "
-      --with-c-toolchain=PACKAGE=TOOLCHAIN
-                         build PACKAGE and its dependents with TOOLCHAIN"))
-  (display (G_ "
-      --with-debug-info=PACKAGE
-                         build PACKAGE and preserve its debug info"))
-  (display (G_ "
-      --without-tests=PACKAGE
-                         build PACKAGE without running its tests")))
-
-
-(define (options->transformation opts)
-  "Return a procedure that, when passed an object to build (package,
-derivation, etc.), applies the transformations specified by OPTS."
-  (define applicable
-    ;; List of applicable transformations as symbol/procedure pairs in the
-    ;; order in which they appear on the command line.
-    (filter-map (match-lambda
-                  ((key . value)
-                   (match (transformation-procedure key)
-                     (#f
-                      #f)
-                     (transform
-                      ;; XXX: We used to pass TRANSFORM a list of several
-                      ;; arguments, but we now pass only one, assuming that
-                      ;; transform composes well.
-                      (list key value (transform (list value)))))))
-                (reverse opts)))
-
-  (define (package-with-transformation-properties p)
-    (package/inherit p
-      (properties `((transformations
-                     . ,(map (match-lambda
-                               ((key value _)
-                                (cons key value)))
-                             applicable))
-                    ,@(package-properties p)))))
-
-  (lambda (obj)
-    (define (tagged-object new)
-      (if (and (not (eq? obj new))
-               (package? new) (not (null? applicable)))
-          (package-with-transformation-properties new)
-          new))
-
-    (tagged-object
-     (fold (match-lambda*
-             (((name value transform) obj)
-              (let ((new (transform obj)))
-                (when (eq? new obj)
-                  (warning (G_ "transformation '~a' had no effect on ~a~%")
-                           name
-                           (if (package? obj)
-                               (package-full-name obj)
-                               obj)))
-                new)))
-           obj
-           applicable))))
-
-(define (package-transformations package)
-  "Return the transformations applied to PACKAGE according to its properties."
-  (match (assq-ref (package-properties package) 'transformations)
-    (#f '())
-    (transformations transformations)))
-
-(define (manifest-entry-with-transformations entry)
-  "Return ENTRY with an additional 'transformations' property if it's not
-already there."
-  (let ((properties (manifest-entry-properties entry)))
-    (if (assq 'transformations properties)
-        entry
-        (let ((item (manifest-entry-item entry)))
-          (manifest-entry
-            (inherit entry)
-            (properties
-             (match (and (package? item)
-                         (package-transformations item))
-               ((or #f '())
-                properties)
-               (transformations
-                `((transformations . ,transformations)
-                  ,@properties)))))))))
-
 
 ;;;
 ;;; Standard command-line build options.
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 4db6c5d2d7..2328df98b8 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -32,6 +32,7 @@
   #:use-module ((guix gexp) #:select (lower-object))
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (gnu build linux-container)
   #:use-module (gnu build accounts)
   #:use-module ((guix build syscalls) #:select (set-network-interface-up))
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 6b2e60d7e2..6874904deb 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -34,10 +34,11 @@
   #:use-module (guix sets)
   #:use-module ((guix diagnostics)
                 #:select (location-file formatted-message))
-  #:use-module ((guix scripts build)
+  #:use-module ((guix transformations)
                 #:select (options->transformation
-                          %standard-build-options
                           %transformation-options))
+  #:use-module ((guix scripts build)
+                #:select (%standard-build-options))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
diff --git a/guix/scripts/install.scm b/guix/scripts/install.scm
index 5aafe3bd6d..82f5875dd1 100644
--- a/guix/scripts/install.scm
+++ b/guix/scripts/install.scm
@@ -20,6 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts package)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix scripts)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9fe5a24aee..82c40b247c 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -43,6 +43,7 @@
   #:use-module (guix search-paths)
   #:use-module (guix build-system gnu)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 5599e26f5d..eb2e67a0de 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -41,6 +41,7 @@
   #:use-module (guix config)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix describe)
   #:autoload   (guix store roots) (gc-roots user-owned?)
   #:use-module ((guix build utils)
diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm
index c4527d56d9..1ee8937acf 100644
--- a/guix/scripts/upgrade.scm
+++ b/guix/scripts/upgrade.scm
@@ -21,6 +21,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts package)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix scripts)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
diff --git a/guix/transformations.scm b/guix/transformations.scm
new file mode 100644
index 0000000000..126a9a69d3
--- /dev/null
+++ b/guix/transformations.scm
@@ -0,0 +1,610 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix transformations)
+  #:use-module (guix i18n)
+  #:use-module (guix store)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix diagnostics)
+  #:autoload   (guix download) (download-to-store)
+  #:autoload   (guix git-download) (git-reference? git-reference-url)
+  #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
+  #:use-module (guix utils)
+  #:use-module (guix memoization)
+  #:use-module (guix gexp)
+
+  ;; Use the procedure that destructures "NAME-VERSION" forms.
+  #:use-module ((guix build utils)
+                #:select ((package-name->name+version
+                           . hyphen-package-name->name+version)))
+
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (options->transformation
+            manifest-entry-with-transformations
+
+            show-transformation-options-help
+            %transformation-options))
+
+;;; Commentary:
+;;;
+;;; This module implements "package transformation options"---tools for
+;;; package graph rewriting.  It contains the graph rewriting logic, but also
+;;; the tip of its user interface: command-line option handling.
+;;;
+;;; Code:
+
+(module-autoload! (current-module) '(gnu packages)
+                  '(specification->package))
+
+(define (numeric-extension? file-name)
+  "Return true if FILE-NAME ends with digits."
+  (string-every char-set:hex-digit (file-extension file-name)))
+
+(define (tarball-base-name file-name)
+  "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar
+extensions."
+  ;; TODO: Factorize.
+  (cond ((not (file-extension file-name))
+         file-name)
+        ((numeric-extension? file-name)
+         file-name)
+        ((string=? (file-extension file-name) "tar")
+         (file-sans-extension file-name))
+        ((file-extension file-name)
+         =>
+         (match-lambda
+           ("scm" file-name)
+           (_     (tarball-base-name (file-sans-extension file-name)))))
+        (else
+         file-name)))
+
+
+;; Files to be downloaded.
+(define-record-type <downloaded-file>
+  (downloaded-file uri recursive?)
+  downloaded-file?
+  (uri        downloaded-file-uri)
+  (recursive? downloaded-file-recursive?))
+
+(define download-to-store*
+  (store-lift download-to-store))
+
+(define-gexp-compiler (compile-downloaded-file (file <downloaded-file>)
+                                               system target)
+  "Download FILE and return the result as a store item."
+  (match file
+    (($ <downloaded-file> uri recursive?)
+     (download-to-store* uri #:recursive? recursive?))))
+
+(define* (package-with-source p uri #:optional version)
+  "Return a package based on P but with its source taken from URI.  Extract
+the new package's version number from URI."
+  (let ((base (tarball-base-name (basename uri))))
+    (let-values (((_ version*)
+                  (hyphen-package-name->name+version base)))
+      (package (inherit p)
+               (version (or version version*
+                            (package-version p)))
+
+               ;; Use #:recursive? #t to allow for directories.
+               (source (downloaded-file uri #t))))))
+
+
+;;;
+;;; Transformations.
+;;;
+
+(define (transform-package-source sources)
+  "Return a transformation procedure that replaces package sources with the
+matching URIs given in SOURCES."
+  (define new-sources
+    (map (lambda (uri)
+           (match (string-index uri #\=)
+             (#f
+              ;; Determine the package name and version from URI.
+              (call-with-values
+                  (lambda ()
+                    (hyphen-package-name->name+version
+                     (tarball-base-name (basename uri))))
+                (lambda (name version)
+                  (list name version uri))))
+             (index
+              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
+              (call-with-values
+                  (lambda ()
+                    (package-name->name+version (string-take uri index)))
+                (lambda (name version)
+                  (list name version
+                        (string-drop uri (+ 1 index))))))))
+         sources))
+
+  (lambda (obj)
+    (let loop ((sources  new-sources)
+               (result   '()))
+      (match obj
+        ((? package? p)
+         (match (assoc-ref sources (package-name p))
+           ((version source)
+            (package-with-source p source version))
+           (#f
+            p)))
+        (_
+         obj)))))
+
+(define (evaluate-replacement-specs specs proc)
+  "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
+of package spec/procedure pairs as expected by 'package-input-rewriting/spec'.
+PROC is called with the package to be replaced and its replacement according
+to SPECS.  Raise an error if an element of SPECS uses invalid syntax, or if a
+package it refers to could not be found."
+  (define not-equal
+    (char-set-complement (char-set #\=)))
+
+  (map (lambda (spec)
+         (match (string-tokenize spec not-equal)
+           ((spec new)
+            (cons spec
+                  (let ((new (specification->package new)))
+                    (lambda (old)
+                      (proc old new)))))
+           (x
+            (leave (G_ "invalid replacement specification: ~s~%") spec))))
+       specs))
+
+(define (transform-package-inputs replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"guile=guile@2.1\" meaning that, any dependency on a package
+called \"guile\" must be replaced with a dependency on a version 2.1 of
+\"guile\"."
+  (let* ((replacements (evaluate-replacement-specs replacement-specs
+                                                   (lambda (old new)
+                                                     new)))
+         (rewrite      (package-input-rewriting/spec replacements)))
+    (lambda (obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
+
+(define (transform-package-inputs/graft replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
+current 'gnutls' package, after which version 3.5.4 is grafted onto them."
+  (define (set-replacement old new)
+    (package (inherit old) (replacement new)))
+
+  (let* ((replacements (evaluate-replacement-specs replacement-specs
+                                                   set-replacement))
+         (rewrite      (package-input-rewriting/spec replacements)))
+    (lambda (obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
+
+(define %not-equal
+  (char-set-complement (char-set #\=)))
+
+(define (package-git-url package)
+  "Return the URL of the Git repository for package, or raise an error if
+the source of PACKAGE is not fetched from a Git repository."
+  (let ((source (package-source package)))
+    (cond ((and (origin? source)
+                (git-reference? (origin-uri source)))
+           (git-reference-url (origin-uri source)))
+          ((git-checkout? source)
+           (git-checkout-url source))
+          (else
+           (leave (G_ "the source of ~a is not a Git reference~%")
+                  (package-full-name package))))))
+
+(define (evaluate-git-replacement-specs specs proc)
+  "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
+of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
+replacement package.  Raise an error if an element of SPECS uses invalid
+syntax, or if a package it refers to could not be found."
+  (map (lambda (spec)
+         (match (string-tokenize spec %not-equal)
+           ((spec branch-or-commit)
+            (define (replace old)
+              (let* ((source (package-source old))
+                     (url    (package-git-url old)))
+                (proc old url branch-or-commit)))
+
+            (cons spec replace))
+           (_
+            (leave (G_ "invalid replacement specification: ~s~%") spec))))
+       specs))
+
+(define (transform-package-source-branch replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"guile-next=stable-3.0\" meaning that packages are built using
+'guile-next' from the latest commit on its 'stable-3.0' branch."
+  (define (replace old url branch)
+    (package
+      (inherit old)
+      (version (string-append "git." (string-map (match-lambda
+                                                   (#\/ #\-)
+                                                   (chr chr))
+                                                 branch)))
+      (source (git-checkout (url url) (branch branch)
+                            (recursive? #t)))))
+
+  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
+                                                       replace))
+         (rewrite      (package-input-rewriting/spec replacements)))
+    (lambda (obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
+
+(define (transform-package-source-commit replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"guile-next=cabba9e\" meaning that packages are built using
+'guile-next' from commit 'cabba9e'."
+  (define (replace old url commit)
+    (package
+      (inherit old)
+      (version (if (and (> (string-length commit) 1)
+                        (string-prefix? "v" commit)
+                        (char-set-contains? char-set:digit
+                                            (string-ref commit 1)))
+                   (string-drop commit 1)        ;looks like a tag like "v1.0"
+                   (string-append "git."
+                                  (if (< (string-length commit) 7)
+                                      commit
+                                      (string-take commit 7)))))
+      (source (git-checkout (url url) (commit commit)
+                            (recursive? #t)))))
+
+  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
+                                                       replace))
+         (rewrite      (package-input-rewriting/spec replacements)))
+    (lambda (obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
+
+(define (transform-package-source-git-url replacement-specs)
+  "Return a procedure that, when passed a package, replaces its dependencies
+according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of strings like
+\"guile-json=https://gitthing.com/…\" meaning that packages are built using
+a checkout of the Git repository at the given URL."
+  (define replacements
+    (map (lambda (spec)
+           (match (string-tokenize spec %not-equal)
+             ((spec url)
+              (cons spec
+                    (lambda (old)
+                      (package
+                        (inherit old)
+                        (source (git-checkout (url url)
+                                              (recursive? #t)))))))
+             (_
+              (leave (G_ "~a: invalid Git URL replacement specification~%")
+                     spec))))
+         replacement-specs))
+
+  (define rewrite
+    (package-input-rewriting/spec replacements))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
+(define (package-dependents/spec top bottom)
+  "Return the list of dependents of BOTTOM, a spec string, that are also
+dependencies of TOP, a package."
+  (define-values (name version)
+    (package-name->name+version bottom))
+
+  (define dependent?
+    (mlambda (p)
+      (and (package? p)
+           (or (and (string=? name (package-name p))
+                    (or (not version)
+                        (version-prefix? version (package-version p))))
+               (match (bag-direct-inputs (package->bag p))
+                 (((labels dependencies . _) ...)
+                  (any dependent? dependencies)))))))
+
+  (filter dependent? (package-closure (list top))))
+
+(define (package-toolchain-rewriting p bottom toolchain)
+  "Return a procedure that, when passed a package that's either BOTTOM or one
+of its dependents up to P so, changes it so it is built with TOOLCHAIN.
+TOOLCHAIN must be an input list."
+  (define rewriting-property
+    (gensym " package-toolchain-rewriting"))
+
+  (match (package-dependents/spec p bottom)
+    (()                                           ;P does not depend on BOTTOM
+     identity)
+    (set
+     ;; SET is the list of packages "between" P and BOTTOM (included) whose
+     ;; toolchain needs to be changed.
+     (package-mapping (lambda (p)
+                        (if (or (assq rewriting-property
+                                      (package-properties p))
+                                (not (memq p set)))
+                            p
+                            (let ((p (package-with-c-toolchain p toolchain)))
+                              (package/inherit p
+                                (properties `((,rewriting-property . #t)
+                                              ,@(package-properties p)))))))
+                      (lambda (p)
+                        (or (assq rewriting-property (package-properties p))
+                            (not (memq p set))))
+                      #:deep? #t))))
+
+(define (transform-package-toolchain replacement-specs)
+  "Return a procedure that, when passed a package, changes its toolchain or
+that of its dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is
+a list of strings like \"fftw=gcc-toolchain@10\" meaning that the package to
+the left of the equal sign must be built with the toolchain to the right of
+the equal sign."
+  (define split-on-commas
+    (cute string-tokenize <> (char-set-complement (char-set #\,))))
+
+  (define (specification->input spec)
+    (let ((package (specification->package spec)))
+      (list (package-name package) package)))
+
+  (define replacements
+    (map (lambda (spec)
+           (match (string-tokenize spec %not-equal)
+             ((spec (= split-on-commas toolchain))
+              (cons spec (map specification->input toolchain)))
+             (_
+              (leave (G_ "~a: invalid toolchain replacement specification~%")
+                     spec))))
+         replacement-specs))
+
+  (lambda (obj)
+    (if (package? obj)
+        (or (any (match-lambda
+                   ((bottom . toolchain)
+                    ((package-toolchain-rewriting obj bottom toolchain) obj)))
+                 replacements)
+            obj)
+        obj)))
+
+(define (transform-package-with-debug-info specs)
+  "Return a procedure that, when passed a package, set its 'replacement' field
+to the same package but with #:strip-binaries? #f in its 'arguments' field."
+  (define (non-stripped p)
+    (package
+      (inherit p)
+      (arguments
+       (substitute-keyword-arguments (package-arguments p)
+         ((#:strip-binaries? _ #f) #f)))))
+
+  (define (package-with-debug-info p)
+    (if (member "debug" (package-outputs p))
+        p
+        (let loop ((p p))
+          (match (package-replacement p)
+            (#f
+             (package
+               (inherit p)
+               (replacement (non-stripped p))))
+            (next
+             (package
+               (inherit p)
+               (replacement (loop next))))))))
+
+  (define rewrite
+    (package-input-rewriting/spec (map (lambda (spec)
+                                         (cons spec package-with-debug-info))
+                                       specs)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
+(define (transform-package-tests specs)
+  "Return a procedure that, when passed a package, sets #:tests? #f in its
+'arguments' field."
+  (define (package-without-tests p)
+    (package/inherit p
+      (arguments
+       (substitute-keyword-arguments (package-arguments p)
+         ((#:tests? _ #f) #f)))))
+
+  (define rewrite
+    (package-input-rewriting/spec (map (lambda (spec)
+                                         (cons spec package-without-tests))
+                                       specs)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
+(define %transformations
+  ;; Transformations that can be applied to things to build.  The car is the
+  ;; key used in the option alist, and the cdr is the transformation
+  ;; procedure; it is called with two arguments: the store, and a list of
+  ;; things to build.
+  `((with-source . ,transform-package-source)
+    (with-input  . ,transform-package-inputs)
+    (with-graft  . ,transform-package-inputs/graft)
+    (with-branch . ,transform-package-source-branch)
+    (with-commit . ,transform-package-source-commit)
+    (with-git-url . ,transform-package-source-git-url)
+    (with-c-toolchain . ,transform-package-toolchain)
+    (with-debug-info . ,transform-package-with-debug-info)
+    (without-tests . ,transform-package-tests)))
+
+(define (transformation-procedure key)
+  "Return the transformation procedure associated with KEY, a symbol such as
+'with-source', or #f if there is none."
+  (any (match-lambda
+         ((k . proc)
+          (and (eq? k key) proc)))
+       %transformations))
+
+
+;;;
+;;; Command-line handling.
+;;;
+
+(define %transformation-options
+  ;; The command-line interface to the above transformations.
+  (let ((parser (lambda (symbol)
+                  (lambda (opt name arg result . rest)
+                    (apply values
+                           (alist-cons symbol arg result)
+                           rest)))))
+    (list (option '("with-source") #t #f
+                  (parser 'with-source))
+          (option '("with-input") #t #f
+                  (parser 'with-input))
+          (option '("with-graft") #t #f
+                  (parser 'with-graft))
+          (option '("with-branch") #t #f
+                  (parser 'with-branch))
+          (option '("with-commit") #t #f
+                  (parser 'with-commit))
+          (option '("with-git-url") #t #f
+                  (parser 'with-git-url))
+          (option '("with-c-toolchain") #t #f
+                  (parser 'with-c-toolchain))
+          (option '("with-debug-info") #t #f
+                  (parser 'with-debug-info))
+          (option '("without-tests") #t #f
+                  (parser 'without-tests)))))
+
+(define (show-transformation-options-help)
+  (display (G_ "
+      --with-source=[PACKAGE=]SOURCE
+                         use SOURCE when building the corresponding package"))
+  (display (G_ "
+      --with-input=PACKAGE=REPLACEMENT
+                         replace dependency PACKAGE by REPLACEMENT"))
+  (display (G_ "
+      --with-graft=PACKAGE=REPLACEMENT
+                         graft REPLACEMENT on packages that refer to PACKAGE"))
+  (display (G_ "
+      --with-branch=PACKAGE=BRANCH
+                         build PACKAGE from the latest commit of BRANCH"))
+  (display (G_ "
+      --with-commit=PACKAGE=COMMIT
+                         build PACKAGE from COMMIT"))
+  (display (G_ "
+      --with-git-url=PACKAGE=URL
+                         build PACKAGE from the repository at URL"))
+  (display (G_ "
+      --with-c-toolchain=PACKAGE=TOOLCHAIN
+                         build PACKAGE and its dependents with TOOLCHAIN"))
+  (display (G_ "
+      --with-debug-info=PACKAGE
+                         build PACKAGE and preserve its debug info"))
+  (display (G_ "
+      --without-tests=PACKAGE
+                         build PACKAGE without running its tests")))
+
+
+(define (options->transformation opts)
+  "Return a procedure that, when passed an object to build (package,
+derivation, etc.), applies the transformations specified by OPTS and returns
+the resulting objects.  OPTS must be a list of symbol/string pairs such as:
+
+  ((with-branch . \"guile-gcrypt=master\")
+   (without-tests . \"libgcrypt\"))
+
+Each symbol names a transformation and the corresponding string is an argument
+to that transformation."
+  (define applicable
+    ;; List of applicable transformations as symbol/procedure pairs in the
+    ;; order in which they appear on the command line.
+    (filter-map (match-lambda
+                  ((key . value)
+                   (match (transformation-procedure key)
+                     (#f
+                      #f)
+                     (transform
+                      ;; XXX: We used to pass TRANSFORM a list of several
+                      ;; arguments, but we now pass only one, assuming that
+                      ;; transform composes well.
+                      (list key value (transform (list value)))))))
+                (reverse opts)))
+
+  (define (package-with-transformation-properties p)
+    (package/inherit p
+      (properties `((transformations
+                     . ,(map (match-lambda
+                               ((key value _)
+                                (cons key value)))
+                             applicable))
+                    ,@(package-properties p)))))
+
+  (lambda (obj)
+    (define (tagged-object new)
+      (if (and (not (eq? obj new))
+               (package? new) (not (null? applicable)))
+          (package-with-transformation-properties new)
+          new))
+
+    (tagged-object
+     (fold (match-lambda*
+             (((name value transform) obj)
+              (let ((new (transform obj)))
+                (when (eq? new obj)
+                  (warning (G_ "transformation '~a' had no effect on ~a~%")
+                           name
+                           (if (package? obj)
+                               (package-full-name obj)
+                               obj)))
+                new)))
+           obj
+           applicable))))
+
+(define (package-transformations package)
+  "Return the transformations applied to PACKAGE according to its properties."
+  (match (assq-ref (package-properties package) 'transformations)
+    (#f '())
+    (transformations transformations)))
+
+(define (manifest-entry-with-transformations entry)
+  "Return ENTRY with an additional 'transformations' property if it's not
+already there."
+  (let ((properties (manifest-entry-properties entry)))
+    (if (assq 'transformations properties)
+        entry
+        (let ((item (manifest-entry-item entry)))
+          (manifest-entry
+            (inherit entry)
+            (properties
+             (match (and (package? item)
+                         (package-transformations item))
+               ((or #f '())
+                properties)
+               (transformations
+                `((transformations . ,transformations)
+                  ,@properties)))))))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index b877fac9df..5a164b77e3 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -80,6 +80,7 @@ guix/gexp.scm
 guix/gnu-maintenance.scm
 guix/scripts/container.scm
 guix/scripts/container/exec.scm
+guix/transformations.scm
 guix/upstream.scm
 guix/ui.scm
 guix/status.scm
diff --git a/tests/scripts-build.scm b/tests/transformations.scm
index d56e02b452..07ed8b1234 100644
--- a/tests/scripts-build.scm
+++ b/tests/transformations.scm
@@ -16,7 +16,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (test-scripts-build)
+(define-module (test-transformations)
   #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module ((guix gexp) #:select (lower-object))
@@ -25,7 +25,7 @@
   #:use-module (guix git-download)
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
-  #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
@@ -38,7 +38,7 @@
   #:use-module (srfi srfi-64))
 
 
-(test-begin "scripts-build")
+(test-begin "transformations")
 
 (test-assert "options->transformation, no transformations"
   (let ((p (dummy-package "foo"))