1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
module Re = Core
exception Parse_error = Parse_buffer.Parse_error
exception Not_supported
let parse newline s =
let buf = Parse_buffer.create s in
let accept = Parse_buffer.accept buf in
let eos () = Parse_buffer.eos buf in
let test c = Parse_buffer.test buf c in
let unget () = Parse_buffer.unget buf in
let get () = Parse_buffer.get buf in
let rec regexp () = regexp' (branch ())
and regexp' left = if accept '|' then regexp' (Re.alt [ left; branch () ]) else left
and branch () = branch' []
and branch' left =
if eos () || test '|' || test ')'
then Re.seq (List.rev left)
else branch' (piece () :: left)
and piece () =
let r = atom () in
if accept '*'
then Re.rep (Re.nest r)
else if accept '+'
then Re.rep1 (Re.nest r)
else if accept '?'
then Re.opt r
else if accept '{'
then (
match Parse_buffer.integer buf with
| Some i ->
let j = if accept ',' then Parse_buffer.integer buf else Some i in
if not (accept '}') then raise Parse_error;
(match j with
| Some j when j < i -> raise Parse_error
| _ -> ());
Re.repn (Re.nest r) i j
| None ->
unget ();
r)
else r
and atom () =
if accept '.'
then if newline then Re.notnl else Re.any
else if accept '('
then (
let r = regexp () in
if not (accept ')') then raise Parse_error;
Re.group r)
else if accept '^'
then if newline then Re.bol else Re.bos
else if accept '$'
then if newline then Re.eol else Re.eos
else if accept '['
then
if accept '^'
then Re.diff (Re.compl (bracket [])) (Re.char '\n')
else Re.alt (bracket [])
else if accept '\\'
then (
if eos () then raise Parse_error;
match get () with
| ('|' | '(' | ')' | '*' | '+' | '?' | '[' | '.' | '^' | '$' | '{' | '\\') as c ->
Re.char c
| _ -> raise Parse_error)
else (
if eos () then raise Parse_error;
match get () with
| '*' | '+' | '?' | '{' | '\\' -> raise Parse_error
| c -> Re.char c)
and bracket s =
if s <> [] && accept ']'
then s
else (
match char () with
| `Set st -> bracket (st :: s)
| `Char c ->
if accept '-'
then
if accept ']'
then Re.char c :: Re.char '-' :: s
else
bracket
(match char () with
| `Char c' -> Re.rg c c' :: s
| `Set st' -> Re.char c :: Re.char '-' :: st' :: s)
else bracket (Re.char c :: s))
and char () =
if eos () then raise Parse_error;
let c = get () in
if c = '['
then (
match Posix_class.parse buf with
| Some set -> `Set set
| None ->
if accept '.'
then (
if eos () then raise Parse_error;
let c = get () in
if not (accept '.') then raise Not_supported;
if not (accept ']') then raise Parse_error;
`Char c)
else `Char c)
else `Char c
in
let res = regexp () in
if not (eos ()) then raise Parse_error;
res
;;
type opt =
[ `ICase
| `NoSub
| `Newline
]
let re ?(opts = []) s =
let r = parse (List.memq `Newline opts) s in
let r = if List.memq `ICase opts then Re.no_case r else r in
let r = if List.memq `NoSub opts then Re.no_group r else r in
r
;;
let compile re = Re.compile (Re.longest re)
let compile_pat ?(opts = []) s = compile (re ~opts s)