diff options
Diffstat (limited to 'guix/records.scm')
-rw-r--r-- | guix/records.scm | 42 |
1 files changed, 31 insertions, 11 deletions
diff --git a/guix/records.scm b/guix/records.scm index 98f3c8fef0..0649c90ea3 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -1,5 +1,6 @@ ;;; 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> ;;; ;;; This file is part of GNU Guix. ;;; @@ -43,15 +44,6 @@ (format #f fmt args ...) 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))))) - (eval-when (expand load eval) ;; The procedures below are needed both at run time and at expansion time. @@ -74,7 +66,32 @@ interface\" (ABI) for TYPE is equal to COOKIE." ;; recompiled. (throw 'record-abi-mismatch-error 'abi-check "~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 (syntax-rules () @@ -169,6 +186,9 @@ of TYPE matches the expansion-time ABI." #'(field (... ...))) (wrap-field-value f (field-default-value f)))) + ;; Pass S to make sure source location info is preserved. + (report-duplicate-field-specifier 'name s) + (let ((fields (append fields (map car default-values)))) (cond ((lset= eq? fields '(expected ...)) #`(let* #,(field-bindings |