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
156
module Re = Core
exception Parse_error
exception Not_supported
let parse newline s =
let i = ref 0 in
let l = String.length s in
let eos () = !i = l in
let test c = not (eos ()) && s.[!i] = c in
let accept c = let r = test c in if r then incr i; r in
let get () = let r = s.[!i] in incr i; r in
let unget () = decr i 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 integer () with
Some i ->
let j = if accept ',' then integer () else Some i in
if not (accept '}') then raise Parse_error;
begin match j with
Some j when j < i -> raise Parse_error | _ -> ()
end;
Re.repn (Re.nest r) i j
| None ->
unget (); r
else
r
and atom () =
if accept '.' then begin
if newline then Re.notnl else Re.any
end else if accept '(' then begin
let r = regexp () in
if not (accept ')') then raise Parse_error;
Re.group r
end else
if accept '^' then begin
if newline then Re.bol else Re.bos
end else if accept '$' then begin
if newline then Re.eol else Re.eos
end else if accept '[' then begin
if accept '^' then
Re.diff (Re.compl (bracket [])) (Re.char '\n')
else
Re.alt (bracket [])
end else
if accept '\\' then begin
if eos () then raise Parse_error;
match get () with
'|' | '(' | ')' | '*' | '+' | '?'
| '[' | '.' | '^' | '$' | '{' | '\\' as c -> Re.char c
| _ -> raise Parse_error
end else begin
if eos () then raise Parse_error;
match get () with
'*' | '+' | '?' | '{' | '\\' -> raise Parse_error
| c -> Re.char c
end
and integer () =
if eos () then None else
match get () with
'0'..'9' as d -> integer' (Char.code d - Char.code '0')
| _ -> unget (); None
and integer' i =
if eos () then Some i else
match get () with
'0'..'9' as d ->
let i' = 10 * i + (Char.code d - Char.code '0') in
if i' < i then raise Parse_error;
integer' i'
| _ ->
unget (); Some i
and bracket s =
if s <> [] && accept ']' then s else begin
let c = char () in
if accept '-' then begin
if accept ']' then Re.char c :: Re.char '-' :: s else begin
let c' = char () in
bracket (Re.rg c c' :: s)
end
end else
bracket (Re.char c :: s)
end
and char () =
if eos () then raise Parse_error;
let c = get () in
if c = '[' then begin
if accept '=' then raise Not_supported
else if accept ':' then begin
raise Not_supported
end else if accept '.' then begin
if eos () then raise Parse_error;
let c = get () in
if not (accept '.') then raise Not_supported;
if not (accept ']') then raise Parse_error;
c
end else
c
end else
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)