avoid define-syntax-parser for older versions

pull/8/head
AlexKnauth 6 years ago
parent 32e018f333
commit 9ddb20c53c

@ -3,7 +3,6 @@
(provide define+provide+safe+match) (provide define+provide+safe+match)
(require racket/match (require racket/match
syntax/parse/define
(for-syntax racket/base (for-syntax racket/base
racket/syntax racket/syntax
syntax/parse syntax/parse
@ -32,45 +31,47 @@
[(stx-pair? stx) [(stx-pair? stx)
(datum->syntax stx (cons id (stx-cdr stx)) stx stx)]))) (datum->syntax stx (cons id (stx-cdr stx)) stx stx)])))
(define-syntax-parser define+provide+safe+match (define-syntax define+provide+safe+match
(λ (stx)
(syntax-parse stx
[(d (head . args) [(d (head . args)
contract:expr contract:expr
value-body:expr ...+ value-body:expr ...+
#:match-expander match-transformer:expr) #:match-expander match-transformer:expr)
#:with fn-expr (syntax/loc this-syntax (λ args value-body ...)) #:with fn-expr (syntax/loc stx (λ args value-body ...))
(syntax/loc this-syntax (syntax/loc stx
(d head contract fn-expr #:match-expander match-transformer))] (d head contract fn-expr #:match-expander match-transformer))]
[(_ name:id [(_ name:id
contract:expr contract:expr
value:expr value:expr
#:match-expander match-transformer:expr) #:match-expander match-transformer:expr)
#:with internal-name (generate-temporary #'name) #:with internal-name (generate-temporary #'name)
#:with contract-name (generate-temporary #'name) #:with contract-name (generate-temporary #'name)
#:with make-name-match-transformer (generate-temporary #'name) #:with make-name-match-transformer (generate-temporary #'name)
#'(begin #'(begin
(define internal-name (let ([name value]) name)) (define internal-name (let ([name value]) name))
(begin-for-syntax (begin-for-syntax
(define (make-name-match-transformer name) (define (make-name-match-transformer name)
(with-syntax ([name name]) match-transformer))) (with-syntax ([name name]) match-transformer)))
(define-match-expander name (define-match-expander name
(make-name-match-transformer (quote-syntax internal-name)) (make-name-match-transformer (quote-syntax internal-name))
(variable-like-transformer (quote-syntax internal-name))) (variable-like-transformer (quote-syntax internal-name)))
(provide name) (provide name)
(module+ safe (module+ safe
(require racket/contract/base) (require racket/contract/base)
(define-module-boundary-contract contract-name internal-name contract (define-module-boundary-contract contract-name internal-name contract
#:name-for-blame name) #:name-for-blame name)
(define-match-expander name (define-match-expander name
(make-name-match-transformer (quote-syntax contract-name)) (make-name-match-transformer (quote-syntax contract-name))
(variable-like-transformer (quote-syntax contract-name))) (variable-like-transformer (quote-syntax contract-name)))
(provide name)))]) (provide name)))])))

Loading…
Cancel
Save