From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mathieu Othacehe Subject: [PATCH 2/5] services: Factorize define-maybe macro. Date: Wed, 15 Mar 2017 21:46:39 +0100 Message-ID: <20170315204642.27626-3-m.othacehe@gmail.com> References: <20170315204642.27626-1-m.othacehe@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:41840) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1coFov-0003yG-Ff for guix-devel@gnu.org; Wed, 15 Mar 2017 16:46:58 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1coFou-0004uN-5q for guix-devel@gnu.org; Wed, 15 Mar 2017 16:46:57 -0400 Received: from mail-wr0-x22b.google.com ([2a00:1450:400c:c0c::22b]:33262) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1coFot-0004uH-W6 for guix-devel@gnu.org; Wed, 15 Mar 2017 16:46:56 -0400 Received: by mail-wr0-x22b.google.com with SMTP id u48so19084221wrc.0 for ; Wed, 15 Mar 2017 13:46:55 -0700 (PDT) In-Reply-To: <20170315204642.27626-1-m.othacehe@gmail.com> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * gnu/services/configuration.scm (define-maybe): New exported procedure. (id): New procedure extracted from define-configuration. * gnu/services/messaging.scm (define-all-configurations): Define id inside procedure as define-all-configurations is now the only user. --- gnu/services/configuration.scm | 28 ++++++++++++++++++++-------- gnu/services/messaging.scm | 22 +++------------------- 2 files changed, 23 insertions(+), 27 deletions(-) diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 2ad3a637a..3fdaf705a 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Andy Wingo +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +37,7 @@ configuration-field-default-value-thunk configuration-field-documentation serialize-configuration + define-maybe define-configuration validate-configuration generate-documentation @@ -85,16 +87,26 @@ (configuration-field-name field) val)))) fields)) +(define-syntax-rule (id ctx parts ...) + (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) + +(define-syntax define-maybe + (lambda (x) + (syntax-case x () + ((_ stem) + (with-syntax + ((stem? (id #'stem #'stem #'?)) + (maybe-stem? (id #'stem #'maybe- #'stem #'?)) + (serialize-stem (id #'stem #'serialize- #'stem)) + (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem))) + #'(begin + (define (maybe-stem? val) + (or (eq? val 'disabled) (stem? val))) + (define (serialize-maybe-stem field-name val) + (when (stem? val) (serialize-stem field-name val))))))))) + (define-syntax define-configuration (lambda (stx) - (define (id ctx part . parts) - (let ((part (syntax->datum part))) - (datum->syntax - ctx - (match parts - (() part) - (parts (symbol-append part - (syntax->datum (apply id ctx parts)))))))) (syntax-case stx () ((_ stem (field (field-type def) doc) ...) (with-syntax (((field-getter ...) diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 34723dc11..e50eeba8c 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -49,27 +50,10 @@ ;;; ;;; Code: -(define-syntax-rule (id ctx parts ...) - "Assemble PARTS into a raw (unhygienic) identifier." - (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) - -(define-syntax define-maybe - (lambda (x) - (syntax-case x () - ((_ stem) - (with-syntax - ((stem? (id #'stem #'stem #'?)) - (maybe-stem? (id #'stem #'maybe- #'stem #'?)) - (serialize-stem (id #'stem #'serialize- #'stem)) - (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem))) - #'(begin - (define (maybe-stem? val) - (or (eq? val 'disabled) (stem? val))) - (define (serialize-maybe-stem field-name val) - (when (stem? val) (serialize-stem field-name val))))))))) - (define-syntax define-all-configurations (lambda (stx) + (define-syntax-rule (id ctx parts ...) + (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) (define (make-pred arg) (lambda (field target) (and (memq (syntax->datum target) `(common ,arg)) field))) -- 2.12.0