105 lines
3.5 KiB
Racket
105 lines
3.5 KiB
Racket
#lang typed/racket/base
|
|
|
|
;; TODO byte-regexp
|
|
|
|
(provide
|
|
regexp!
|
|
;; (-> String Regexp)
|
|
|
|
pregexp!
|
|
;; (-> String Regexp)
|
|
|
|
regexp-match!
|
|
;; (-> Pattern String Any * (U #f (List String *N+1)))
|
|
;; Match the regular expression pattern against a string.
|
|
;; If the pattern is determined statically, result will be either #f
|
|
;; or a list of N+1 strings, where N is the number of groups specified
|
|
;; the pattern.
|
|
;;
|
|
;; Will raise a compile-time exception if the pattern contains unmatched groups.
|
|
)
|
|
|
|
(require
|
|
(for-syntax racket/base syntax/parse racket/syntax))
|
|
|
|
;; =============================================================================
|
|
|
|
(define-for-syntax num-groups-key 'num-groups)
|
|
|
|
;; TODO abstract these macros?
|
|
(define-syntax regexp!
|
|
(syntax-parser
|
|
[(_ x:str)
|
|
(syntax-property #'(regexp x) num-groups-key (count-groups/regexp (syntax-e #'x)))]
|
|
[(_ arg* ...)
|
|
#'(regexp arg* ...)]))
|
|
|
|
(define-syntax pregexp!
|
|
(syntax-parser
|
|
[(_ x:str)
|
|
(syntax-property #'(pregexp x) num-groups-key (count-groups/pregexp (syntax-e #'x)))]
|
|
[(_ arg* ...)
|
|
#'(pregexp arg* ...)]))
|
|
|
|
(define-syntax regexp-match!
|
|
(syntax-parser
|
|
[(f pat-stx arg* ...)
|
|
#:with num-groups (count-groups #'pat-stx #:src #'f)
|
|
#:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
|
|
#'(let ([maybe-match (regexp-match pat-stx arg* ...)])
|
|
(if maybe-match
|
|
(let ([m : (Listof (Option String)) maybe-match])
|
|
(list (car maybe-match)
|
|
(begin (set! m (cdr m))
|
|
(or (car m) (error 'regexp-match! (format "Internal error at result index ~a, try Racket's regexp-match" index*))))
|
|
...))
|
|
#f))]
|
|
[(f arg* ...)
|
|
(syntax/loc #'f (regexp-match arg* ...))]))
|
|
|
|
(define-for-syntax (count-groups v-stx #:src stx)
|
|
(or (syntax-property v-stx num-groups-key)
|
|
(let ([v (format "~a" (syntax-e v-stx))])
|
|
(cond
|
|
[(string? v) (count-groups/string v #:src stx)]
|
|
;[(regexp? v) (count-groups/regexp v #:src stx)]
|
|
;[(pregexp? v) (count-groups/pregexp v #:src stx)]
|
|
;[(byte-regexp? v) (count-groups/byte-regexp v #:src stx)]
|
|
;[(byte-pregexp? v) (count-groups/byte-pregexp v #:src stx)]
|
|
[else (error 'regexp-match! "Internal error on input" v)]))))
|
|
|
|
;; Count the number of matched parentheses in a regexp pattern.
|
|
;; Raise an exception if there are unmatched parens.
|
|
(define-for-syntax (count-groups/string str #:src stx)
|
|
(define last-index (- (string-length str) 1))
|
|
(let loop ([i 0] [in-paren #f] [num-groups 0])
|
|
(if (> i last-index)
|
|
(if in-paren
|
|
(group-error str (format "'(' at index ~a" in-paren))
|
|
num-groups)
|
|
(case (string-ref str i)
|
|
[(#\()
|
|
(loop (+ i 1) i num-groups)]
|
|
[(#\))
|
|
(unless in-paren
|
|
(group-error str (format "')' at index ~a" i)))
|
|
(loop (+ i 1) #f (+ 1 num-groups))]
|
|
[(#\\)
|
|
(if (and (< i last-index) (eq? #\\ (string-ref str (+ i 1))))
|
|
(loop (+ i 3) in-paren num-groups)
|
|
(loop (+ i 2) in-paren num-groups))]
|
|
[else
|
|
(loop (+ i 1) in-paren num-groups)]))))
|
|
|
|
(define-for-syntax (count-groups/regexp rxp #:src stx)
|
|
(error 'regexp-match! "Not implemented"))
|
|
|
|
(define-for-syntax (count-groups/pregexp pxp #:src stx)
|
|
(error 'regexp-match! "Not implemented"))
|
|
|
|
(define-for-syntax (group-error str reason)
|
|
(raise-argument-error
|
|
'regexp-match!
|
|
(format "Valid regexp pattern (contains unmatched ~a)" reason)
|
|
str))
|