[private] init
This commit is contained in:
parent
a6fb675918
commit
23fccba081
5
private/README.md
Normal file
5
private/README.md
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
private
|
||||||
|
===
|
||||||
|
|
||||||
|
Files that no law-abiding library user should `require`.
|
||||||
|
- `common.rkt` Helper functions common to a few macros.
|
12
private/common.rkt
Normal file
12
private/common.rkt
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide
|
||||||
|
expand-expr
|
||||||
|
;; (-> Syntax Syntax)
|
||||||
|
;; Call local expand for an expression context with an empty list of stop-ids
|
||||||
|
)
|
||||||
|
|
||||||
|
;; =============================================================================
|
||||||
|
|
||||||
|
(define (expand-expr stx)
|
||||||
|
(local-expand stx 'expression '()))
|
10
regexp.rkt
10
regexp.rkt
|
@ -27,6 +27,7 @@
|
||||||
racket/syntax
|
racket/syntax
|
||||||
syntax/id-table
|
syntax/id-table
|
||||||
syntax/parse
|
syntax/parse
|
||||||
|
trivial/private/common
|
||||||
))
|
))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
|
@ -53,7 +54,7 @@
|
||||||
[g:id
|
[g:id
|
||||||
(syntax/loc #'g f)]
|
(syntax/loc #'g f)]
|
||||||
[(_ pat-stx)
|
[(_ pat-stx)
|
||||||
#:with pat-stx+ (regexp-expand #'pat-stx)
|
#:with pat-stx+ (expand-expr #'pat-stx)
|
||||||
#:with (num-groups . T) (count-groups #'pat-stx+)
|
#:with (num-groups . T) (count-groups #'pat-stx+)
|
||||||
(syntax-property #'(f pat-stx+)
|
(syntax-property #'(f pat-stx+)
|
||||||
num-groups-key
|
num-groups-key
|
||||||
|
@ -64,7 +65,7 @@
|
||||||
(define-syntax define-f:
|
(define-syntax define-f:
|
||||||
(syntax-parser
|
(syntax-parser
|
||||||
[(_ name:id pat-stx)
|
[(_ name:id pat-stx)
|
||||||
#:with pat-stx+ (regexp-expand #'pat-stx)
|
#:with pat-stx+ (expand-expr #'pat-stx)
|
||||||
#:with (num-groups . T) (count-groups #'pat-stx+)
|
#:with (num-groups . T) (count-groups #'pat-stx+)
|
||||||
(free-id-table-set! id+num-groups
|
(free-id-table-set! id+num-groups
|
||||||
#'name
|
#'name
|
||||||
|
@ -81,7 +82,7 @@
|
||||||
(define-syntax regexp-match:
|
(define-syntax regexp-match:
|
||||||
(syntax-parser
|
(syntax-parser
|
||||||
[(f pat-stx arg* ...)
|
[(f pat-stx arg* ...)
|
||||||
#:with pat-stx+ (regexp-expand #'pat-stx)
|
#:with pat-stx+ (expand-expr #'pat-stx)
|
||||||
#:with (num-groups . T) (count-groups #'pat-stx+)
|
#:with (num-groups . T) (count-groups #'pat-stx+)
|
||||||
#:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
|
#:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
|
||||||
#'(let ([maybe-match (regexp-match pat-stx+ arg* ...)])
|
#'(let ([maybe-match (regexp-match pat-stx+ arg* ...)])
|
||||||
|
@ -105,9 +106,6 @@
|
||||||
(format "Valid regexp pattern (contains unmatched ~a)" reason)
|
(format "Valid regexp pattern (contains unmatched ~a)" reason)
|
||||||
str))
|
str))
|
||||||
|
|
||||||
(define-for-syntax (regexp-expand stx)
|
|
||||||
(local-expand stx 'expression '()))
|
|
||||||
|
|
||||||
(define-for-syntax (quoted-stx-value? stx)
|
(define-for-syntax (quoted-stx-value? stx)
|
||||||
(and
|
(and
|
||||||
(syntax? stx)
|
(syntax? stx)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user