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