38 lines
1.7 KiB
Racket

#lang racket/base
(require (for-syntax racket/base) racket/stxparam racket/splicing)
(provide splicing-syntax-parameterize
define-syntax-parameters
define-language-variables
define-language-variable
inject-language-variables
(rename-out [br:define-syntax-parameter define-syntax-parameter]))
(define-syntax (br:define-syntax-parameter stx)
(syntax-case stx ()
[(_ ID STX) #'(define-syntax-parameter ID STX)]
[(_ [ID VAL]) #'(define-syntax-parameter ID (λ (stx) #'VAL))]
[(_ ID) #'(define-syntax-parameter ID
(λ (stx) (raise-syntax-error (syntax-e stx) "parameter not set")))]))
(define-syntax-rule (define-syntax-parameters ID ...)
(begin (br:define-syntax-parameter ID) ...))
(define-syntax-rule (define-language-variable ID VAL)
(br:define-syntax-parameter [ID VAL]))
(define-syntax-rule (define-language-variables [ID VAL] ...)
(begin (define-language-variable ID VAL) ...))
(define-syntax (inject-language-variables stx)
(syntax-case stx ()
[(_ (VAR-PARAM ...) LANG-CODE ...)
(with-syntax ([(HOLDS-ORIG-PARAM-VALUE ...) (generate-temporaries #'(VAR-PARAM ...))]
[(INTERNAL-NAME ...) (generate-temporaries #'(VAR-PARAM ...))])
;; need to use splicing expressions in a module-begin to compose with requires etc. that might be in lang code
#'(splicing-let ([HOLDS-ORIG-PARAM-VALUE VAR-PARAM] ...)
(splicing-syntax-parameterize
([VAR-PARAM (make-rename-transformer #'INTERNAL-NAME)] ...)
(define INTERNAL-NAME HOLDS-ORIG-PARAM-VALUE) ...
(provide (rename-out [INTERNAL-NAME VAR-PARAM] ...))
LANG-CODE ...)))]))