#lang scheme (require (for-syntax scheme/base) (for-syntax syntax/struct)) (provide pseudo-parameter? make-pseudo-parameter pseudo-parameter/c define-parameter-set) (define-struct pseudo-parameter (getter setter) #:property prop:procedure (case-lambda [(pp) ((pseudo-parameter-getter pp))] [(pp x) ((pseudo-parameter-setter pp) x)])) (define (pseudo-parameter/c c) (and/c pseudo-parameter? (case-> (-> c) (c . -> . any)))) (define-syntax (define-parameter-set stx) (syntax-case stx () [(define-parameter-set struct current (param default . maybe-guard) ...) (with-syntax ([(struct:pset make-pset pset? get-field ...) (build-struct-names #'struct (syntax->list #'(param ...)) #f #t stx)]) #'(begin (define param (make-parameter default . maybe-guard)) ... (define-struct struct (param ...) #:prefab) (define current (make-pseudo-parameter (lambda () (make-pset (param) ...)) (lambda (x) (unless (pset? x) (error 'current "expected a parameter set of type ~a, received: ~v" 'struct x)) (param (get-field x)) ... x)))))]))