add `syntax-flatten`

pull/2/head
Matthew Butterick 9 years ago
parent 157787a99f
commit 67ac247f41

@ -1,19 +1,10 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/list racket/base syntax/parse racket/syntax syntax/datum syntax/strip-context racket/string) sugar/define) (require (for-syntax racket/list racket/base syntax/parse br/syntax racket/syntax syntax/datum syntax/strip-context racket/string) sugar/define)
(provide (all-defined-out)) (provide (all-defined-out))
;; everything is prefixed br: whether it needs it or not so it can be stripped by #lang br ;; everything is prefixed br: whether it needs it or not so it can be stripped by #lang br
(define-for-syntax (syntax-flatten stx) (define-for-syntax (upcased? str) (equal? (string-upcase str) str))
(flatten
(let loop ([stx stx])
(define maybe-list (syntax->list stx))
(if maybe-list
(map loop maybe-list)
stx))))
(define-for-syntax (upcased? str)
(equal? (string-upcase str) str))
(define-for-syntax (generate-literals pats) (define-for-syntax (generate-literals pats)
;; generate literals for any symbols that are not ... or _ or _underscore-prefixed ;; generate literals for any symbols that are not ... or _ or _underscore-prefixed

@ -134,3 +134,11 @@
(with-syntax ([id (syntax-local-introduce (syntax-local-get-shadower #'id))] ...) (with-syntax ([id (syntax-local-introduce (syntax-local-get-shadower #'id))] ...)
. body)) . body))
(define (syntax-flatten stx)
(flatten
(let loop ([stx stx])
(define maybe-list (syntax->list stx))
(if maybe-list
(map loop maybe-list)
stx))))
Loading…
Cancel
Save