113 lines
3.0 KiB
Standard ML
113 lines
3.0 KiB
Standard ML
structure Nfa =
|
|
struct
|
|
datatype regex =
|
|
CONCAT of regex * regex
|
|
| CHAR_LITERAL of char
|
|
| ALTERNATION of regex * regex
|
|
| ZERO_OR_ONE of regex
|
|
| ZERO_OR_MORE of regex
|
|
| ONE_OR_MORE of regex
|
|
| GROUP of regex
|
|
|
|
val groupLevel = 1
|
|
val postfixLevel = 2
|
|
val concatLevel = 3
|
|
val altLevel = 4
|
|
|
|
local
|
|
fun loop (pos, str, openParens, closeParens) =
|
|
if pos = String.size str then
|
|
pos
|
|
else
|
|
case String.sub (str, pos) of
|
|
#"(" => loop (pos + 1, str, openParens + 1, closeParens)
|
|
| #")" =>
|
|
if closeParens + 1 = openParens then pos
|
|
else loop (pos + 1, str, openParens, closeParens + 1)
|
|
| _ => loop (pos + 1, str, openParens, closeParens)
|
|
in
|
|
fun getRightParenIdx (pos, str) = loop (pos, str, 1, 0)
|
|
end
|
|
|
|
fun helpClimb (pos, str, lhs, level) =
|
|
if pos = String.size str then
|
|
(pos, lhs)
|
|
else
|
|
case String.sub (str, pos) of
|
|
#")" => (pos + 1, lhs)
|
|
| #"(" =>
|
|
if level < groupLevel then
|
|
(pos, lhs)
|
|
else
|
|
let
|
|
val groupEndIdx = getRightParenIdx (pos + 1, str)
|
|
val substr = String.substring
|
|
(str, pos + 1, groupEndIdx - pos - 1)
|
|
val rhs = climb substr
|
|
val rhs = GROUP rhs
|
|
val result = CONCAT (lhs, rhs)
|
|
in
|
|
helpClimb (groupEndIdx + 1, str, result, groupLevel)
|
|
end
|
|
| #"|" =>
|
|
if level < altLevel then
|
|
(pos, lhs)
|
|
else
|
|
let
|
|
val chr = String.sub (str, pos + 1)
|
|
val chr = CHAR_LITERAL chr
|
|
val (pos, rhs) = helpClimb (pos + 2, str, chr, altLevel)
|
|
val result = ALTERNATION (lhs, rhs)
|
|
in
|
|
(pos, result)
|
|
end
|
|
| #"?" =>
|
|
if level < postfixLevel then
|
|
(pos, lhs)
|
|
else
|
|
let val lhs = ZERO_OR_ONE lhs
|
|
in helpClimb (pos + 1, str, lhs, postfixLevel)
|
|
end
|
|
| #"*" =>
|
|
if level < postfixLevel then
|
|
(pos, lhs)
|
|
else
|
|
let val lhs = ZERO_OR_MORE lhs
|
|
in helpClimb (pos + 1, str, lhs, postfixLevel)
|
|
end
|
|
| #"+" =>
|
|
if level < postfixLevel then
|
|
(pos, lhs)
|
|
else
|
|
let val lhs = ONE_OR_MORE lhs
|
|
in helpClimb (pos + 1, str, lhs, postfixLevel)
|
|
end
|
|
| chr =>
|
|
if level < concatLevel then
|
|
(pos, lhs)
|
|
else
|
|
let
|
|
val chr = CHAR_LITERAL chr
|
|
val (pos, rhs) = helpClimb (pos + 1, str, chr, concatLevel)
|
|
val result = CONCAT (lhs, rhs)
|
|
in
|
|
(pos, result)
|
|
end
|
|
|
|
and loop (pos, str, ast) =
|
|
if pos = String.size str then
|
|
ast
|
|
else
|
|
let val (pos, ast) = helpClimb (pos, str, ast, altLevel)
|
|
in loop (pos, str, ast)
|
|
end
|
|
|
|
and climb str =
|
|
let
|
|
val chr = String.sub (str, 0)
|
|
val chr = CHAR_LITERAL chr
|
|
in
|
|
loop (1, str, chr)
|
|
end
|
|
end
|