extract dfa generator to a separate file in repository root, so that it could be reused
This commit is contained in:
@@ -1,928 +0,0 @@
|
||||
signature DFA_GEN_PARAMS =
|
||||
sig
|
||||
val endMarker: char
|
||||
val charIsEqual: char * char -> bool
|
||||
end
|
||||
|
||||
signature DFA_GEN =
|
||||
sig
|
||||
type dfa = int vector vector
|
||||
type dfa_state = int
|
||||
|
||||
val fromString: string -> dfa
|
||||
|
||||
val nextState: dfa * dfa_state * char -> dfa_state
|
||||
val isFinal: dfa * dfa_state -> bool
|
||||
val isDead: dfa_state -> bool
|
||||
|
||||
val matchString: dfa * string -> (int * int) list
|
||||
end
|
||||
|
||||
functor MakeDfaGen(Fn: DFA_GEN_PARAMS): DFA_GEN =
|
||||
struct
|
||||
datatype parse_tree =
|
||||
CHAR_LITERAL of {char: char, position: int}
|
||||
| WILDCARD of int
|
||||
| IS_ANY_CHARACTER of {chars: char vector, position: int}
|
||||
| NOT_ANY_CHARACTER of {chars: char vector, position: int}
|
||||
| CONCAT of
|
||||
{l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int}
|
||||
| ALTERNATION of
|
||||
{l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int}
|
||||
| ZERO_OR_ONE of parse_tree
|
||||
| ZERO_OR_MORE of parse_tree
|
||||
| ONE_OR_MORE of parse_tree
|
||||
| GROUP of parse_tree
|
||||
|
||||
fun isNullable tree =
|
||||
case tree of
|
||||
CHAR_LITERAL _ => false
|
||||
| WILDCARD _ => false
|
||||
| IS_ANY_CHARACTER _ => false
|
||||
| NOT_ANY_CHARACTER _ => false
|
||||
|
||||
| CONCAT {l, r, ...} => isNullable l andalso isNullable r
|
||||
| ALTERNATION {l, r, ...} => isNullable l orelse isNullable r
|
||||
|
||||
| ZERO_OR_ONE _ => true
|
||||
| ZERO_OR_MORE _ => true
|
||||
| ONE_OR_MORE regex => isNullable regex
|
||||
|
||||
| GROUP regex => isNullable regex
|
||||
|
||||
fun firstpos (tree, acc) =
|
||||
case tree of
|
||||
CHAR_LITERAL {position, ...} => position :: acc
|
||||
| IS_ANY_CHARACTER {position, ...} => position :: acc
|
||||
| NOT_ANY_CHARACTER {position, ...} => position :: acc
|
||||
| WILDCARD i => i :: acc
|
||||
|
||||
| CONCAT {l, r, ...} =>
|
||||
if isNullable l then
|
||||
let val acc = firstpos (l, acc)
|
||||
in firstpos (r, acc)
|
||||
end
|
||||
else
|
||||
firstpos (l, acc)
|
||||
| ALTERNATION {l, r, ...} =>
|
||||
let val acc = firstpos (l, acc)
|
||||
in firstpos (r, acc)
|
||||
end
|
||||
|
||||
| ZERO_OR_ONE regex => firstpos (regex, acc)
|
||||
| ZERO_OR_MORE regex => firstpos (regex, acc)
|
||||
| ONE_OR_MORE regex => firstpos (regex, acc)
|
||||
| GROUP regex => firstpos (regex, acc)
|
||||
|
||||
fun lastpos (tree, acc) =
|
||||
case tree of
|
||||
CHAR_LITERAL {position, ...} => position :: acc
|
||||
| IS_ANY_CHARACTER {position, ...} => position :: acc
|
||||
| NOT_ANY_CHARACTER {position, ...} => position :: acc
|
||||
| WILDCARD i => i :: acc
|
||||
|
||||
| CONCAT {l, r, ...} =>
|
||||
if isNullable r then
|
||||
let val acc = lastpos (l, acc)
|
||||
in lastpos (r, acc)
|
||||
end
|
||||
else
|
||||
lastpos (r, acc)
|
||||
| ALTERNATION {l, r, ...} =>
|
||||
let val acc = lastpos (l, acc)
|
||||
in lastpos (r, acc)
|
||||
end
|
||||
|
||||
| ZERO_OR_ONE regex => lastpos (regex, acc)
|
||||
| ZERO_OR_MORE regex => lastpos (regex, acc)
|
||||
| ONE_OR_MORE regex => lastpos (regex, acc)
|
||||
| GROUP regex => lastpos (regex, acc)
|
||||
|
||||
structure Set =
|
||||
struct
|
||||
datatype 'a set = BRANCH of 'a set * int * 'a * 'a set | LEAF
|
||||
|
||||
fun isEmpty set =
|
||||
case set of
|
||||
BRANCH _ => false
|
||||
| LEAF => true
|
||||
|
||||
fun insertOrReplace (newKey, newVal, tree) =
|
||||
case tree of
|
||||
BRANCH (l, curKey, curVal, r) =>
|
||||
if newKey > curKey then
|
||||
let val r = insertOrReplace (newKey, newVal, r)
|
||||
in BRANCH (l, curKey, curVal, r)
|
||||
end
|
||||
else if newKey < curKey then
|
||||
let val l = insertOrReplace (newKey, newVal, l)
|
||||
in BRANCH (l, curKey, curVal, r)
|
||||
end
|
||||
else
|
||||
BRANCH (l, newKey, newVal, r)
|
||||
| LEAF => BRANCH (LEAF, newKey, newVal, LEAF)
|
||||
|
||||
fun addFromList (lst, tree) =
|
||||
case lst of
|
||||
[] => tree
|
||||
| k :: tl =>
|
||||
let val tree = insertOrReplace (k, (), tree)
|
||||
in addFromList (tl, tree)
|
||||
end
|
||||
|
||||
fun getOrDefault (findKey, tree, default) =
|
||||
case tree of
|
||||
BRANCH (l, curKey, curVal, r) =>
|
||||
if findKey > curKey then getOrDefault (findKey, r, default)
|
||||
else if findKey < curKey then getOrDefault (findKey, l, default)
|
||||
else curVal
|
||||
| LEAF => default
|
||||
|
||||
fun helpToList (tree, acc) =
|
||||
case tree of
|
||||
BRANCH (l, curKey, curVal, r) =>
|
||||
let
|
||||
val acc = helpToList (r, acc)
|
||||
val acc = (curKey, curVal) :: acc
|
||||
in
|
||||
helpToList (l, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
|
||||
fun toList tree = helpToList (tree, [])
|
||||
|
||||
fun helpKeysToList (tree, acc) =
|
||||
case tree of
|
||||
BRANCH (l, curKey, _, r) =>
|
||||
let
|
||||
val acc = helpKeysToList (r, acc)
|
||||
val acc = curKey :: acc
|
||||
in
|
||||
helpKeysToList (l, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
|
||||
fun keysToList tree = helpKeysToList (tree, [])
|
||||
|
||||
fun helpValuesToList (tree, acc) =
|
||||
case tree of
|
||||
BRANCH (l, _, v, r) =>
|
||||
let
|
||||
val acc = helpValuesToList (r, acc)
|
||||
val acc = v :: acc
|
||||
in
|
||||
helpValuesToList (l, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
|
||||
fun valuesToList tree = helpValuesToList (tree, [])
|
||||
|
||||
fun map (f, tree) =
|
||||
case tree of
|
||||
BRANCH (l, key, value, r) =>
|
||||
let
|
||||
val r = map (f, r)
|
||||
val l = map (f, l)
|
||||
val value = f value
|
||||
in
|
||||
BRANCH (l, key, value, r)
|
||||
end
|
||||
| LEAF => LEAF
|
||||
|
||||
fun foldl (f, tree, acc) =
|
||||
case tree of
|
||||
BRANCH (l, k, v, r) =>
|
||||
let
|
||||
val acc = foldl (f, l, acc)
|
||||
val acc = f (v, acc)
|
||||
in
|
||||
foldl (f, r, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
|
||||
fun foldr (f, tree, acc) =
|
||||
case tree of
|
||||
BRANCH (l, k, v, r) =>
|
||||
let
|
||||
val acc = foldr (f, r, acc)
|
||||
val acc = f (v, acc)
|
||||
in
|
||||
foldr (f, l, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
end
|
||||
|
||||
structure ParseDfa =
|
||||
struct
|
||||
(* parsing through precedence climbing algorithm. *)
|
||||
val postfixLevel = 1
|
||||
val concatLevel = 2
|
||||
val altLevel = 3
|
||||
|
||||
local
|
||||
fun loop (pos, str, openParens, closeParens) =
|
||||
if pos = String.size str then
|
||||
NONE
|
||||
else
|
||||
case String.sub (str, pos) of
|
||||
#"(" => loop (pos + 1, str, openParens + 1, closeParens)
|
||||
| #")" =>
|
||||
if closeParens + 1 = openParens then SOME 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
|
||||
|
||||
(* assumes previous char is a backslash *)
|
||||
fun isValidEscapeSequence chr =
|
||||
case chr of
|
||||
(* regex metacharacters *)
|
||||
#"(" => (true, chr)
|
||||
| #")" => (true, chr)
|
||||
| #"[" => (true, chr)
|
||||
| #"]" => (true, chr)
|
||||
| #"+" => (true, chr)
|
||||
| #"*" => (true, chr)
|
||||
| #"|" => (true, chr)
|
||||
| #"?" => (true, chr)
|
||||
| #"." => (true, chr)
|
||||
| #"-" => (true, chr)
|
||||
(* standard escape sequences *)
|
||||
| #"a" => (true, #"\a")
|
||||
| #"b" => (true, #"\b")
|
||||
| #"t" => (true, #"\t")
|
||||
| #"n" => (true, #"\n")
|
||||
| #"v" => (true, #"\v")
|
||||
| #"f" => (true, #"\f")
|
||||
| #"r" => (true, #"\r")
|
||||
| #"\\" => (true, chr)
|
||||
| _ => (false, chr)
|
||||
|
||||
fun getCharsBetween (lowChr, highChr, acc) =
|
||||
if lowChr = highChr then
|
||||
highChr :: acc
|
||||
else
|
||||
let
|
||||
val acc = lowChr :: acc
|
||||
val lowChr = Char.succ lowChr
|
||||
in
|
||||
getCharsBetween (lowChr, highChr, acc)
|
||||
end
|
||||
|
||||
fun getCharsInBrackets (pos, str, acc) =
|
||||
if pos = String.size str then
|
||||
NONE
|
||||
else
|
||||
case String.sub (str, pos) of
|
||||
#"\\" =>
|
||||
(* escape sequences *)
|
||||
if pos + 1 = String.size str then
|
||||
NONE
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, pos + 1)
|
||||
val (isValid, chr) = isValidEscapeSequence chr
|
||||
in
|
||||
if isValid then
|
||||
(* Edge case:
|
||||
* We have to check if there is a char range like a-z,
|
||||
* and if there is,
|
||||
* we have to check if the second char in the range
|
||||
* is another escaped-character *)
|
||||
if
|
||||
pos + 2 < String.size str
|
||||
andalso String.sub (str, pos + 2) = #"-"
|
||||
andalso pos + 3 < String.size str
|
||||
then
|
||||
(* we do have a character range,
|
||||
* which may possibly be escaped *)
|
||||
case String.sub (str, pos + 3) of
|
||||
#"(" => NONE
|
||||
| #")" => NONE
|
||||
| #"[" => NONE
|
||||
| #"]" => NONE
|
||||
| #"+" => NONE
|
||||
| #"*" => NONE
|
||||
| #"|" => NONE
|
||||
| #"?" => NONE
|
||||
| #"." => NONE
|
||||
| #"-" => NONE
|
||||
| #"\\" =>
|
||||
if pos + 4 < String.size str then
|
||||
let
|
||||
val chr2 = String.sub (str, pos + 4)
|
||||
val (isValid, chr2) = isValidEscapeSequence chr2
|
||||
val acc =
|
||||
if chr < chr2 then
|
||||
getCharsBetween (chr, chr2, acc)
|
||||
else
|
||||
getCharsBetween (chr2, chr, acc)
|
||||
in
|
||||
getCharsInBrackets (pos + 5, str, acc)
|
||||
end
|
||||
else
|
||||
NONE
|
||||
| chr2 =>
|
||||
let
|
||||
val acc =
|
||||
if chr < chr2 then getCharsBetween (chr, chr2, acc)
|
||||
else getCharsBetween (chr2, chr, acc)
|
||||
in
|
||||
getCharsInBrackets (pos + 4, str, acc)
|
||||
end
|
||||
else
|
||||
(* no character range we have to check *)
|
||||
getCharsInBrackets (pos + 2, str, chr :: acc)
|
||||
else
|
||||
NONE
|
||||
end
|
||||
| #"]" =>
|
||||
let val chars = Vector.fromList acc
|
||||
in SOME (pos + 1, chars)
|
||||
end
|
||||
| chr =>
|
||||
if
|
||||
pos + 1 < String.size str andalso String.sub (str, pos + 1) = #"-"
|
||||
andalso pos + 2 < String.size str
|
||||
then
|
||||
(* handle character ranges like a-z.
|
||||
* There are edge cases regarding
|
||||
* the second character in the range.
|
||||
* We have to check that any unescaped metacharacters
|
||||
* return an invalid parse state.
|
||||
* We also have to unescape any escape sequences.
|
||||
* *)
|
||||
case String.sub (str, pos + 2) of
|
||||
#"\\" =>
|
||||
(* second char contains an escape sequence *)
|
||||
if pos + 3 < String.size str then
|
||||
let
|
||||
val chr2 = String.sub (str, pos + 3)
|
||||
val (isValid, chr2) = isValidEscapeSequence chr2
|
||||
val acc =
|
||||
if chr < chr2 then getCharsBetween (chr, chr2, acc)
|
||||
else getCharsBetween (chr2, chr, acc)
|
||||
in
|
||||
if isValid then getCharsInBrackets (pos + 4, str, acc)
|
||||
else NONE
|
||||
end
|
||||
else
|
||||
NONE
|
||||
| #"(" => NONE
|
||||
| #")" => NONE
|
||||
| #"[" => NONE
|
||||
| #"]" => NONE
|
||||
| #"+" => NONE
|
||||
| #"*" => NONE
|
||||
| #"|" => NONE
|
||||
| #"?" => NONE
|
||||
| #"." => NONE
|
||||
| #"-" => NONE
|
||||
| chr2 =>
|
||||
(* valid char range *)
|
||||
let
|
||||
val acc =
|
||||
if chr < chr2 then getCharsBetween (chr, chr2, acc)
|
||||
else getCharsBetween (chr2, chr, acc)
|
||||
in
|
||||
getCharsInBrackets (pos + 3, str, acc)
|
||||
end
|
||||
else
|
||||
getCharsInBrackets (pos + 1, str, chr :: acc)
|
||||
|
||||
fun parseCharacterClass (pos, str, stateNum) =
|
||||
case getCharsInBrackets (pos, str, []) of
|
||||
SOME (pos, chars) =>
|
||||
let
|
||||
val node = IS_ANY_CHARACTER {chars = chars, position = stateNum + 1}
|
||||
in
|
||||
SOME (pos, node, stateNum + 1)
|
||||
end
|
||||
| NONE => NONE
|
||||
|
||||
fun parseNegateCharacterClass (pos, str, stateNum) =
|
||||
case getCharsInBrackets (pos, str, []) of
|
||||
SOME (pos, chars) =>
|
||||
let
|
||||
val node =
|
||||
NOT_ANY_CHARACTER {chars = chars, position = stateNum + 1}
|
||||
in
|
||||
SOME (pos, node, stateNum + 1)
|
||||
end
|
||||
| NONE => NONE
|
||||
|
||||
fun computeAtom (pos, str, stateNum) =
|
||||
if pos = String.size str then
|
||||
NONE
|
||||
else
|
||||
case String.sub (str, pos) of
|
||||
#"(" =>
|
||||
(case getRightParenIdx (pos + 1, str) of
|
||||
SOME groupEndIdx =>
|
||||
let
|
||||
val substr = String.substring
|
||||
(str, pos + 1, groupEndIdx - pos - 1)
|
||||
in
|
||||
case parse (substr, stateNum) of
|
||||
SOME (rhs, stateNum) =>
|
||||
SOME (groupEndIdx + 1, rhs, stateNum)
|
||||
| NONE => NONE
|
||||
end
|
||||
| NONE => NONE)
|
||||
| #"\\" =>
|
||||
(* escape sequences *)
|
||||
if pos + 1 = String.size str then
|
||||
NONE
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, pos + 1)
|
||||
val (isValid, chr) = isValidEscapeSequence chr
|
||||
in
|
||||
if Fn.charIsEqual (chr, Fn.endMarker) then
|
||||
NONE
|
||||
else if isValid then
|
||||
let
|
||||
val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
|
||||
in
|
||||
SOME (pos + 2, chr, stateNum + 1)
|
||||
end
|
||||
else
|
||||
NONE
|
||||
end
|
||||
| #"." =>
|
||||
let val w = WILDCARD (stateNum + 1)
|
||||
in SOME (pos + 1, w, stateNum + 1)
|
||||
end
|
||||
| #"[" =>
|
||||
if pos + 1 = String.size str then
|
||||
NONE
|
||||
else if String.sub (str, pos + 1) = #"^" then
|
||||
parseNegateCharacterClass (pos + 2, str, stateNum)
|
||||
else
|
||||
parseCharacterClass (pos + 1, str, stateNum)
|
||||
| #")" => NONE
|
||||
| #"]" => NONE
|
||||
| #"+" => NONE
|
||||
| #"*" => NONE
|
||||
| #"|" => NONE
|
||||
| #"?" => NONE
|
||||
| #"-" => NONE
|
||||
| chr =>
|
||||
if Fn.charIsEqual (chr, Fn.endMarker) then
|
||||
NONE
|
||||
else
|
||||
let val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
|
||||
in SOME (pos + 1, chr, stateNum + 1)
|
||||
end
|
||||
|
||||
and climb (pos, str, lhs, level, stateNum) : (int * parse_tree * int) option =
|
||||
if pos = String.size str then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else
|
||||
case String.sub (str, pos) of
|
||||
#"|" =>
|
||||
if level < altLevel then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else if pos + 1 < String.size str then
|
||||
let
|
||||
val chr = String.sub (str, pos + 1)
|
||||
val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
|
||||
in
|
||||
case climb (pos + 2, str, chr, altLevel, stateNum + 1) of
|
||||
SOME (pos, rhs, rightStateNum) =>
|
||||
let
|
||||
val result = ALTERNATION
|
||||
{ l = lhs
|
||||
, r = rhs
|
||||
, leftMaxState = stateNum
|
||||
, rightMaxState = rightStateNum
|
||||
}
|
||||
in
|
||||
SOME (pos, result, rightStateNum)
|
||||
end
|
||||
| NONE => NONE
|
||||
end
|
||||
else
|
||||
NONE
|
||||
| #"?" =>
|
||||
if level < postfixLevel then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else
|
||||
let val lhs = ZERO_OR_ONE lhs
|
||||
in climb (pos + 1, str, lhs, postfixLevel, stateNum)
|
||||
end
|
||||
| #"*" =>
|
||||
if level < postfixLevel then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else
|
||||
let val lhs = ZERO_OR_MORE lhs
|
||||
in climb (pos + 1, str, lhs, postfixLevel, stateNum)
|
||||
end
|
||||
| #"+" =>
|
||||
if level < postfixLevel then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else
|
||||
let val lhs = ONE_OR_MORE lhs
|
||||
in climb (pos + 1, str, lhs, postfixLevel, stateNum)
|
||||
end
|
||||
| chr =>
|
||||
if level < concatLevel then
|
||||
SOME (pos, lhs, stateNum)
|
||||
else
|
||||
case computeAtom (pos, str, stateNum) of
|
||||
SOME (nextPos, curAtom, atomStateNum) =>
|
||||
(case climb (nextPos, str, curAtom, concatLevel, atomStateNum) of
|
||||
SOME (pos, rhs, rightStateNum) =>
|
||||
let
|
||||
val result = CONCAT
|
||||
{ l = lhs
|
||||
, r = rhs
|
||||
, leftMaxState = stateNum
|
||||
, rightMaxState = rightStateNum
|
||||
}
|
||||
in
|
||||
SOME (pos, result, rightStateNum)
|
||||
end
|
||||
| NONE => NONE)
|
||||
| NONE => NONE
|
||||
|
||||
and loop (pos, str, ast, stateNum) =
|
||||
if pos = String.size str then
|
||||
SOME (ast, stateNum)
|
||||
else
|
||||
case climb (pos, str, ast, altLevel, stateNum) of
|
||||
SOME (pos, ast, stateNum) => loop (pos, str, ast, stateNum)
|
||||
| NONE => NONE
|
||||
|
||||
and parse (str, stateNum) =
|
||||
if String.size str > 0 then
|
||||
case computeAtom (0, str, stateNum) of
|
||||
SOME (nextPos, lhs, stateNum) => loop (nextPos, str, lhs, stateNum)
|
||||
| NONE => NONE
|
||||
else
|
||||
NONE
|
||||
end
|
||||
|
||||
structure ToDfa =
|
||||
struct
|
||||
type dstate_element = {marked: bool, transitions: int list}
|
||||
type dstate_vec = dstate_element vector
|
||||
|
||||
fun chrExistsInVec (idx, vec, curChr) =
|
||||
if idx = Vector.length vec then
|
||||
false
|
||||
else
|
||||
let
|
||||
val idxChr = Vector.sub (vec, idx)
|
||||
in
|
||||
Fn.charIsEqual (idxChr, curChr)
|
||||
orelse chrExistsInVec (idx + 1, vec, curChr)
|
||||
end
|
||||
|
||||
fun addKeysToFollowSet (lst, addSet, followSet) =
|
||||
case lst of
|
||||
hd :: tl =>
|
||||
let
|
||||
val currentFollows = Set.getOrDefault (hd, followSet, [])
|
||||
val updatedFollows = Set.addFromList (currentFollows, addSet)
|
||||
val updatedFollows: int list = Set.keysToList updatedFollows
|
||||
val followSet = Set.insertOrReplace (hd, updatedFollows, followSet)
|
||||
in
|
||||
addKeysToFollowSet (tl, addSet, followSet)
|
||||
end
|
||||
| [] => followSet
|
||||
|
||||
fun addToFollowSet (tree, followSet) =
|
||||
case tree of
|
||||
WILDCARD _ => followSet
|
||||
| CHAR_LITERAL {char, position} =>
|
||||
(* we add the endMarker and its position to the followSet *)
|
||||
if char = Fn.endMarker then
|
||||
Set.insertOrReplace (position, [Char.ord Fn.endMarker], followSet)
|
||||
else
|
||||
followSet
|
||||
| IS_ANY_CHARACTER _ => followSet
|
||||
| NOT_ANY_CHARACTER _ => followSet
|
||||
| CONCAT {l, r, ...} =>
|
||||
let
|
||||
val followSet = addToFollowSet (l, followSet)
|
||||
val followSet = addToFollowSet (r, followSet)
|
||||
|
||||
val lpOfLeft = lastpos (l, [])
|
||||
val fpOfRight = firstpos (r, [])
|
||||
val fpOfRight = Set.addFromList (fpOfRight, Set.LEAF)
|
||||
in
|
||||
addKeysToFollowSet (lpOfLeft, fpOfRight, followSet)
|
||||
end
|
||||
| ALTERNATION {l, r, ...} =>
|
||||
let val followSet = addToFollowSet (l, followSet)
|
||||
in addToFollowSet (r, followSet)
|
||||
end
|
||||
| ZERO_OR_MORE child =>
|
||||
let
|
||||
val followSet = addToFollowSet (child, followSet)
|
||||
val fp = firstpos (child, [])
|
||||
val fp = Set.addFromList (fp, Set.LEAF)
|
||||
val lp = lastpos (child, [])
|
||||
in
|
||||
addKeysToFollowSet (lp, fp, followSet)
|
||||
end
|
||||
| ONE_OR_MORE child =>
|
||||
let
|
||||
val followSet = addToFollowSet (child, followSet)
|
||||
val lp = lastpos (child, [])
|
||||
val fp = firstpos (child, [])
|
||||
val fp = Set.addFromList (fp, Set.LEAF)
|
||||
in
|
||||
addKeysToFollowSet (lp, fp, followSet)
|
||||
end
|
||||
| ZERO_OR_ONE child => addToFollowSet (child, followSet)
|
||||
| GROUP child => addToFollowSet (child, followSet)
|
||||
|
||||
fun appendIfNew (pos, dstates, newStates) =
|
||||
if pos = Vector.length dstates then
|
||||
let
|
||||
val record = {transitions = newStates, marked = false}
|
||||
val dstates = Vector.concat [dstates, Vector.fromList [record]]
|
||||
in
|
||||
(pos, dstates)
|
||||
end
|
||||
else
|
||||
let
|
||||
val {transitions: int list, marked = _} = Vector.sub (dstates, pos)
|
||||
in
|
||||
if transitions = newStates then (pos, dstates)
|
||||
else appendIfNew (pos + 1, dstates, newStates)
|
||||
end
|
||||
|
||||
fun getUnmarkedTransitionsIfExists (pos, dstates) =
|
||||
if pos = Vector.length dstates then
|
||||
NONE
|
||||
else
|
||||
let
|
||||
val record: dstate_element = Vector.sub (dstates, pos)
|
||||
in
|
||||
if #marked record then
|
||||
getUnmarkedTransitionsIfExists (pos + 1, dstates)
|
||||
else
|
||||
SOME (pos, #transitions record)
|
||||
end
|
||||
|
||||
fun isCharMatch (regex, pos, curChr) =
|
||||
case regex of
|
||||
CHAR_LITERAL {char, ...} => Fn.charIsEqual (char, curChr)
|
||||
| WILDCARD _ => true
|
||||
| IS_ANY_CHARACTER {chars, ...} => chrExistsInVec (0, chars, curChr)
|
||||
| NOT_ANY_CHARACTER {chars, ...} =>
|
||||
let val charIsValid = chrExistsInVec (0, chars, curChr)
|
||||
in not charIsValid
|
||||
end
|
||||
| ALTERNATION {l, r, leftMaxState, ...} =>
|
||||
if pos > leftMaxState then isCharMatch (r, pos, curChr)
|
||||
else isCharMatch (l, pos, curChr)
|
||||
| CONCAT {l, r, leftMaxState, ...} =>
|
||||
if pos > leftMaxState then isCharMatch (r, pos, curChr)
|
||||
else isCharMatch (l, pos, curChr)
|
||||
| ZERO_OR_ONE child => isCharMatch (child, pos, curChr)
|
||||
| ZERO_OR_MORE child => isCharMatch (child, pos, curChr)
|
||||
| ONE_OR_MORE child => isCharMatch (child, pos, curChr)
|
||||
| GROUP child => isCharMatch (child, pos, curChr)
|
||||
|
||||
fun positionsThatCorrespondToChar
|
||||
(char, curStates, regex, acc, followSet, hasAnyMatch) =
|
||||
case curStates of
|
||||
[] => List.concat (Set.valuesToList acc)
|
||||
| pos :: tl =>
|
||||
if isCharMatch (regex, pos, Char.chr char) then
|
||||
let
|
||||
(* get union of new and previous follows *)
|
||||
val prevFollows = Set.getOrDefault (char, acc, [])
|
||||
val newFollows = Set.getOrDefault (pos, followSet, [])
|
||||
|
||||
val tempSet = Set.addFromList (prevFollows, Set.LEAF)
|
||||
val tempSet = Set.addFromList (newFollows, tempSet)
|
||||
val allFollowList = Set.keysToList tempSet
|
||||
|
||||
(* store union of new and previous follows so far *)
|
||||
val acc = Set.insertOrReplace (char, allFollowList, acc)
|
||||
in
|
||||
positionsThatCorrespondToChar
|
||||
(char, tl, regex, acc, followSet, true)
|
||||
end
|
||||
else
|
||||
positionsThatCorrespondToChar
|
||||
(char, tl, regex, acc, followSet, hasAnyMatch)
|
||||
|
||||
structure Dtran =
|
||||
struct
|
||||
(* vector, with idx corresponding to state in dstate,
|
||||
* an int key which corresponds to char's ascii code,
|
||||
* and an int value corresponding to state we will transition to *)
|
||||
type t = int Set.set vector
|
||||
|
||||
fun insert (dStateIdx, char, toStateIdx, dtran: t) =
|
||||
if dStateIdx = Vector.length dtran then
|
||||
let
|
||||
val el = Set.insertOrReplace (char, toStateIdx, Set.LEAF)
|
||||
val el = Vector.fromList [el]
|
||||
in
|
||||
Vector.concat [dtran, el]
|
||||
end
|
||||
else if dStateIdx < Vector.length dtran then
|
||||
let
|
||||
val el = Vector.sub (dtran, dStateIdx)
|
||||
val el = Set.insertOrReplace (char, toStateIdx, el)
|
||||
in
|
||||
Vector.update (dtran, dStateIdx, el)
|
||||
end
|
||||
else
|
||||
let
|
||||
val appendLength = dStateIdx - Vector.length dtran
|
||||
val appendVecs = Vector.tabulate (appendLength, fn _ => Set.LEAF)
|
||||
val dtran = Vector.concat [dtran, appendVecs]
|
||||
in
|
||||
insert (dStateIdx, char, toStateIdx, dtran)
|
||||
end
|
||||
end
|
||||
|
||||
fun convertChar
|
||||
( char
|
||||
, regex
|
||||
, dstates
|
||||
, dtran: Dtran.t
|
||||
, unmarkedState
|
||||
, unmarkedIdx
|
||||
, followSet
|
||||
, prevDstateLength
|
||||
) =
|
||||
if char < 0 then
|
||||
(dstates, dtran)
|
||||
else
|
||||
let
|
||||
val u = positionsThatCorrespondToChar
|
||||
(char, unmarkedState, regex, Set.LEAF, followSet, false)
|
||||
in
|
||||
case u of
|
||||
[] =>
|
||||
convertChar
|
||||
( char - 1
|
||||
, regex
|
||||
, dstates
|
||||
, dtran
|
||||
, unmarkedState
|
||||
, unmarkedIdx
|
||||
, followSet
|
||||
, prevDstateLength
|
||||
)
|
||||
| _ =>
|
||||
let
|
||||
(* dtran is idx -> char -> state_list map *)
|
||||
val (uIdx, dstates) = appendIfNew (0, dstates, u)
|
||||
val dtran = Dtran.insert (unmarkedIdx, char, uIdx, dtran)
|
||||
in
|
||||
convertChar
|
||||
( char - 1
|
||||
, regex
|
||||
, dstates
|
||||
, dtran
|
||||
, unmarkedState
|
||||
, unmarkedIdx
|
||||
, followSet
|
||||
, prevDstateLength
|
||||
)
|
||||
end
|
||||
end
|
||||
|
||||
fun convertLoop (regex, dstates, dtran, followSet) =
|
||||
case getUnmarkedTransitionsIfExists (0, dstates) of
|
||||
SOME (unmarkedIdx, unamarkedTransition) =>
|
||||
let
|
||||
(* mark transition *)
|
||||
val dstates =
|
||||
let
|
||||
val newMark = {marked = true, transitions = unamarkedTransition}
|
||||
in
|
||||
Vector.update (dstates, unmarkedIdx, newMark)
|
||||
end
|
||||
|
||||
val (dstates, dtran) = convertChar
|
||||
( 255
|
||||
, regex
|
||||
, dstates
|
||||
, dtran
|
||||
, unamarkedTransition
|
||||
, unmarkedIdx
|
||||
, followSet
|
||||
, Vector.length dstates
|
||||
)
|
||||
in
|
||||
convertLoop (regex, dstates, dtran, followSet)
|
||||
end
|
||||
| NONE =>
|
||||
Vector.map
|
||||
(fn set =>
|
||||
Vector.tabulate (256, fn i => Set.getOrDefault (i, set, ~1)))
|
||||
dtran
|
||||
|
||||
fun convert regex =
|
||||
let
|
||||
val followSet = addToFollowSet (regex, Set.LEAF)
|
||||
|
||||
(* get firstpos, sorted *)
|
||||
val first = firstpos (regex, [])
|
||||
val first = Set.addFromList (first, Set.LEAF)
|
||||
val first = Set.keysToList first
|
||||
|
||||
val dstates = Vector.fromList [{transitions = first, marked = false}]
|
||||
in
|
||||
convertLoop (regex, dstates, Vector.fromList [Set.LEAF], followSet)
|
||||
end
|
||||
end
|
||||
|
||||
fun fromString str =
|
||||
case ParseDfa.parse (str, 0) of
|
||||
SOME (ast, numStates) =>
|
||||
let
|
||||
val endMarker =
|
||||
CHAR_LITERAL {char = Fn.endMarker, position = numStates + 1}
|
||||
val ast = CONCAT
|
||||
{ l = ast
|
||||
, leftMaxState = numStates
|
||||
, r = endMarker
|
||||
, rightMaxState = numStates + 1
|
||||
}
|
||||
in
|
||||
ToDfa.convert ast
|
||||
end
|
||||
| NONE => Vector.fromList []
|
||||
|
||||
type dfa = int vector vector
|
||||
type dfa_state = int
|
||||
|
||||
fun nextState (dfa: dfa, curState: dfa_state, chr) =
|
||||
let val curTable = Vector.sub (dfa, curState)
|
||||
in Vector.sub (curTable, Char.ord chr)
|
||||
end
|
||||
|
||||
fun isFinal (dfa: dfa, curState: dfa_state) =
|
||||
curState <> ~1
|
||||
andalso
|
||||
let
|
||||
val curTable = Vector.sub (dfa, curState)
|
||||
val endMarkerCode = Char.ord Fn.endMarker
|
||||
in
|
||||
Vector.sub (curTable, endMarkerCode) <> ~1
|
||||
end
|
||||
|
||||
fun isDead (curState: dfa_state) = curState = ~1
|
||||
|
||||
fun helpMatchString (strPos, str, dfa, curState, startPos, prevFinalPos, acc) =
|
||||
if strPos = String.size str then
|
||||
let
|
||||
val acc =
|
||||
if prevFinalPos = ~1 then acc else (startPos, prevFinalPos) :: acc
|
||||
in
|
||||
List.rev acc
|
||||
end
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, strPos)
|
||||
val newState = nextState (dfa, curState, chr)
|
||||
val prevFinalPos =
|
||||
if isFinal (dfa, newState) then strPos else prevFinalPos
|
||||
in
|
||||
if isDead newState then
|
||||
if prevFinalPos = ~1 then
|
||||
(* restart from startPos *)
|
||||
helpMatchString (startPos + 1, str, dfa, 0, startPos + 1, ~1, acc)
|
||||
else
|
||||
let
|
||||
val acc = (startPos, prevFinalPos) :: acc
|
||||
in
|
||||
helpMatchString
|
||||
(prevFinalPos + 1, str, dfa, 0, prevFinalPos + 1, ~1, acc)
|
||||
end
|
||||
else
|
||||
helpMatchString
|
||||
(strPos + 1, str, dfa, newState, startPos, prevFinalPos, acc)
|
||||
end
|
||||
|
||||
fun matchString (dfa, string) =
|
||||
if Vector.length dfa = 0 then []
|
||||
else helpMatchString (0, string, dfa, 0, 0, ~1, [])
|
||||
end
|
||||
|
||||
structure CaseInsensitiveDfa =
|
||||
MakeDfaGen
|
||||
(struct
|
||||
val endMarker = #"\^@"
|
||||
fun charIsEqual (a: char, b: char) = Char.toLower a = Char.toLower b
|
||||
end)
|
||||
|
||||
structure CaseSensitiveDfa =
|
||||
MakeDfaGen
|
||||
(struct
|
||||
val endMarker = #"\^@"
|
||||
fun charIsEqual (a: char, b: char) = a = b
|
||||
end)
|
||||
937
shf/fcore/search-list/persistent-vector.sml
Normal file
937
shf/fcore/search-list/persistent-vector.sml
Normal file
@@ -0,0 +1,937 @@
|
||||
structure PersistentVector =
|
||||
struct
|
||||
(* Clojure-style persistent vector, for building search list.
|
||||
* There is an "int table" too, which stores the last index
|
||||
* at the node with the same index.
|
||||
* We can use the size table for binary search.
|
||||
* *)
|
||||
datatype t =
|
||||
BRANCH of t vector * int vector
|
||||
| LEAF of {start: int, finish: int} vector * int vector
|
||||
|
||||
val maxSize = 32
|
||||
val halfSize = 16
|
||||
|
||||
fun isEmpty t =
|
||||
case t of
|
||||
LEAF (_, sizes) => Vector.length sizes = 0
|
||||
| BRANCH (_, sizes) => Vector.length sizes = 0
|
||||
|
||||
val empty = LEAF (#[], #[])
|
||||
|
||||
datatype append_result = APPEND of t | UPDATE of t
|
||||
|
||||
fun isInRange (checkIdx, t) =
|
||||
case t of
|
||||
BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val searchIdx = BinSearch.equalOrMore (checkIdx, sizes)
|
||||
in
|
||||
if searchIdx = ~1 then
|
||||
false
|
||||
else if searchIdx = 0 then
|
||||
isInRange (checkIdx, Vector.sub (nodes, searchIdx))
|
||||
else
|
||||
let
|
||||
val nextCheckIdx = checkIdx - Vector.sub (sizes, searchIdx - 1)
|
||||
in
|
||||
isInRange (nextCheckIdx, Vector.sub (nodes, searchIdx))
|
||||
end
|
||||
end
|
||||
| LEAF (values, sizes) =>
|
||||
let
|
||||
val searchIdx = BinSearch.equalOrMore (checkIdx, sizes)
|
||||
in
|
||||
if searchIdx = ~1 then
|
||||
false
|
||||
else
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, searchIdx)
|
||||
in
|
||||
checkIdx >= start andalso checkIdx <= finish
|
||||
end
|
||||
end
|
||||
|
||||
fun getFinishIdx t =
|
||||
case t of
|
||||
BRANCH (_, sizes) => Vector.sub (sizes, Vector.length sizes - 1)
|
||||
| LEAF (_, sizes) => Vector.sub (sizes, Vector.length sizes - 1)
|
||||
|
||||
fun getStartIdx t =
|
||||
case t of
|
||||
BRANCH (nodes, _) => getStartIdx (Vector.sub (nodes, 0))
|
||||
| LEAF (items, _) =>
|
||||
if Vector.length items = 0 then
|
||||
0
|
||||
else
|
||||
#start (Vector.sub (items, 0))
|
||||
|
||||
fun helpAppend (start, finish, tree) =
|
||||
case tree of
|
||||
BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val lastNode = Vector.sub (nodes, Vector.length nodes - 1)
|
||||
val prevSize =
|
||||
if Vector.length sizes > 1 then
|
||||
Vector.sub (sizes, Vector.length sizes - 2)
|
||||
else
|
||||
0
|
||||
in
|
||||
case helpAppend (start - prevSize, finish - prevSize, lastNode) of
|
||||
UPDATE newLast =>
|
||||
let
|
||||
val lastPos = Vector.length nodes - 1
|
||||
val newNode = Vector.update (nodes, lastPos, newLast)
|
||||
val newSizes = Vector.update (sizes, lastPos, finish)
|
||||
val newNode = BRANCH (newNode, newSizes)
|
||||
in
|
||||
UPDATE newNode
|
||||
end
|
||||
| APPEND newVec =>
|
||||
if Vector.length nodes = maxSize then
|
||||
let
|
||||
(* adjust "finish" so that it does not consider
|
||||
* offset for "lower" vector *)
|
||||
val finish = finish - Vector.sub (sizes, Vector.length sizes - 1)
|
||||
val newNode = BRANCH (#[newVec], #[finish])
|
||||
in
|
||||
APPEND newNode
|
||||
end
|
||||
else
|
||||
let
|
||||
val newNodes = Vector.concat [nodes, #[newVec]]
|
||||
val newSizes = Vector.concat [sizes, #[finish]]
|
||||
val newNodes = BRANCH (newNodes, newSizes)
|
||||
in
|
||||
UPDATE newNodes
|
||||
end
|
||||
end
|
||||
| LEAF (values, sizes) =>
|
||||
if Vector.length values + 1 > maxSize then
|
||||
(* when we split a leaf into two vectors,
|
||||
* we want to adjust the start and finish parameters
|
||||
* so that they don't contain the offset relevant to the
|
||||
* "lower" vector, which was split from *)
|
||||
let
|
||||
val prevFinish = Vector.sub (sizes, Vector.length sizes - 1)
|
||||
val start = start - prevFinish
|
||||
val finish = finish - prevFinish
|
||||
val newNode = LEAF (#[{start = start, finish = finish}], #[finish])
|
||||
in
|
||||
APPEND newNode
|
||||
end
|
||||
else
|
||||
let
|
||||
val newNode = Vector.concat
|
||||
[values, #[{start = start, finish = finish}]]
|
||||
val newSizes = Vector.concat [sizes, #[finish]]
|
||||
val newNode = LEAF (newNode, newSizes)
|
||||
in
|
||||
UPDATE newNode
|
||||
end
|
||||
|
||||
fun append (start, finish, tree) =
|
||||
case helpAppend (start, finish, tree) of
|
||||
UPDATE t => t
|
||||
| APPEND newNode =>
|
||||
let
|
||||
val maxSize = getFinishIdx tree
|
||||
in
|
||||
BRANCH (#[tree, newNode], #[maxSize, finish])
|
||||
end
|
||||
|
||||
fun getStart tree =
|
||||
case tree of
|
||||
LEAF (values, _) => Vector.sub (values, 0)
|
||||
| BRANCH (nodes, _) => getStart (Vector.sub (nodes, 0))
|
||||
|
||||
fun helpNextMatch (cursorIdx, tree, absOffset) =
|
||||
case tree of
|
||||
LEAF (values, sizes) =>
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (cursorIdx, sizes)
|
||||
in
|
||||
if idx = ~1 then {start = ~1, finish = ~1}
|
||||
else
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, idx)
|
||||
in
|
||||
{start = start + absOffset, finish = finish + absOffset}
|
||||
end
|
||||
end
|
||||
| BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (cursorIdx, sizes)
|
||||
in
|
||||
if idx = ~1 then
|
||||
{start = ~1, finish = ~1}
|
||||
else if idx = 0 then
|
||||
helpNextMatch (cursorIdx, Vector.sub (nodes, idx), absOffset)
|
||||
else
|
||||
let
|
||||
val prevSize = Vector.sub (sizes, idx - 1)
|
||||
val cursorIdx = cursorIdx - prevSize
|
||||
val absOffset = absOffset + prevSize
|
||||
in
|
||||
helpNextMatch (cursorIdx, Vector.sub (nodes, idx), absOffset)
|
||||
end
|
||||
end
|
||||
|
||||
fun loopNextMatch (prevStart, prevFinish, tree, count) =
|
||||
if count = 0 then
|
||||
prevStart
|
||||
else
|
||||
let
|
||||
val {start, finish} = helpNextMatch (prevFinish + 1, tree, 0)
|
||||
in
|
||||
if start = ~1 then
|
||||
let val {start, finish} = getStart tree
|
||||
in loopNextMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
else
|
||||
loopNextMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
|
||||
fun nextMatch (cursorIdx, tree, count) =
|
||||
if isEmpty tree then
|
||||
~1
|
||||
else
|
||||
let
|
||||
val {start, finish} = helpNextMatch (cursorIdx, tree, 0)
|
||||
in
|
||||
if start = ~1 then
|
||||
let val {start, finish} = getStart tree
|
||||
in loopNextMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
else if cursorIdx >= start andalso cursorIdx <= finish then
|
||||
loopNextMatch (start, finish, tree, count)
|
||||
else
|
||||
loopNextMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
|
||||
fun getLast (tree, absOffset) =
|
||||
case tree of
|
||||
LEAF (values, _) =>
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, Vector.length values - 1)
|
||||
in
|
||||
{start = start + absOffset, finish = finish + absOffset}
|
||||
end
|
||||
| BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val prevSize =
|
||||
if Vector.length sizes - 2 >= 0 then
|
||||
Vector.sub (sizes, Vector.length sizes - 2)
|
||||
else
|
||||
0
|
||||
val absOffset = absOffset + prevSize
|
||||
in
|
||||
getLast (Vector.sub (nodes, Vector.length nodes - 1), absOffset)
|
||||
end
|
||||
|
||||
(* slightly tricky.
|
||||
* The `sizes` vector contains the last/finish position of the item
|
||||
* at the corresponding index in the `nodes` or `values` vector
|
||||
* However, what we when searching for the previous match
|
||||
* is different: we want the node that has a start prior
|
||||
* to the cursorIdx.
|
||||
* This information cannot be retrieved with 100% accuracy
|
||||
* using the `sizes` vector.
|
||||
* To get what we want, we recurse downwards using the `sizes` vector.
|
||||
* If we found the node we want, we return it.
|
||||
* Otherwise, we return a state meaning "no node at this position"
|
||||
* and we use the call stack to descend down the node at the previous index.
|
||||
* There might not be a previous index because the current index is 0.
|
||||
* In this case, either the call stack will handle it,
|
||||
* or the caller to `helpPrevMatch` will. *)
|
||||
fun helpPrevMatch (cursorIdx, tree, absOffset) =
|
||||
case tree of
|
||||
LEAF (values, sizes) =>
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (cursorIdx, sizes)
|
||||
in
|
||||
if idx < 0 then
|
||||
{start = ~1, finish = ~1}
|
||||
else if idx = 0 then
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, 0)
|
||||
in
|
||||
if start < cursorIdx then
|
||||
{start = start + absOffset, finish = finish + absOffset}
|
||||
else
|
||||
{start = ~1, finish = ~1}
|
||||
end
|
||||
else
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, idx)
|
||||
in
|
||||
if cursorIdx > start then
|
||||
{start = start + absOffset, finish = finish + absOffset}
|
||||
else
|
||||
let
|
||||
val {start, finish} = Vector.sub (values, idx - 1)
|
||||
in
|
||||
{start = start + absOffset, finish = finish + absOffset}
|
||||
end
|
||||
end
|
||||
end
|
||||
| BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (cursorIdx, sizes)
|
||||
in
|
||||
if idx < 0 then
|
||||
{start = ~1, finish = ~1}
|
||||
else if idx = 0 then
|
||||
helpPrevMatch (cursorIdx, Vector.sub (nodes, idx), absOffset)
|
||||
else
|
||||
let
|
||||
val prevSize = Vector.sub (sizes, idx - 1)
|
||||
val node = Vector.sub (nodes, idx)
|
||||
val result =
|
||||
helpPrevMatch (cursorIdx - prevSize, node, absOffset + prevSize)
|
||||
in
|
||||
if #start result = ~1 then
|
||||
let
|
||||
val prevSize =
|
||||
if idx - 2 >= 0 then
|
||||
Vector.sub (sizes, idx - 2)
|
||||
else
|
||||
0
|
||||
val absOffset = absOffset + prevSize
|
||||
in
|
||||
getLast (Vector.sub (nodes, idx - 1), absOffset)
|
||||
end
|
||||
else result
|
||||
end
|
||||
end
|
||||
|
||||
fun loopPrevMatch (prevStart, prevFinish, tree, count) =
|
||||
if count = 0 then
|
||||
prevStart
|
||||
else
|
||||
let
|
||||
val {start, finish} = helpPrevMatch (prevFinish - 1, tree, 0)
|
||||
in
|
||||
if start = ~1 then
|
||||
let val {start, finish} = getLast (tree, 0)
|
||||
in loopPrevMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
else
|
||||
loopPrevMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
|
||||
fun prevMatch (cursorIdx, tree, count) =
|
||||
if isEmpty tree then
|
||||
~1
|
||||
else
|
||||
let
|
||||
val {start, finish} = helpPrevMatch (cursorIdx, tree, 0)
|
||||
in
|
||||
if start = ~1 then
|
||||
let val {start, finish} = getLast (tree, 0)
|
||||
in loopPrevMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
else if cursorIdx >= start andalso cursorIdx <= finish then
|
||||
loopPrevMatch (start, finish, tree, count)
|
||||
else
|
||||
loopPrevMatch (start, finish, tree, count - 1)
|
||||
end
|
||||
|
||||
fun splitLeft (splitIdx, tree) =
|
||||
case tree of
|
||||
LEAF (items, sizes) =>
|
||||
if Vector.length items = 0 then
|
||||
(* if tree is empty, then just return tree *)
|
||||
tree
|
||||
else
|
||||
let
|
||||
val {start, ...} = Vector.sub (items, 0)
|
||||
in
|
||||
(* if all items are after splitIdx,
|
||||
* then we want to return an empty tree,
|
||||
* splitting everything *)
|
||||
if splitIdx < start then
|
||||
empty
|
||||
else if splitIdx > Vector.sub (sizes, Vector.length sizes - 1) then
|
||||
(* if all items are before splitIdx,
|
||||
* then we want to return the same tree,
|
||||
* splitting nothing *)
|
||||
tree
|
||||
else
|
||||
(* we want to split from somewhere in middle, keeping left *)
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (splitIdx, sizes)
|
||||
val idx = SOME idx
|
||||
|
||||
val items = VectorSlice.slice (items, 0, idx)
|
||||
val items = VectorSlice.vector items
|
||||
|
||||
val sizes = VectorSlice.slice (sizes, 0, idx)
|
||||
val sizes = VectorSlice.vector sizes
|
||||
in
|
||||
LEAF (items, sizes)
|
||||
end
|
||||
end
|
||||
| BRANCH (nodes, sizes) =>
|
||||
if Vector.length nodes = 0 then
|
||||
tree
|
||||
else
|
||||
if splitIdx < Vector.sub (sizes, 0) then
|
||||
(* we want to split first node from rest *)
|
||||
splitLeft (splitIdx, Vector.sub (nodes, 0))
|
||||
else if splitIdx > Vector.sub (sizes, Vector.length sizes - 1) then
|
||||
(* split point is after this subtree,
|
||||
* so return this subtree unchanged *)
|
||||
tree
|
||||
else
|
||||
(* we want to split from somewhere in middle *)
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (splitIdx, sizes)
|
||||
val prevSize =
|
||||
if idx = 0 then
|
||||
0
|
||||
else
|
||||
Vector.sub (sizes, idx - 1)
|
||||
val child =
|
||||
splitLeft (splitIdx - prevSize, Vector.sub (nodes, idx))
|
||||
|
||||
val sizes = VectorSlice.slice (sizes, 0, SOME idx)
|
||||
val nodes = VectorSlice.slice (nodes, 0, SOME idx)
|
||||
in
|
||||
if isEmpty child then
|
||||
let
|
||||
val sizes = VectorSlice.vector sizes
|
||||
val nodes = VectorSlice.vector nodes
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
else
|
||||
let
|
||||
val childSize = VectorSlice.full #[getFinishIdx child + prevSize]
|
||||
val sizes =VectorSlice.concat [sizes, childSize]
|
||||
|
||||
val childNode = VectorSlice.full #[child]
|
||||
val nodes = VectorSlice.concat [nodes, childNode]
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
end
|
||||
|
||||
(* When we split in this function,
|
||||
* we always want to update the sizes vector
|
||||
* so that the relative rope-like metadata is valid *)
|
||||
fun splitRight (splitIdx, tree) =
|
||||
case tree of
|
||||
BRANCH (nodes, sizes) =>
|
||||
if splitIdx > Vector.sub (sizes, Vector.length sizes - 1) then
|
||||
(* splitIdx is greater than largest element,
|
||||
* so we want to remove everything;
|
||||
* or, in other words, we want to return an empty vec *)
|
||||
empty
|
||||
else
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (splitIdx, sizes)
|
||||
val prevSize =
|
||||
if idx = 0 then
|
||||
0
|
||||
else
|
||||
Vector.sub (sizes, idx - 1)
|
||||
|
||||
val oldChildSize = Vector.sub (sizes, idx)
|
||||
val child = splitRight (splitIdx - prevSize, Vector.sub (nodes, idx))
|
||||
|
||||
val len = Vector.length nodes - (idx + 1)
|
||||
val sizesSlice = VectorSlice.slice (sizes, idx + 1, SOME len)
|
||||
val nodesSlice = VectorSlice.slice (nodes, idx + 1, SOME len)
|
||||
in
|
||||
if isEmpty child then
|
||||
if VectorSlice.length sizesSlice = 0 then
|
||||
(* if we descended down last node and last node became empty,
|
||||
* then return empty vector *)
|
||||
empty
|
||||
else
|
||||
let
|
||||
val nodes = VectorSlice.vector nodesSlice
|
||||
val sizes = VectorSlice.map (fn el => el - oldChildSize) sizesSlice
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
else
|
||||
let
|
||||
val newChildSize = getFinishIdx child
|
||||
val sizes = Vector.tabulate (VectorSlice.length sizesSlice + 1,
|
||||
fn i =>
|
||||
if i = 0 then
|
||||
newChildSize
|
||||
else
|
||||
let
|
||||
val el = VectorSlice.sub (sizesSlice, i - 1)
|
||||
in
|
||||
el - oldChildSize + newChildSize
|
||||
end
|
||||
)
|
||||
|
||||
val child = VectorSlice.full #[child]
|
||||
val nodes = VectorSlice.concat [child, nodesSlice]
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
end
|
||||
| LEAF (items, sizes) =>
|
||||
if Vector.length items = 0 then
|
||||
tree
|
||||
else
|
||||
if splitIdx > Vector.sub (sizes, Vector.length sizes - 1) then
|
||||
empty
|
||||
else if splitIdx < #start (Vector.sub (items, 0)) then
|
||||
tree
|
||||
else
|
||||
let
|
||||
val idx = BinSearch.equalOrMore (splitIdx, sizes)
|
||||
val {start, finish} = Vector.sub (items, idx)
|
||||
val idx =
|
||||
if splitIdx >= start then
|
||||
idx + 1
|
||||
else
|
||||
idx
|
||||
in
|
||||
if idx >= Vector.length items then
|
||||
empty
|
||||
else
|
||||
let
|
||||
val prevSize =
|
||||
if idx > 0 then
|
||||
Vector.sub (sizes, idx - 1)
|
||||
else
|
||||
0
|
||||
val len = Vector.length items - idx
|
||||
val itemsSlice = VectorSlice.slice (items, idx, SOME len)
|
||||
val items = VectorSlice.map
|
||||
(fn {start, finish} =>
|
||||
{start = start - prevSize, finish = finish - prevSize}
|
||||
)
|
||||
itemsSlice
|
||||
val sizes = Vector.map #finish items
|
||||
in
|
||||
LEAF (items, sizes)
|
||||
end
|
||||
end
|
||||
|
||||
fun decrementBy (decBy, tree) =
|
||||
case tree of
|
||||
BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val child = decrementBy (decBy, Vector.sub (nodes, 0))
|
||||
val nodes = Vector.update (nodes, 0, child)
|
||||
val sizes = Vector.map (fn sz => sz - decBy) sizes
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
| LEAF (items, sizes) =>
|
||||
let
|
||||
val items = Vector.map
|
||||
(fn {start, finish} =>
|
||||
{start = start - decBy, finish = finish - decBy}
|
||||
) items
|
||||
val sizes = Vector.map #finish items
|
||||
in
|
||||
LEAF (items, sizes)
|
||||
end
|
||||
|
||||
fun incrementBy (incBy, tree) =
|
||||
case tree of
|
||||
BRANCH (nodes, sizes) =>
|
||||
let
|
||||
val child = incrementBy (incBy, Vector.sub (nodes, 0))
|
||||
val nodes = Vector.update (nodes, 0, child)
|
||||
val sizes = Vector.map (fn sz => sz + incBy) sizes
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
| LEAF (items, sizes) =>
|
||||
let
|
||||
val items = Vector.map
|
||||
(fn {start, finish} =>
|
||||
{start = start + incBy, finish = finish + incBy}
|
||||
) items
|
||||
val sizes = Vector.map #finish items
|
||||
in
|
||||
LEAF (items, sizes)
|
||||
end
|
||||
|
||||
fun countDepthLoop (counter, tree) =
|
||||
case tree of
|
||||
BRANCH (nodes, _) => countDepthLoop (counter + 1, Vector.sub (nodes, 0))
|
||||
| LEAF (_, _) => counter + 1
|
||||
|
||||
fun countDepth tree = countDepthLoop (0, tree)
|
||||
|
||||
datatype merge_same_depth_result =
|
||||
MERGE_SAME_DEPTH_UPDATE of t
|
||||
| MERGE_SAME_DEPTH_FULL
|
||||
|
||||
fun mergeSameDepth (left, right) =
|
||||
case (left, right) of
|
||||
(LEAF (leftItems, leftSizes), LEAF (rightItems, rightSizes)) =>
|
||||
if Vector.length leftItems + Vector.length rightItems <= maxSize then
|
||||
let
|
||||
val offset = Vector.sub (leftSizes, Vector.length leftSizes - 1)
|
||||
val newVecLen = Vector.length leftItems + Vector.length rightItems
|
||||
val items = Vector.tabulate (newVecLen,
|
||||
fn i =>
|
||||
if i < Vector.length leftItems then
|
||||
Vector.sub (leftItems, i)
|
||||
else
|
||||
let
|
||||
val {start, finish} =
|
||||
Vector.sub (rightItems, i - Vector.length leftItems)
|
||||
in
|
||||
{start = start + offset, finish = finish + offset}
|
||||
end
|
||||
)
|
||||
val sizes = Vector.map #finish items
|
||||
in
|
||||
MERGE_SAME_DEPTH_UPDATE (LEAF (items, sizes))
|
||||
end
|
||||
else
|
||||
MERGE_SAME_DEPTH_FULL
|
||||
| (BRANCH (leftNodes, leftSizes), BRANCH (rightNodes, rightSizes)) =>
|
||||
if Vector.length leftNodes + Vector.length rightNodes <= maxSize then
|
||||
let
|
||||
val offset = Vector.sub (leftSizes, Vector.length leftSizes - 1)
|
||||
val nodes = Vector.concat [leftNodes, rightNodes]
|
||||
|
||||
val sizes = Vector.tabulate (Vector.length nodes,
|
||||
fn i =>
|
||||
if i < Vector.length leftSizes then
|
||||
Vector.sub (leftSizes, i)
|
||||
else
|
||||
Vector.sub (rightSizes, i - Vector.length leftSizes) + offset
|
||||
)
|
||||
in
|
||||
MERGE_SAME_DEPTH_UPDATE (BRANCH (nodes, sizes))
|
||||
end
|
||||
else
|
||||
MERGE_SAME_DEPTH_FULL
|
||||
| _ =>
|
||||
raise Fail "PersistentVector.mergeSameDepth: \
|
||||
\left and right should both be BRANCH or both be LEAF \
|
||||
\but one is BRANCH and one is LEAF"
|
||||
|
||||
datatype merge_diff_depth_result =
|
||||
MERGE_DIFF_DEPTH_UPDATE of t
|
||||
| MERGE_DIFF_DEPTH_FULL
|
||||
|
||||
fun mergeWhenRightDepthIsGreater (left, right, targetDepth, curDepth) =
|
||||
if curDepth = targetDepth then
|
||||
case mergeSameDepth (left, right) of
|
||||
MERGE_SAME_DEPTH_UPDATE tree => MERGE_DIFF_DEPTH_UPDATE tree
|
||||
| MERGE_SAME_DEPTH_FULL => MERGE_DIFF_DEPTH_FULL
|
||||
else
|
||||
case right of
|
||||
BRANCH (nodes, sizes) =>
|
||||
(case mergeWhenRightDepthIsGreater
|
||||
(left, Vector.sub (nodes, 0), targetDepth, curDepth + 1) of
|
||||
MERGE_DIFF_DEPTH_UPDATE child =>
|
||||
let
|
||||
val oldChildSize = Vector.sub (sizes, 0)
|
||||
val newChildSize = getFinishIdx child
|
||||
val difference = newChildSize - oldChildSize
|
||||
|
||||
val nodes = Vector.update (nodes, 0, child)
|
||||
val sizes = Vector.map (fn el => el + difference) sizes
|
||||
in
|
||||
MERGE_DIFF_DEPTH_UPDATE (BRANCH (nodes, sizes))
|
||||
end
|
||||
| MERGE_DIFF_DEPTH_FULL =>
|
||||
let
|
||||
val leftSize = getFinishIdx left
|
||||
val sizes = Vector.tabulate (Vector.length nodes + 1,
|
||||
fn i =>
|
||||
if i = 0 then
|
||||
leftSize
|
||||
else
|
||||
Vector.sub (sizes, i - 1) + leftSize
|
||||
)
|
||||
val nodes = Vector.concat [#[left], nodes]
|
||||
in
|
||||
MERGE_DIFF_DEPTH_UPDATE (BRANCH (nodes, sizes))
|
||||
end)
|
||||
| LEAF _ =>
|
||||
raise Fail "PersistentVector.mergeWhenRightDepthIsGreater: \
|
||||
\reached LEAF before (curDepth = targetDepth)"
|
||||
|
||||
fun mergeWhenLeftDepthIsGreater (left, right, targetDepth, curDepth) =
|
||||
if targetDepth = curDepth then
|
||||
case mergeSameDepth (left, right) of
|
||||
MERGE_SAME_DEPTH_UPDATE tree => MERGE_DIFF_DEPTH_UPDATE tree
|
||||
| MERGE_SAME_DEPTH_FULL => MERGE_DIFF_DEPTH_FULL
|
||||
else
|
||||
case left of
|
||||
BRANCH (nodes, sizes) =>
|
||||
(case
|
||||
mergeWhenLeftDepthIsGreater (
|
||||
Vector.sub (nodes, Vector.length nodes - 1),
|
||||
right,
|
||||
targetDepth,
|
||||
curDepth + 1) of
|
||||
MERGE_DIFF_DEPTH_UPDATE child =>
|
||||
let
|
||||
val lastIdx = Vector.length sizes - 1
|
||||
val oldChildSize = Vector.sub (sizes, lastIdx)
|
||||
val newChildSize = getFinishIdx child
|
||||
val difference = newChildSize - oldChildSize
|
||||
|
||||
val nodes = Vector.update (nodes, lastIdx, child)
|
||||
val sizes = Vector.map (fn el => el + difference) sizes
|
||||
in
|
||||
MERGE_DIFF_DEPTH_UPDATE (BRANCH (nodes, sizes))
|
||||
end
|
||||
| MERGE_DIFF_DEPTH_FULL =>
|
||||
let
|
||||
val maxLeftSize = Vector.sub (sizes, Vector.length sizes - 1)
|
||||
val rightSize = getFinishIdx right + maxLeftSize
|
||||
val sizes = Vector.concat [sizes, #[rightSize]]
|
||||
val nodes = Vector.concat [nodes, #[right]]
|
||||
in
|
||||
MERGE_DIFF_DEPTH_UPDATE (BRANCH (nodes, sizes))
|
||||
end)
|
||||
| LEAF _ =>
|
||||
raise Fail "PersistentVector.mergeWhenLeftDepthIsGreater: \
|
||||
\reached LEAF before (curDepth = targetDepth)"
|
||||
|
||||
fun merge (left, right) =
|
||||
let
|
||||
val leftDepth = countDepth left
|
||||
val rightDepth = countDepth right
|
||||
in
|
||||
if leftDepth = rightDepth then
|
||||
case mergeSameDepth (left, right) of
|
||||
MERGE_SAME_DEPTH_UPDATE t => t
|
||||
| MERGE_SAME_DEPTH_FULL =>
|
||||
let
|
||||
val leftSize = getFinishIdx left
|
||||
val sizes = #[leftSize, getFinishIdx right + leftSize]
|
||||
val nodes = #[left, right]
|
||||
in
|
||||
BRANCH (nodes, sizes)
|
||||
end
|
||||
else if leftDepth < rightDepth then
|
||||
let
|
||||
val targetDepth = rightDepth - leftDepth
|
||||
in
|
||||
case mergeWhenRightDepthIsGreater
|
||||
(left, right, targetDepth, 0) of
|
||||
MERGE_DIFF_DEPTH_UPDATE t => t
|
||||
| MERGE_DIFF_DEPTH_FULL => empty
|
||||
end
|
||||
else
|
||||
let
|
||||
val targetDepth = leftDepth - rightDepth
|
||||
in
|
||||
case mergeWhenLeftDepthIsGreater
|
||||
(left, right, targetDepth, 0) of
|
||||
MERGE_DIFF_DEPTH_UPDATE t => t
|
||||
| MERGE_DIFF_DEPTH_FULL => empty
|
||||
end
|
||||
end
|
||||
|
||||
fun delete (start, length, tree) =
|
||||
if isEmpty tree then
|
||||
empty
|
||||
else
|
||||
let
|
||||
val finish = start + length
|
||||
|
||||
val matchAfterFinish = nextMatch (finish, tree, 1)
|
||||
val matchAfterFinish =
|
||||
if matchAfterFinish < finish then
|
||||
~1
|
||||
else
|
||||
matchAfterFinish
|
||||
in
|
||||
let
|
||||
val left = splitLeft (start, tree)
|
||||
val right = splitRight (finish, tree)
|
||||
in
|
||||
if isEmpty left andalso isEmpty right then
|
||||
empty
|
||||
else if isEmpty left then
|
||||
(* just decrement right and return it *)
|
||||
let
|
||||
val rightStart = getStartIdx right
|
||||
val shouldBeStartIdx = matchAfterFinish - length
|
||||
val difference = rightStart - shouldBeStartIdx
|
||||
in
|
||||
if difference = 0 then
|
||||
right
|
||||
else
|
||||
decrementBy (difference, right)
|
||||
end
|
||||
else if isEmpty right then
|
||||
(* return left half without doing anything *)
|
||||
left
|
||||
else
|
||||
(* decrement right, and then merge both together *)
|
||||
let
|
||||
val leftSize = getFinishIdx left
|
||||
val rightStartRelative = getStartIdx right
|
||||
val rightStartAbsolute = leftSize + rightStartRelative
|
||||
|
||||
val shouldBeStartIdx = matchAfterFinish - length
|
||||
val difference = rightStartAbsolute - shouldBeStartIdx
|
||||
in
|
||||
if difference = 0 then
|
||||
merge (left, right)
|
||||
else
|
||||
let
|
||||
val right = decrementBy (difference, right)
|
||||
in
|
||||
merge (left, right)
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
(* Usually, when inserting, we want the absolute metadata
|
||||
* to be adjusted appropriately.
|
||||
* An insertion should cause the absolute metadata to increment.
|
||||
* However, we sometimes want to insert a match without adjusting
|
||||
* the absolute metadata in this way.
|
||||
* We want to do this when deleting some part of the buffer
|
||||
* would cause a new match to be found, for example. *)
|
||||
fun insertMatchKeepingAbsoluteInddices (start, finish, tree) =
|
||||
let
|
||||
val matchAfterFinish = nextMatch (finish, tree, 1)
|
||||
in
|
||||
if matchAfterFinish <= finish then
|
||||
(* no match after the 'finish', so we can just append to 'tree' *)
|
||||
append (start, finish, tree)
|
||||
else
|
||||
let
|
||||
val left = splitLeft (start, tree)
|
||||
val right = splitRight (finish, tree)
|
||||
|
||||
val left = append (start, finish, left)
|
||||
|
||||
val rightStartRelative = getStartIdx right
|
||||
val rightStartAbsolute = rightStartRelative + finish
|
||||
val difference = rightStartAbsolute - matchAfterFinish
|
||||
val right = decrementBy (difference, right)
|
||||
in
|
||||
merge (left, right)
|
||||
end
|
||||
end
|
||||
|
||||
fun extendExistingMatch (start, newFinish, tree) =
|
||||
let
|
||||
val matchAfterFinish = nextMatch (newFinish, tree, 1)
|
||||
val left = splitLeft (start, tree)
|
||||
val left = append (start, newFinish, left)
|
||||
in
|
||||
if matchAfterFinish <= newFinish then
|
||||
(* no match after newFinish, so we can return 'left'
|
||||
* which has the newFinish appended *)
|
||||
left
|
||||
else
|
||||
let
|
||||
val right = splitRight (newFinish, tree)
|
||||
|
||||
val leftFinish = getFinishIdx left
|
||||
val rightStartRelative = getStartIdx right
|
||||
|
||||
val rightStartAbsolute = rightStartRelative + leftFinish
|
||||
val difference = rightStartAbsolute - matchAfterFinish
|
||||
val right = decrementBy (difference, right)
|
||||
in
|
||||
merge (left, right)
|
||||
end
|
||||
end
|
||||
|
||||
(* functions only for testing *)
|
||||
fun childrenHaveSameDepth (pos, nodes, expectedDepth) =
|
||||
if pos = Vector.length nodes then
|
||||
true
|
||||
else
|
||||
let
|
||||
val node = Vector.sub (nodes, pos)
|
||||
in
|
||||
if allLeavesAtSameDepth node then
|
||||
let
|
||||
val nodeDepth = countDepth node
|
||||
in
|
||||
if nodeDepth = expectedDepth then
|
||||
childrenHaveSameDepth (pos + 1, nodes, expectedDepth)
|
||||
else
|
||||
false
|
||||
end
|
||||
else
|
||||
false
|
||||
end
|
||||
|
||||
and allLeavesAtSameDepth tree =
|
||||
case tree of
|
||||
BRANCH (nodes, _) =>
|
||||
let
|
||||
val expectedDepth = countDepth (Vector.sub (nodes, 0))
|
||||
in
|
||||
childrenHaveSameDepth (0, nodes, expectedDepth)
|
||||
end
|
||||
| LEAF _ => true
|
||||
|
||||
fun fromListLoop (lst, acc) =
|
||||
case lst of
|
||||
{start, finish} :: tl =>
|
||||
let
|
||||
val acc = append (start, finish, acc)
|
||||
in
|
||||
fromListLoop (tl, acc)
|
||||
end
|
||||
| [] => acc
|
||||
|
||||
fun fromList coords = fromListLoop (coords, empty)
|
||||
|
||||
fun toListLoop (tree, acc) =
|
||||
case tree of
|
||||
BRANCH (nodes, _) =>
|
||||
let
|
||||
fun branchLoop (pos, acc) =
|
||||
if pos = Vector.length nodes then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val acc = toListLoop (Vector.sub (nodes, pos), acc)
|
||||
in
|
||||
branchLoop (pos + 1, acc)
|
||||
end
|
||||
in
|
||||
branchLoop (0, acc)
|
||||
end
|
||||
| LEAF (items, _) =>
|
||||
let
|
||||
fun itemLoop (pos, acc, offset) =
|
||||
if pos = Vector.length items then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val {start, finish} = Vector.sub (items, pos)
|
||||
val item = {start = start + offset, finish = finish + offset}
|
||||
in
|
||||
itemLoop (pos + 1, item :: acc, offset)
|
||||
end
|
||||
|
||||
val offset =
|
||||
case acc of
|
||||
{finish, ...} :: _ => finish
|
||||
| [] => 0
|
||||
in
|
||||
itemLoop (0, acc, offset)
|
||||
end
|
||||
|
||||
fun toList tree =
|
||||
let
|
||||
val result = toListLoop (tree, [])
|
||||
in
|
||||
List.rev result
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user