diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 02:26:23 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 02:26:23 +0200 |
| commit | 8538b3b269a03b9601ba0710435927787b318bec (patch) | |
| tree | fa0d2d32806629300b1d7b8222527b21104aa3d4 | |
| parent | Document base64. (diff) | |
| download | calp-8538b3b269a03b9601ba0710435927787b318bec.tar.gz calp-8538b3b269a03b9601ba0710435927787b318bec.tar.xz | |
Clean up (calp util config).
Introduced define-once-public. While only used once, removes a weird
export which was previously easily missed.
| -rw-r--r-- | module/calp/util/config.scm | 59 |
1 files changed, 30 insertions, 29 deletions
diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index b2a46ea7..aba2cd2c 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -9,8 +9,7 @@ :use-module (srfi srfi-1) :use-module (ice-9 curried-definitions) ; for ensure :use-module (calp translation) - :export (define-config) -) + :export (define-config ensure)) (define (fix-keywords args) (map (lambda (arg) @@ -22,43 +21,45 @@ (define %configuration-error (_ "Pre-property failed when setting ~s to ~s")) +(define-syntax-rule (define-once-public symbol binding) + (begin (define-once symbol binding) + (export symbol))) + (define-syntax (define-config stx) (syntax-case stx () ((_ name default kw ...) (let ((pre (cond ((memv pre: (fix-keywords #'(kw ...))) => cadr) (else #f))) (post (cond ((memv post: (fix-keywords #'(kw ...))) => cadr) (else #f)))) - #`(begin - (define-once name - (make-parameter - default - #,@(cond ((and pre post) - #`((lambda (new-value) - (cond ((#,pre new-value) - => (lambda (translated) - (#,post translated) - translated)) - (else - (scm-error 'configuration-error - "set-config!" - %configuration-error - (list (quote name) new-value))))))) - (pre - #`((lambda (new-value) - (or (#,pre new-value) + #`(define-once-public name + (make-parameter + default + #,@(cond ((and pre post) + #`((lambda (new-value) + (cond ((#,pre new-value) + => (lambda (translated) + (#,post translated) + translated)) + (else (scm-error 'configuration-error "set-config!" %configuration-error - (list (quote name) new-value)))))) - (post - #`((lambda (new-value) - (#,post new-value) - new-value)) - ) - (else #'())))) - (export name)))))) + (list (quote name) new-value))))))) + (pre + #`((lambda (new-value) + (or (#,pre new-value) + (scm-error 'configuration-error + "set-config!" + %configuration-error + (list (quote name) new-value)))))) + (post + #`((lambda (new-value) + (#,post new-value) + new-value)) + ) + (else #'())))))))) -(define-public ((ensure predicate) value) +(define ((ensure predicate) value) (if (predicate value) value #f)) |