`generate-literals`: treat nonalphabetic identifiers as literals
parent
a5dc7b4ea7
commit
e4a39ee906
@ -1,17 +1,21 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "syntax-flatten.rkt")
|
(require "syntax-flatten.rkt")
|
||||||
(provide (all-defined-out))
|
(provide generate-literals)
|
||||||
|
|
||||||
|
(define (literal-identifier? pat-datum)
|
||||||
|
(and (symbol? pat-datum)
|
||||||
|
(not (memq pat-datum '(... _))) ; isn't a reserved identifier
|
||||||
|
(let ([pat-str (symbol->string pat-datum)])
|
||||||
|
(or (not (regexp-match #rx"[A-Z]" pat-str)) ; either doesn't contain at least one uppercase letter ...
|
||||||
|
(not (equal? (string-upcase pat-str) pat-str)))))) ;... or doesn't contain all uppercase letters
|
||||||
|
|
||||||
;; generate literals for any symbols that are not ... or _ and not IN_CAPS
|
;; generate literals for any symbols that are not ... or _ and not IN_CAPS
|
||||||
(define (generate-literals pats)
|
(define (generate-literals pats)
|
||||||
(for*/list ([pat-arg (in-list (syntax-flatten pats))]
|
(for*/list ([pat-arg (in-list (syntax-flatten pats))]
|
||||||
[pat-datum (in-value (syntax->datum pat-arg))]
|
[pat-datum (in-value (syntax->datum pat-arg))]
|
||||||
#:when (and (symbol? pat-datum)
|
#:when (literal-identifier? pat-datum))
|
||||||
(not (memq pat-datum '(... _))) ; exempted from literality
|
|
||||||
(let ([pat-str (symbol->string pat-datum)])
|
|
||||||
(not (equal? (string-upcase pat-str) pat-str)))))
|
|
||||||
pat-arg))
|
pat-arg))
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(check-equal? (map syntax->datum (generate-literals #'(foo 42 BAR _ bar 3bar))) '(foo bar 3bar)))
|
(check-equal? (map syntax->datum (generate-literals #'(foo 42 BAR _ (... ...) bar <=> 3Bar 3bar))) '(foo bar <=> 3Bar 3bar)))
|
Loading…
Reference in New Issue