diff --git a/guix/records.scm b/guix/records.scm index 6b3c25cefa..0649c90ea3 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -44,31 +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))))) - -(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) ;; 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. (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 ()