humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

when parsing NFA, label position of leaves (each leaf is either a CHAR_LITERAL or a WILDCARD)

Browse Source
This commit is contained in:
Humza Shahid
2025-10-01 11:23:41 +01:00
parent 31f70a6748
commit 9584bca7ee
1 changed files with 45 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
fcore/search-list/nfa.sml
View File

@@ -1,14 +1,14 @@
structure Nfa = structure Nfa =
struct struct
datatype regex = datatype regex =
CHAR_LITERAL of char CHAR_LITERAL of {char: char, position: int}
| CONCAT of regex list | CONCAT of regex list
| ALTERNATION of regex list | ALTERNATION of regex list
| ZERO_OR_ONE of regex | ZERO_OR_ONE of regex
| ZERO_OR_MORE of regex | ZERO_OR_MORE of regex
| ONE_OR_MORE of regex | ONE_OR_MORE of regex
| GROUP of regex | GROUP of regex
| WILDCARD | WILDCARD of int
structure ParseNfa = structure ParseNfa =
struct struct
@@ -37,15 +37,15 @@ struct
fun getRightParenIdx (pos, str) = loop (pos, str, 1, 0) fun getRightParenIdx (pos, str) = loop (pos, str, 1, 0)
end end
fun climb (pos, str, lhs, level) : (int * regex) option = fun climb (pos, str, lhs, level, stateNum) : (int * regex * int) option =
if pos = String.size str then if pos = String.size str then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
case String.sub (str, pos) of case String.sub (str, pos) of
#")" => SOME (pos + 1, lhs) #")" => SOME (pos + 1, lhs, stateNum)
| #"(" => | #"(" =>
if level < groupLevel then if level < groupLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
(case getRightParenIdx (pos + 1, str) of (case getRightParenIdx (pos + 1, str) of
SOME groupEndIdx => SOME groupEndIdx =>
@@ -53,34 +53,40 @@ struct
val substr = String.substring val substr = String.substring
(str, pos + 1, groupEndIdx - pos - 1) (str, pos + 1, groupEndIdx - pos - 1)
in in
(case parse substr of (case parse (substr, stateNum) of
SOME rhs => SOME (rhs, stateNum) =>
let let
val rhs = GROUP rhs val rhs = GROUP rhs
val result = CONCAT [lhs, rhs] val result = CONCAT [lhs, rhs]
in in
climb (groupEndIdx + 1, str, result, groupLevel) climb
( groupEndIdx + 1
, str
, result
, groupLevel
, stateNum
)
end end
| NONE => NONE) | NONE => NONE)
end end
| NONE => NONE) | NONE => NONE)
| #"|" => | #"|" =>
if level < altLevel then if level < altLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else if pos + 1 < String.size str then else if pos + 1 < String.size str then
let let
val chr = String.sub (str, pos + 1) val chr = String.sub (str, pos + 1)
val chr = CHAR_LITERAL chr val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
in in
case climb (pos + 2, str, chr, altLevel) of case climb (pos + 2, str, chr, altLevel, stateNum + 1) of
SOME (pos, rhs) => SOME (pos, rhs, stateNum) =>
let let
val result = val result =
case rhs of case rhs of
ALTERNATION lst => ALTERNATION (lhs :: lst) ALTERNATION lst => ALTERNATION (lhs :: lst)
| _ => ALTERNATION [lhs, rhs] | _ => ALTERNATION [lhs, rhs]
in in
SOME (pos, result) SOME (pos, result, stateNum)
end end
| NONE => NONE | NONE => NONE
end end
@@ -88,68 +94,74 @@ struct
NONE NONE
| #"?" => | #"?" =>
if level < postfixLevel then if level < postfixLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
let val lhs = ZERO_OR_ONE lhs let val lhs = ZERO_OR_ONE lhs
in climb (pos + 1, str, lhs, postfixLevel) in climb (pos + 1, str, lhs, postfixLevel, stateNum)
end end
| #"*" => | #"*" =>
if level < postfixLevel then if level < postfixLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
let val lhs = ZERO_OR_MORE lhs let val lhs = ZERO_OR_MORE lhs
in climb (pos + 1, str, lhs, postfixLevel) in climb (pos + 1, str, lhs, postfixLevel, stateNum)
end end
| #"+" => | #"+" =>
if level < postfixLevel then if level < postfixLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
let val lhs = ONE_OR_MORE lhs let val lhs = ONE_OR_MORE lhs
in climb (pos + 1, str, lhs, postfixLevel) in climb (pos + 1, str, lhs, postfixLevel, stateNum)
end end
| chr => | chr =>
if level < concatLevel then if level < concatLevel then
SOME (pos, lhs) SOME (pos, lhs, stateNum)
else else
let let
val currentState = val currentState =
if chr = #"." then WILDCARD else CHAR_LITERAL chr if chr = #"." then WILDCARD (stateNum + 1)
else CHAR_LITERAL {char = chr, position = stateNum + 1}
in in
case climb (pos + 1, str, currentState, concatLevel) of case
SOME (pos, rhs) => climb (pos + 1, str, currentState, concatLevel, stateNum + 1)
of
SOME (pos, rhs, stateNum) =>
let let
val result = val result =
case rhs of case rhs of
CONCAT lst => CONCAT (lhs :: lst) CONCAT lst => CONCAT (lhs :: lst)
| _ => CONCAT [lhs, rhs] | _ => CONCAT [lhs, rhs]
in in
SOME (pos, result) SOME (pos, result, stateNum)
end end
| NONE => NONE | NONE => NONE
end end
and loop (pos, str, ast) = and loop (pos, str, ast, stateNum) =
if pos = String.size str then if pos = String.size str then
SOME ast SOME (ast, stateNum)
else else
case climb (pos, str, ast, altLevel) of case climb (pos, str, ast, altLevel, stateNum) of
SOME (pos, ast) => loop (pos, str, ast) SOME (pos, ast, stateNum) => loop (pos, str, ast, stateNum)
| NONE => NONE | NONE => NONE
and parse str = and parse (str, stateNum) =
if String.size str > 0 then if String.size str > 0 then
(* todo: we currently assume that the first char is always a CHAR_LITERAL (* todo: we currently assume that the first char is always a CHAR_LITERAL
* but we should actually check what character the chr is * but we should actually check what character the chr is
* before deciding it represents one variant or another *) * before deciding it represents one variant or another *)
let let
val chr = String.sub (str, 0) val chr = String.sub (str, 0)
val chr = CHAR_LITERAL chr val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
in in
loop (1, str, chr) loop (1, str, chr, stateNum + 1)
end end
else else
NONE NONE
end end
val parse = ParseNfa.parse fun parse str =
case ParseNfa.parse (str, 0) of
SOME (ast, _) => SOME ast
| NONE => NONE
end end