Compare commits
No commits in common. "master" and "fix-use-site-scope" have entirely different histories.
master
...
fix-use-si
|
@ -27,8 +27,7 @@
|
|||
(define-for-syntax (make-?-expander transformer)
|
||||
(expander ?-expander-type transformer))
|
||||
(define-for-syntax (?-expander? v)
|
||||
(and (expander? v)
|
||||
(expander-of-type? ?-expander-type v)))
|
||||
(expander-of-type? ?-expander-type v))
|
||||
(define-syntax define-?-expander
|
||||
(syntax-parser
|
||||
[(_ expander-name:id transformer:expr)
|
||||
|
|
|
@ -23,7 +23,6 @@ expanders for use with other macros.
|
|||
environment}
|
||||
@item{@code{expand-all-id-expanders} - a procedure bound at phase
|
||||
@; TODO: expand-all-expanders-of-type is not documented
|
||||
level 1 that's equivalent to
|
||||
@racket[expand-syntax-tree-with-expanders-of-type] with the
|
||||
@code{id-expander-type} as the type argument}
|
||||
level 1 that's equivalent to @racket[expand-all-expanders-of-type] with
|
||||
the @code{id-expander-type} as the type argument}
|
||||
]}
|
||||
|
|
|
@ -4,14 +4,16 @@
|
|||
syntax/parse
|
||||
syntax/stx
|
||||
predicates
|
||||
fancy-app
|
||||
racket/syntax)
|
||||
fancy-app)
|
||||
|
||||
(provide (struct-out expander)
|
||||
(contract-out
|
||||
[expander-of-type? (-> expander-type? expander? boolean?)]
|
||||
[expand-syntax-tree-with-expanders-of-type (-> expander-type? syntax? syntax?)]))
|
||||
|
||||
(define (maybe-syntax-local-value stx)
|
||||
(syntax-local-value stx (λ () #f)))
|
||||
|
||||
(struct expander (type transformer))
|
||||
|
||||
(define (expander-of-type? type expander)
|
||||
|
@ -20,12 +22,12 @@
|
|||
(define (expander-stx? v)
|
||||
(and (syntax? v)
|
||||
(syntax-parse v
|
||||
[(id:id . _) (syntax-local-value/record #'id expander?)]
|
||||
[(id:id _ ...) (expander? (maybe-syntax-local-value #'id))]
|
||||
[_ #f])))
|
||||
|
||||
(define (expander-stx->expander expander-stx)
|
||||
(syntax-parse expander-stx
|
||||
[(id:id . _) (syntax-local-value/record #'id expander?)]))
|
||||
[(id:id _ ...) (maybe-syntax-local-value #'id)]))
|
||||
|
||||
(define (expander-stx-of-type? type v)
|
||||
(and (expander-stx? v)
|
||||
|
@ -45,7 +47,6 @@
|
|||
|
||||
(define (expand-syntax-tree-with-expanders-of-type type stx)
|
||||
(define not-expander-stx-of-type? (not? (expander-stx-of-type? type _)))
|
||||
(with-disappeared-uses
|
||||
(expand-syntax-tree not-expander-stx-of-type?
|
||||
call-expander-transformer
|
||||
stx)))
|
||||
stx))
|
|
@ -1,13 +0,0 @@
|
|||
#lang racket
|
||||
(require generic-syntax-expanders rackunit)
|
||||
(define-expander-type foo)
|
||||
(define-foo-expander foo1 (λ _ #''ok))
|
||||
(define-syntax (bar stx)
|
||||
(syntax-case stx ()
|
||||
[(_ body)
|
||||
(expand-all-foo-expanders #'body)]))
|
||||
;; When hovering "foo1" in the code below with the mouse, an arrow should
|
||||
;; be shown in DrRacket from the foo1 in (define-foo-expander foo1 …) above.
|
||||
;; This is not automatically checked, as it would be difficult/brittle to check
|
||||
;; for the syntax property. Patches welcome.
|
||||
(check-equal? (bar (foo1)) 'ok)
|
|
@ -1,22 +0,0 @@
|
|||
#lang racket
|
||||
|
||||
(require generic-syntax-expanders
|
||||
(for-syntax syntax/parse)
|
||||
rackunit)
|
||||
|
||||
(define-expander-type foo)
|
||||
|
||||
(define-foo-expander some-foo-expander
|
||||
(syntax-parser
|
||||
[(_ a:id b:id c:id . d:id) #'(d c b a)]))
|
||||
|
||||
(define-syntax (test-foo-expander stx)
|
||||
(syntax-parse stx
|
||||
[(_ e:expr)
|
||||
#`'#,(expand-all-foo-expanders #'e)]))
|
||||
|
||||
(test-equal?
|
||||
"Check that some-foo-expander accepts being called
|
||||
when it is the first item of a dotted list"
|
||||
(test-foo-expander (some-foo-expander x y z . t))
|
||||
'(t z y x))
|
|
@ -1,61 +0,0 @@
|
|||
#lang racket
|
||||
|
||||
(require generic-syntax-expanders
|
||||
(for-syntax syntax/parse
|
||||
rackunit))
|
||||
(require (for-syntax generic-syntax-expanders))
|
||||
(define-expander-type foo)
|
||||
(define-expander-type other)
|
||||
(define-foo-expander foo-exp (λ (stx) #''foo-exp-is-a-foo-expander))
|
||||
(define-other-expander other-exp (λ (stx) #''other-exp-is-not-a-foo-expander))
|
||||
(define-syntax not-an-expander 'syntax-local-value-is-not-an-expander)
|
||||
(begin-for-syntax
|
||||
(test-not-exn
|
||||
"Check that foo-expander? can be passed any value, not just an expander?"
|
||||
(λ ()
|
||||
(foo-expander? 123)
|
||||
(void)))
|
||||
|
||||
(test-false
|
||||
"Check that (static foo-expander?) rejects syntax that is not an identifier?"
|
||||
(syntax-parse #'(definitely not-a-foo-expander)
|
||||
[(~var exp (static foo-expander? "a foo expander")) #t]
|
||||
[_ #f]))
|
||||
|
||||
(test-false
|
||||
"Check that (static foo-expander?) rejects an id without syntax-local-value"
|
||||
(syntax-parse #'no-syntax-local-value
|
||||
[(~var exp (static foo-expander? "a foo expander")) #t]
|
||||
[_ #f]))
|
||||
|
||||
(test-begin
|
||||
(test-false
|
||||
"Check that foo-expander? rejects an id which is not an expander?"
|
||||
(foo-expander? (syntax-local-value #'not-an-expander)))
|
||||
(test-false
|
||||
"Check that foo-expander? rejects an id which is not an expander?"
|
||||
(syntax-parse #'not-an-expander
|
||||
[(~var exp (static foo-expander? "a foo expander")) #t]
|
||||
[_ #f])))
|
||||
|
||||
(test-begin
|
||||
(test-false
|
||||
(string-append "Check that foo-expander? rejects an id which is an"
|
||||
" expander? but not a foo-expander?")
|
||||
(foo-expander? (syntax-local-value #'other-exp)))
|
||||
(test-false
|
||||
(string-append "Check that foo-expander? rejects an id which is an"
|
||||
" expander? but not a foo-expander?")
|
||||
(syntax-parse #'other-exp
|
||||
[(~var exp (static foo-expander? "a foo expander")) #t]
|
||||
[_ #f])))
|
||||
|
||||
(test-begin
|
||||
(test-true
|
||||
"Check that foo-expander? accepts an id which is a foo-expander?"
|
||||
(foo-expander? (syntax-local-value #'foo-exp)))
|
||||
(test-true
|
||||
"Check that foo-expander? accepts an id which is a foo-expander?"
|
||||
(syntax-parse #'foo-exp
|
||||
[(~var exp (static foo-expander? "a foo expander")) #t]
|
||||
[_ #f]))))
|
Loading…
Reference in New Issue
Block a user