records: Make 'report-duplicate-field-specifier' available at expansion-time.
Fixes a regression in 'guix pack -R' introduced with commit
c2dcff41c2
. The imported modules of
'c-compiler' would be compiled in this order: first (guix records),
then (guix search-paths). Consequently,
'report-duplicate-field-specifier' would be reported as unbound while
compiling (guix search-paths), leading to a build failure.
* guix/records.scm (report-invalid-field-specifier)
(report-duplicate-field-specifier): Move within 'eval-expand'.
This commit is contained in:
parent
2c5ee9bba4
commit
bbb2bd50dc
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -44,31 +44,6 @@
|
||||||
(format #f fmt args ...)
|
(format #f fmt args ...)
|
||||||
form))))
|
form))))
|
||||||
|
|
||||||
(define (report-invalid-field-specifier name bindings)
|
|
||||||
"Report the first invalid binding among BINDINGS."
|
|
||||||
(let loop ((bindings bindings))
|
|
||||||
(syntax-case bindings ()
|
|
||||||
(((field value) rest ...) ;good
|
|
||||||
(loop #'(rest ...)))
|
|
||||||
((weird _ ...) ;weird!
|
|
||||||
(syntax-violation name "invalid field specifier" #'weird)))))
|
|
||||||
|
|
||||||
(define (report-duplicate-field-specifier name ctor)
|
|
||||||
"Report the first duplicate identifier among the bindings in CTOR."
|
|
||||||
(syntax-case ctor ()
|
|
||||||
((_ bindings ...)
|
|
||||||
(let loop ((bindings #'(bindings ...))
|
|
||||||
(seen '()))
|
|
||||||
(syntax-case bindings ()
|
|
||||||
(((field value) rest ...)
|
|
||||||
(not (memq (syntax->datum #'field) seen))
|
|
||||||
(loop #'(rest ...) (cons (syntax->datum #'field) seen)))
|
|
||||||
((duplicate rest ...)
|
|
||||||
(syntax-violation name "duplicate field initializer"
|
|
||||||
#'duplicate))
|
|
||||||
(()
|
|
||||||
#t))))))
|
|
||||||
|
|
||||||
(eval-when (expand load eval)
|
(eval-when (expand load eval)
|
||||||
;; The procedures below are needed both at run time and at expansion time.
|
;; The procedures below are needed both at run time and at expansion time.
|
||||||
|
|
||||||
|
@ -91,7 +66,32 @@ interface\" (ABI) for TYPE is equal to COOKIE."
|
||||||
;; recompiled.
|
;; recompiled.
|
||||||
(throw 'record-abi-mismatch-error 'abi-check
|
(throw 'record-abi-mismatch-error 'abi-check
|
||||||
"~a: record ABI mismatch; recompilation needed"
|
"~a: record ABI mismatch; recompilation needed"
|
||||||
(list #,type) '())))))
|
(list #,type) '()))))
|
||||||
|
|
||||||
|
(define (report-invalid-field-specifier name bindings)
|
||||||
|
"Report the first invalid binding among BINDINGS."
|
||||||
|
(let loop ((bindings bindings))
|
||||||
|
(syntax-case bindings ()
|
||||||
|
(((field value) rest ...) ;good
|
||||||
|
(loop #'(rest ...)))
|
||||||
|
((weird _ ...) ;weird!
|
||||||
|
(syntax-violation name "invalid field specifier" #'weird)))))
|
||||||
|
|
||||||
|
(define (report-duplicate-field-specifier name ctor)
|
||||||
|
"Report the first duplicate identifier among the bindings in CTOR."
|
||||||
|
(syntax-case ctor ()
|
||||||
|
((_ bindings ...)
|
||||||
|
(let loop ((bindings #'(bindings ...))
|
||||||
|
(seen '()))
|
||||||
|
(syntax-case bindings ()
|
||||||
|
(((field value) rest ...)
|
||||||
|
(not (memq (syntax->datum #'field) seen))
|
||||||
|
(loop #'(rest ...) (cons (syntax->datum #'field) seen)))
|
||||||
|
((duplicate rest ...)
|
||||||
|
(syntax-violation name "duplicate field initializer"
|
||||||
|
#'duplicate))
|
||||||
|
(()
|
||||||
|
#t)))))))
|
||||||
|
|
||||||
(define-syntax make-syntactic-constructor
|
(define-syntax make-syntactic-constructor
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
|
Loading…
Reference in New Issue