@@ -108,6 +108,7 @@
package-superseded
deprecated-package
package-field-location
+ package-argument-location
this-package-input
this-package-native-input
@@ -515,9 +516,9 @@ object."
(name old-name)
(properties `((superseded . ,p)))))
-(define (package-field-location package field)
- "Return the source code location of the definition of FIELD for PACKAGE, or
-#f if it could not be determined."
+(define (package-part-location package proc)
+ "Return the source code location of the part of PACKAGE returned by (PROC
+PACKAGE), or #f if it could not be determined."
(match (package-location package)
(($ <location> file line column)
(match (search-path %load-path file)
@@ -530,17 +531,16 @@ object."
(go-to-location port line column)
(match (read port)
(('package inits ...)
- (let ((field (assoc field inits)))
- (match field
- ((_ value)
- (let ((loc (and=> (source-properties value)
- source-properties->location)))
- (and loc
- ;; Preserve the original file name, which may be a
- ;; relative file name.
- (set-field loc (location-file) file))))
- (_
- #f))))
+ (match (proc inits)
+ (#f
+ #f)
+ (value
+ (let ((loc (and=> (source-properties value)
+ source-properties->location)))
+ (and loc
+ ;; Preserve the original file name, which may be a
+ ;; relative file name.
+ (set-field loc (location-file) file))))))
(_
#f)))))
(lambda _
@@ -550,6 +550,29 @@ object."
#f)))
(_ #f)))
+(define (package-field-location package field)
+ "Return the source code location of the definition of FIELD for PACKAGE, or
+#f if it could not be determined."
+ (package-part-location
+ package
+ (lambda (p)
+ (match (assoc field p)
+ ((_ value) value)
+ (_ #f)))))
+
+(define (package-argument-location package argument)
+ "Return the source code location of the definition of keyword ARGUMENT for
+PACKAGE, or #f if it could not be determined."
+ (package-part-location
+ package
+ (lambda (p)
+ (match (assoc 'arguments p)
+ ((_ ('quasiquote (arguments ..1)))
+ (match (member argument arguments eq?)
+ ((_ value . _) value)
+ (_ #f)))
+ (_ #f)))))
+
(define (package-input package name)
"Return the package input NAME of PACKAGE--i.e., an input
from the ‘inputs’ or ‘propagated-inputs’ field. Native inputs are not
@@ -371,7 +371,7 @@ bailing out~%")
(delete ,@to-delete)
(prepend ,@things)))
(location-column location))))
- (('quasiquote (exp ...))
+ ((or ('quasiquote (exp ...)) ((or (exp ...) (? comment? exp)) ...))
(let/ec return
(object->string*
`(list ,@(simplify-expressions exp inputs return))
@@ -389,6 +389,33 @@ POLICY is a symbol that defines whether to simplify inputs; it can one of
'silent (change only if the resulting derivation is the same), 'safe (change
only if semantics are known to be unaffected), and 'always (fearlessly
simplify inputs!)."
+ (define (package-argument package argument)
+ (match (member argument (package-arguments package) eq?)
+ ((_ value . _) value)
+ (_ #f)))
+
+ ;; We know that the cargo build system does not use its special input labels,
+ ;; so it is always safe to simplify, but it will change the derivation. Only
+ ;; proceed if POLICY is 'safe or 'always.
+ (when (member policy '(safe always))
+ (for-each (lambda (argument)
+ (match (package-argument package argument)
+ (#f
+ #f)
+ (inputs
+ (match (package-argument-location package argument)
+ (#f
+ #f)
+ (location
+ (edit-expression
+ (location->source-properties location)
+ (lambda (str)
+ (simplify-inputs location
+ (package-name package)
+ str inputs
+ #:label-matches? (const #t)))))))))
+ (list #:cargo-inputs #:cargo-development-inputs)))
+
(for-each (lambda (field-name field)
(match (field package)
(()