diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-11-23 11:22:30 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-11-23 11:29:38 +0100 |
commit | b15e543d303ea58fdc0f0541c708389f9d513e3d (patch) | |
tree | 5c4bd48d67d4d3cd4806269dcabf58382f448bed /guix/diagnostics.scm | |
parent | 4efc08d895274ee39e6e6e5c49121fb05a0281b6 (diff) | |
parent | daf7b5ecef8de0e536ffd8d2957f022d010767a8 (diff) | |
download | guix-patches-b15e543d303ea58fdc0f0541c708389f9d513e3d.tar guix-patches-b15e543d303ea58fdc0f0541c708389f9d513e3d.tar.gz |
Merge branch 'master' into core-updates-frozen
Diffstat (limited to 'guix/diagnostics.scm')
-rw-r--r-- | guix/diagnostics.scm | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 6a792febd4..337a73c1a2 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -54,7 +54,9 @@ condition-fix-hint guix-warning-port - program-name)) + program-name + + define-with-syntax-properties)) ;;; Commentary: ;;; @@ -331,3 +333,37 @@ number of arguments in ARGS matches the escapes in FORMAT." (define program-name ;; Name of the command-line program currently executing, or #f. (make-parameter #f)) + + +(define-syntax define-with-syntax-properties + (lambda (x) + "Define BINDING to be a syntax form replacing each VALUE-IDENTIFIER and +SYNTAX-PROPERTIES-IDENTIFIER in body by the syntax and syntax-properties, +respectively, of each ensuing syntax object." + (syntax-case x () + ((_ (binding (value-identifier syntax-properties-identifier) + ...) + body ...) + (and (and-map identifier? #'(value-identifier ...)) + (and-map identifier? #'(syntax-properties-identifier ...))) + #'(define-syntax binding + (lambda (y) + (with-ellipsis ::: + (syntax-case y () + ((_ value-identifier ...) + (with-syntax ((syntax-properties-identifier + #`'#,(datum->syntax y + (syntax-source + #'value-identifier))) + ...) + #'(begin body ...))) + (_ + (syntax-violation #f (format #f + "Expected (~a~{ ~a~})" + 'binding + '(value-identifier ...)) + y))))))) + (_ + (syntax-violation #f "Expected a definition of the form \ +(define-with-syntax-properties (binding (value syntax-properties) \ +...) body ...)" x))))) |