progress with insertion on line_gap.sml

This commit is contained in:
2024-06-29 06:50:52 +01:00
parent 2583e0edea
commit 99de90febc

View File

@@ -75,7 +75,16 @@ struct
val newStrHd = strHd ^ newString val newStrHd = strHd ^ newString
val newLeftString = newStrHd :: strTl val newLeftString = newStrHd :: strTl
val newLine = curLine + Vector.length newLines val newLine = curLine + Vector.length newLines
val newLinesHd = Vector.concat [lineHd, newLines] val newLinesHd =
Vector.tabulate
( Vector.length lineHd + Vector.length newLines
, fn idx =>
if idx < Vector.length lineHd then
Vector.sub (lineHd, idx)
else
Vector.sub (newLines, idx - Vector.length lineHd)
+ String.size strHd
)
val newLeftLines = newLinesHd :: lineTl val newLeftLines = newLinesHd :: lineTl
in in
{ idx = newIdx { idx = newIdx
@@ -121,31 +130,31 @@ struct
, rightStrings , rightStrings
, rightLines , rightLines
, prevIdx , prevIdx
, leftStrHd , leftStringsHd
, leftStrTl , leftStringsTl
, leftLineHd , leftLinesHd
, leftLineTl , leftLinesTl
) : t = ) : t =
if idx = prevIdx then if idx = prevIdx then
(* Need to insert at the start of the left list. *) (* Need to insert at the start of the left list. *)
if isInLimit (newString, leftStrHd, newLines, leftLineHd) then if isInLimit (newString, leftStringsHd, newLines, leftLinesHd) then
let let
(* Create new vector, adjusting indices as needed. *) (* Create new vector, adjusting indices as needed. *)
val joinedLines = val joinedLines =
Vector.tabulate Vector.tabulate
( Vector.length newLines + Vector.length leftLineHd ( Vector.length newLines + Vector.length leftLinesHd
, fn idx => , fn idx =>
if idx < Vector.length newLines then if idx < Vector.length newLines then
Vector.sub (newLines, idx) Vector.sub (newLines, idx)
else else
Vector.sub (leftLineHd, idx - Vector.length newLines) Vector.sub (leftLinesHd, idx - Vector.length newLines)
+ String.size newString + String.size newString
) )
in in
{ idx = curIdx + String.size newString { idx = curIdx + String.size newString
, line = curLine + Vector.length newLines , line = curLine + Vector.length newLines
, leftStrings = (newString ^ leftStrHd) :: leftStrTl , leftStrings = (newString ^ leftStringsHd) :: leftStringsTl
, leftLines = joinedLines :: leftLineTl , leftLines = joinedLines :: leftLinesTl
, rightStrings = rightStrings , rightStrings = rightStrings
, rightLines = rightLines , rightLines = rightLines
} }
@@ -154,8 +163,8 @@ struct
(* Just cons everything; no way we can join while staying in limit. *) (* Just cons everything; no way we can join while staying in limit. *)
{ idx = curIdx + String.size newString { idx = curIdx + String.size newString
, line = curLine + Vector.length newLines , line = curLine + Vector.length newLines
, leftStrings = leftStrHd :: newString :: leftStrTl , leftStrings = leftStringsHd :: newString :: leftStringsTl
, leftLines = leftLineHd :: newLines :: leftLineTl , leftLines = leftLinesHd :: newLines :: leftLinesTl
, rightStrings = rightStrings , rightStrings = rightStrings
, rightLines = rightLines , rightLines = rightLines
} }
@@ -164,37 +173,37 @@ struct
let let
(* Get string slices on both sides. *) (* Get string slices on both sides. *)
val strLength = idx - prevIdx val strLength = idx - prevIdx
val strSub1 = String.substring (leftStrHd, 0, strLength) val strSub1 = String.substring (leftStringsHd, 0, strLength)
val strSub2 = String.substring val strSub2 = String.substring
(leftStrHd, strLength, String.size leftStrHd - strLength) (leftStringsHd, strLength, String.size leftStringsHd - strLength)
val midpoint = val midpoint =
binSearch binSearch
(String.size strSub1, leftLineHd, 0, Vector.length leftLineHd) (String.size strSub1, leftLinesHd, 0, Vector.length leftLinesHd)
in in
if if
isThreeInLimit (strSub1, newString, strSub2, leftLineHd, newLines) isThreeInLimit (strSub1, newString, strSub2, leftLinesHd, newLines)
then then
(* Join three strings together. *) (* Join three strings together. *)
let let
val joinedLines = val joinedLines =
Vector.tabulate Vector.tabulate
( Vector.length leftLineHd + Vector.length newLines ( Vector.length leftLinesHd + Vector.length newLines
, fn idx => , fn idx =>
if idx < midpoint then if idx < midpoint then
Vector.sub (leftLineHd, idx) Vector.sub (leftLinesHd, idx)
else if idx < midpoint + String.size newString then else if idx < midpoint + String.size newString then
Vector.sub (newLines, idx - midpoint) Vector.sub (newLines, idx - midpoint)
- String.size strSub1 - String.size strSub1
else else
Vector.sub (leftLineHd, idx - Vector.length newLines) Vector.sub (leftLinesHd, idx - Vector.length newLines)
+ String.size newString + String.size newString
) )
in in
{ idx = curIdx + String.size newString { idx = curIdx + String.size newString
, line = curLine + Vector.length newLines , line = curLine + Vector.length newLines
, leftStrings = , leftStrings =
String.concat [strSub1, newString, strSub2] :: leftStrTl String.concat [strSub1, newString, strSub2] :: leftStringsTl
, leftLines = joinedLines :: leftLineTl , leftLines = joinedLines :: leftLinesTl
, rightStrings = rightStrings , rightStrings = rightStrings
, rightLines = rightLines , rightLines = rightLines
} }
@@ -208,18 +217,18 @@ struct
let let
val newLeftLines = val newLeftLines =
Vector.tabulate (midpoint + Vector.length newLines, fn idx => Vector.tabulate (midpoint + Vector.length newLines, fn idx =>
if idx < midpoint then Vector.sub (leftLineHd, idx) if idx < midpoint then Vector.sub (leftLinesHd, idx)
else Vector.sub (newLines, idx - midpoint) + String.size strSub1) else Vector.sub (newLines, idx - midpoint) + String.size strSub1)
val newRightLines = VectorSlice.slice (leftLineHd, midpoint, SOME val newRightLines = VectorSlice.slice (leftLinesHd, midpoint, SOME
(Vector.length leftLineHd - midpoint)) (Vector.length leftLinesHd - midpoint))
val newRightLines = VectorSlice.vector newRightLines val newRightLines = VectorSlice.vector newRightLines
in in
{ idx = prevIdx + String.size strSub1 + String.size newString { idx = prevIdx + String.size strSub1 + String.size newString
, line = , line =
(curLine - Vector.length leftLineHd) (curLine - Vector.length leftLinesHd)
+ Vector.length newLeftLines + Vector.length newLeftLines
, leftStrings = (strSub1 ^ newString) :: leftStrTl , leftStrings = (strSub1 ^ newString) :: leftStringsTl
, leftLines = newLeftLines :: leftLineTl , leftLines = newLeftLines :: leftLinesTl
, rightStrings = strSub2 :: rightStrings , rightStrings = strSub2 :: rightStrings
, rightLines = newRightLines :: rightLines , rightLines = newRightLines :: rightLines
} }
@@ -227,30 +236,31 @@ struct
else if else if
String.size newString + String.size strSub2 <= stringLimit String.size newString + String.size strSub2 <= stringLimit
andalso andalso
(Vector.length leftLineHd - midpoint) + Vector.length newLines (Vector.length leftLinesHd - midpoint) + Vector.length newLines
<= vecLimit <= vecLimit
then then
(* If we can join newString/line with sub2 while staying (* If we can join newString/line with sub2 while staying
* in limit. *) * in limit. *)
let let
val newLeftLines = VectorSlice.slice (leftLineHd, 0, SOME midpoint) val newLeftLines = VectorSlice.slice (leftLinesHd, 0, SOME midpoint)
val newLeftLines = VectorSlice.vector newLeftLines val newLeftLines = VectorSlice.vector newLeftLines
val newRightLines = val newRightLines =
Vector.tabulate Vector.tabulate
( (Vector.length leftLineHd - midpoint) + Vector.length newLines ( (Vector.length leftLinesHd - midpoint)
+ Vector.length newLines
, fn idx => , fn idx =>
if idx < Vector.length newLines then if idx < Vector.length newLines then
Vector.sub (newLines, idx) Vector.sub (newLines, idx)
else else
(Vector.sub (leftLineHd, idx - Vector.length newLines) (Vector.sub (leftLinesHd, idx - Vector.length newLines)
- String.size strSub1) + String.size newString - String.size strSub1) + String.size newString
) )
in in
{ idx = prevIdx + String.size strSub1 { idx = prevIdx + String.size strSub1
, line = (curLine - Vector.length leftLineHd) + midpoint , line = (curLine - Vector.length leftLinesHd) + midpoint
, leftStrings = strSub1 :: leftStrTl , leftStrings = strSub1 :: leftStringsTl
, leftLines = newLeftLines :: leftLineTl , leftLines = newLeftLines :: leftLinesTl
, rightStrings = (newString ^ strSub2) :: rightStrings , rightStrings = (newString ^ strSub2) :: rightStrings
, rightLines = newRightLines :: rightLines , rightLines = newRightLines :: rightLines
} }
@@ -258,25 +268,216 @@ struct
else else
(* Can't join on either side while staying in limit. *) (* Can't join on either side while staying in limit. *)
let let
val lineSub1 = VectorSlice.slice (leftLineHd, 0, SOME midpoint) val lineSub1 = VectorSlice.slice (leftLinesHd, 0, SOME midpoint)
val lineSub1 = VectorSlice.vector lineSub1 val lineSub1 = VectorSlice.vector lineSub1
val lineSub2 = VectorSlice.slice (leftLineHd, midpoint, SOME val lineSub2 = VectorSlice.slice (leftLinesHd, midpoint, SOME
(Vector.length leftLineHd - midpoint)) (Vector.length leftLinesHd - midpoint))
val lineSub2 = VectorSlice.vector lineSub2 val lineSub2 = VectorSlice.vector lineSub2
in in
{ idx = prevIdx + String.size strSub1 + String.size newString { idx = prevIdx + String.size strSub1 + String.size newString
, line = , line =
(curLine - String.size leftStrHd) + midpoint (curLine - String.size leftStringsHd) + midpoint
+ Vector.length newLines + Vector.length newLines
, leftStrings = newString :: strSub1 :: leftStrTl , leftStrings = newString :: strSub1 :: leftStringsTl
, leftLines = newLines :: lineSub1 :: leftLineTl , leftLines = newLines :: lineSub1 :: leftLinesTl
, rightStrings = strSub2 :: rightStrings , rightStrings = strSub2 :: rightStrings
, rightLines = lineSub1 :: rightLines , rightLines = lineSub1 :: rightLines
} }
end end
end end
fun moveLeftAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
) =
case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
let
val prevIdx = curIdx - String.size leftStringsHd
in
if idx < prevIdx then
(*
* Need to move leftward.
* The rather complicated code below is an optimisation checking
* if we can minimise the number of lists in the gap buffer
* by concatenating lines/strings together while staying
* under the limit.
* *)
(case (rightStrings, rightLines) of
(rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) =>
if
isInLimit
(leftStringsHd, rightStringsHd, leftLinesHd, rightLinesHd)
then
let
val prevLine = curLine - Vector.length leftLinesHd
val newRightStringsHd = leftStringsHd ^ rightStringsHd
val newRightLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
(rightLinesHd, idx - Vector.length leftLinesHd)
+ String.size leftStringsHd
)
in
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, prevLine
, leftStringsTl
, leftLinesTl
, newRightLinesHd :: rightStringsTl
, newRightLinesHd :: rightLinesTl
)
end
else
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
)
| (_, _) =>
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length newLines
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
))
else
(* Insertion is somewhere between the head of the left list,
* and the tail of the left list. *)
insInLeftList
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, prevIdx
, leftStringsHd
, leftStringsTl
, leftLinesHd
, leftLinesTl
)
end
| (_, _) =>
(* Left list is empty, so need to cons or join.
* Just set left string/list as newString/newLines. *)
{ idx = String.size newString
, line = Vector.length newLines
, leftStrings = [newString]
, leftLines = [newLines]
, rightStrings = rightStrings
, rightLines = rightLines
}
fun moveRightAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
) =
case (rightStrings, rightLines) of
(rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) =>
let
val nextIdx = curIdx + String.size rightStringsHd
in
if idx > nextIdx then
(* Need to move rightward. *)
(case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
if
isInLimit
(leftStringsHd, rightStringsHd, leftLinesHd, rightLinesHd)
then
let
val nextLine = curLine + Vector.length rightLinesHd
val newLeftStringsHd = leftStringsHd ^ rightStringsHd
val newLeftLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
(rightLinesHd, idx - Vector.length leftLinesHd)
+ String.size leftStringsHd
)
in
moveRightAndIns
( idx
, newString
, newLines
, nextIdx
, nextLine
, newLeftStringsHd :: leftStringsTl
, newLeftLinesHd :: leftLinesTl
, rightStringsTl
, rightLinesTl
)
end
else
moveRightAndIns
( idx
, newString
, newLines
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
, rightLinesHd :: leftStrings
, rightStringsTl
, rightLinesTl
))
else
(* Need to insert in the middle of the right string's hd. *)
0
end
| (_, _) =>
(* Right string/line is empty. *)
{ idx = curIdx
, line = curLine
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = [newString]
, rightLines = [newLines]
}
fun ins fun ins
( idx ( idx
, newString , newString
@@ -300,58 +501,7 @@ struct
, rightLines , rightLines
) )
else if idx < curIdx then else if idx < curIdx then
(* Check if we need to insert leftward or move the gap buffer left. *) moveLeftAndIns
case (leftStrings, leftLines) of
(leftStrHd :: leftStrTl, leftLineHd :: leftLineTl) =>
let
val prevIdx = curIdx - String.size leftStrHd
in
if idx < prevIdx then
(* Need to move leftward.
* The rather complicated code below is an optimisation checking
* if we can minimise the number of lists in the gap buffer
* by concatenating lines/strings together while staying
* under the limit. *)
(case (rightStrings, rightLines) of
(rightStrHd :: rightStrTl, rightLineHd :: rightLineTl) =>
if isInLimit (leftStrHd, rightStrHd, leftLineHd, rightLineHd) then
ins
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length newLines
, leftStrTl
, leftLineTl
, (leftStrHd ^ rightStrHd) :: rightStrTl
, (Vector.concat [leftLineHd, rightLineHd] :: rightLineTl)
)
else
ins
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length newLines
, leftStrTl
, leftLineTl
, leftStrHd :: rightStrings
, leftLineHd :: rightLines
)
| (_, _) =>
ins
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length newLines
, leftStrTl
, leftLineTl
, leftStrHd :: rightStrings
, leftLineHd :: rightLines
))
else
insInLeftList
( idx ( idx
, newString , newString
, newLines , newLines
@@ -361,24 +511,19 @@ struct
, leftLines , leftLines
, rightStrings , rightStrings
, rightLines , rightLines
, prevIdx
, leftStrHd
, leftStrTl
, leftLineHd
, leftLineTl
) )
end
| (_, _) =>
(* The left list is empty, so no need to cons or join.
* Just set the left values to the newString/newLine. *)
{ idx = String.size newString
, line = Vector.length newLines
, leftStrings = [newString]
, leftLines = [newLines]
, rightStrings = rightStrings
, rightLines = rightLines
}
else else
raise Empty (* idx > curIdx. *)
moveRightAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightString
, rightLines
)
end end