Move make-variable-like-transformer to syntax/transformer.
This commit is contained in:
parent
442db8d523
commit
7e93b7d426
28
racket/collects/syntax/transformer.rkt
Normal file
28
racket/collects/syntax/transformer.rkt
Normal file
|
@ -0,0 +1,28 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require (for-template racket/base))
|
||||||
|
|
||||||
|
(provide make-variable-like-transformer)
|
||||||
|
|
||||||
|
(define (make-variable-like-transformer ref-stx [set!-handler #f])
|
||||||
|
(unless (syntax? ref-stx)
|
||||||
|
(raise-type-error 'make-variable-like-transformer "syntax?" ref-stx))
|
||||||
|
(unless (or (syntax? set!-handler) (procedure? set!-handler) (eq? set!-handler #f))
|
||||||
|
(raise-type-error 'make-variable-like-transformer "(or/c syntax? procedure? #f)" set!-handler))
|
||||||
|
(make-set!-transformer
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-case stx (set!)
|
||||||
|
[id
|
||||||
|
(identifier? #'id)
|
||||||
|
ref-stx]
|
||||||
|
[(set! id val)
|
||||||
|
(cond [(procedure? set!-handler)
|
||||||
|
(set!-handler stx)]
|
||||||
|
[(syntax? set!-handler)
|
||||||
|
(with-syntax ([setter set!-handler])
|
||||||
|
(syntax/loc stx (setter val)))]
|
||||||
|
[else
|
||||||
|
(raise-syntax-error #f "cannot mutate identifier" stx #'id)])]
|
||||||
|
[(id . args)
|
||||||
|
(let ([stx* (cons #'(#%expression id) (cdr (syntax-e stx)))])
|
||||||
|
(datum->syntax stx stx* stx))]))))
|
|
@ -2,7 +2,8 @@
|
||||||
;; owner: ryanc (and cce and stamourv, where noted)
|
;; owner: ryanc (and cce and stamourv, where noted)
|
||||||
(require racket/syntax
|
(require racket/syntax
|
||||||
(for-syntax racket/base)
|
(for-syntax racket/base)
|
||||||
(for-template racket/base))
|
(for-template racket/base)
|
||||||
|
syntax/transformer) ; for re-export
|
||||||
|
|
||||||
(provide ;; by endobson
|
(provide ;; by endobson
|
||||||
syntax-length
|
syntax-length
|
||||||
|
@ -18,6 +19,8 @@
|
||||||
;; by ryanc
|
;; by ryanc
|
||||||
explode-module-path-index
|
explode-module-path-index
|
||||||
phase-of-enclosing-module
|
phase-of-enclosing-module
|
||||||
|
|
||||||
|
;; re-export, for backwards compatibility
|
||||||
make-variable-like-transformer)
|
make-variable-like-transformer)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -81,29 +84,6 @@
|
||||||
(variable-reference->module-base-phase
|
(variable-reference->module-base-phase
|
||||||
(#%variable-reference)))
|
(#%variable-reference)))
|
||||||
|
|
||||||
(define (make-variable-like-transformer ref-stx [set!-handler #f])
|
|
||||||
(unless (syntax? ref-stx)
|
|
||||||
(raise-type-error 'make-variable-like-transformer "syntax?" ref-stx))
|
|
||||||
(unless (or (syntax? set!-handler) (procedure? set!-handler) (eq? set!-handler #f))
|
|
||||||
(raise-type-error 'make-variable-like-transformer "(or/c syntax? procedure? #f)" set!-handler))
|
|
||||||
(make-set!-transformer
|
|
||||||
(lambda (stx)
|
|
||||||
(syntax-case stx (set!)
|
|
||||||
[id
|
|
||||||
(identifier? #'id)
|
|
||||||
ref-stx]
|
|
||||||
[(set! id val)
|
|
||||||
(cond [(procedure? set!-handler)
|
|
||||||
(set!-handler stx)]
|
|
||||||
[(syntax? set!-handler)
|
|
||||||
(with-syntax ([setter set!-handler])
|
|
||||||
(syntax/loc stx (setter val)))]
|
|
||||||
[else
|
|
||||||
(raise-syntax-error #f "cannot mutate identifier" stx #'id)])]
|
|
||||||
[(id . args)
|
|
||||||
(let ([stx* (cons #'(#%expression id) (cdr (syntax-e stx)))])
|
|
||||||
(datum->syntax stx stx* stx))]))))
|
|
||||||
|
|
||||||
;; by endobson
|
;; by endobson
|
||||||
|
|
||||||
(define (syntax-length stx)
|
(define (syntax-length stx)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user