(module parameter mzscheme
(require (file "base.ss"))
(provide make-guard
define-parameter)
(define (make-guard pred type-message)
(lambda (val)
(if (pred val)
val
(raise-exn exn:fail:unlib
(format "Expected ~a, received ~a" type-message val)))))
(define-syntax (define-parameter stx)
(syntax-case stx ()
[(_ parameter-name initial-value guard with-form)
(syntax
(begin
(define parameter-name
(make-parameter initial-value guard))
(define-syntax (with-form stx)
(syntax-case stx ()
[(with-form new-value exp (... ...))
(syntax
(parameterize ([parameter-name new-value])
exp (... ...)))]))))]))
)