1#lang racket/base 2(require "../common/error.rkt" 3 "../parse/main.rkt" 4 "../analyze/validate.rkt" 5 "../analyze/convert.rkt" 6 "../analyze/anchor.rkt" 7 "../analyze/must-string.rkt" 8 "../analyze/start-range.rkt" 9 "compile.rkt") 10 11(provide (struct-out rx:regexp) 12 make-regexp 13 regexp? 14 byte-regexp? 15 pregexp? 16 byte-pregexp?) 17 18(struct rx:regexp (bytes? ; a bytes matcher (as opposed to string matcher)? 19 px? ; a pregexp (as opposed to pregexp)? 20 source ; original source string/bytes, but made immutable 21 matcher ; compiled matcher function; see "compile.rkt" 22 num-groups ; number of `(...)` groups for reporting submatches 23 references? ; any backreferences in the pattern? 24 max-lookbehind ; max lookbehnd 25 anchored? ; starts with `^`? 26 must-string ; shortcut: a byte string that must appear in a match 27 start-range) ; shortcut: a range that must match the initial byte 28 #:reflection-name 'regexp 29 #:property prop:custom-write (lambda (rx port mode) 30 (write-bytes (if (rx:regexp-px? rx) 31 #"#px" 32 #"#rx") 33 port) 34 (write (rx:regexp-source rx) port)) 35 #:property prop:object-name (struct-field-index source) 36 #:property prop:equal+hash (list 37 (lambda (a b eql?) 38 (and (eq? (rx:regexp-px? a) (rx:regexp-px? b)) 39 (equal? (rx:regexp-source a) (rx:regexp-source b)))) 40 (lambda (a hc) 41 (hc (rx:regexp-source a))) 42 (lambda (a hc) 43 (hc (rx:regexp-source a))))) 44 45(define (make-regexp who orig-p px? as-bytes? handler) 46 (call-with-continuation-prompt 47 (lambda () 48 (define p (if (bytes? orig-p) 49 (bytes->immutable-bytes orig-p) 50 (string->immutable-string orig-p))) 51 (define-values (raw-rx num-groups references?) (parse p #:px? px?)) 52 (define rx (if as-bytes? raw-rx (convert raw-rx))) 53 (define max-lookbehind (validate rx num-groups)) 54 (define matcher (compile rx)) 55 (rx:regexp as-bytes? px? p 56 matcher num-groups references? max-lookbehind 57 (anchored? rx) (get-must-string rx) 58 (get-start-range rx))) 59 regexp-error-tag 60 (lambda (str) 61 (if handler 62 (handler str) 63 (raise-arguments-error who str "pattern" orig-p))))) 64 65(define (regexp? v) 66 (and (rx:regexp? v) 67 (not (rx:regexp-bytes? v)))) 68 69(define (byte-regexp? v) 70 (and (rx:regexp? v) 71 (rx:regexp-bytes? v))) 72 73(define (pregexp? v) 74 (and (rx:regexp? v) 75 (not (rx:regexp-bytes? v)) 76 (rx:regexp-px? v))) 77 78(define (byte-pregexp? v) 79 (and (rx:regexp? v) 80 (rx:regexp-bytes? v) 81 (rx:regexp-px? v))) 82