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

Loading…
Cancel
Save