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

address some bugs with one deletion function

Browse Source
This commit is contained in:
Humza Shahid
2024-07-16 00:07:38 +01:00
parent 99b1a32393
commit d47181921e
2 changed files with 192 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files

322
src/line_gap.sml
View File

@@ -53,6 +53,58 @@ struct
, rightLines = [] , rightLines = []
} }
(* TEST CODE *)
fun lineBreaksToString vec =
(Vector.foldr (fn (el, acc) => Int.toString el ^ ", " ^ acc) "" vec) ^ "\n"
fun checkLineBreaks (v1, v2) =
if v1 = v2 then
()
else
let
val _ = print ("broken: " ^ (lineBreaksToString v1))
val _ = print ("fixed: " ^ (lineBreaksToString v2))
in
()
end
fun goToStart (leftStrings, leftLines, accStrings, accLines) =
case (leftStrings, leftLines) of
(lsHd :: lsTl, llHd :: llTl) =>
goToStart (lsTl, llTl, lsHd :: accStrings, llHd :: accLines)
| (_, _) => (accStrings, accLines)
fun verifyLineList (strings, lines) =
case (strings, lines) of
(strHd :: strTl, lHd :: lTl) =>
let
val checkLines = countLineBreaks strHd
in
if checkLines = lHd then
verifyLineList (strTl, lTl)
else
let
val _ = print "line metadata is incorrect\n"
val _ = checkLineBreaks (lHd, checkLines)
in
raise Empty
end
end
| (_, _) => print "verified lines; no problems\n"
fun verifyLines (buffer: t) =
let
val (strings, lines) =
goToStart
( #leftStrings buffer
, #leftLines buffer
, #rightStrings buffer
, #rightLines buffer
)
in
verifyLineList (strings, lines)
end
local local
fun helpToString (acc, input) = fun helpToString (acc, input) =
case input of case input of
@@ -947,7 +999,8 @@ struct
end end
end end
fun println str = print (str ^ "\n") fun println str =
print (str ^ "\n")
(* Delete function and helper functions for it. *) (* Delete function and helper functions for it. *)
local local
@@ -968,16 +1021,20 @@ struct
in in
if nextIdx < finish then if nextIdx < finish then
(* Keep moving right. *) (* Keep moving right. *)
deleteRightFromHere let
( origIdx val _ = println "971"
, origLine in
, nextIdx deleteRightFromHere
, finish ( origIdx
, leftStrings , origLine
, leftLines , nextIdx
, rightStringsTl , finish
, rightLinesTl , leftStrings
) , leftLines
, rightStringsTl
, rightLinesTl
)
end
else if nextIdx > finish then else if nextIdx > finish then
(* Base case: delete from the start of this string and stop moving. *) (* Base case: delete from the start of this string and stop moving. *)
let let
@@ -1089,20 +1146,43 @@ struct
) )
val newLeftStrings = newLeftStringsHd :: leftStringsTl val newLeftStrings = newLeftStringsHd :: leftStringsTl
val newLeftLines = newLeftLinesHd :: leftLinesTl val newLeftLines = newLeftLinesHd :: leftLinesTl
in
let
val _ = println "1093"
in
moveRightAndDelete
( start
, finish
, nextIdx
, curLine + Vector.length rightLinesHd
, newLeftStrings
, newLeftLines
, rightStringsTl
, rightLinesTl
)
end
end
else
(* Can't join heads while staying in limit, so just cons. *)
let
val _ = println "1108"
in in
moveRightAndDelete moveRightAndDelete
( start ( start
, finish , finish
, nextIdx , nextIdx
, curLine + Vector.length rightLinesHd , curLine + Vector.length rightLinesHd
, newLeftStrings , rightStringsHd :: leftStrings
, newLeftLines , rightLinesHd :: leftLines
, rightStringsTl , rightStringsTl
, rightLinesTl , rightLinesTl
) )
end end
else | (_, _) =>
(* Can't join heads while staying in limit, so just cons. *) (* Can't join heads while staying in limit, so just cons. *)
let
val _ = println "1121"
in
moveRightAndDelete moveRightAndDelete
( start ( start
, finish , finish
@@ -1113,18 +1193,7 @@ struct
, rightStringsTl , rightStringsTl
, rightLinesTl , rightLinesTl
) )
| (_, _) => end)
(* Can't join heads while staying in limit, so just cons. *)
moveRightAndDelete
( start
, finish
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
))
else if nextIdx > start then else if nextIdx > start then
if nextIdx < finish then if nextIdx < finish then
(* Start deleting from the end of this string, (* Start deleting from the end of this string,
@@ -1138,7 +1207,7 @@ struct
val newLines = val newLines =
if lineDeleteEnd >= 0 then if lineDeleteEnd >= 0 then
let let
val _ = println "1141" val _ = println "1141"
val slice = VectorSlice.slice val slice = VectorSlice.slice
(rightLinesHd, 0, SOME (lineDeleteEnd + 1)) (rightLinesHd, 0, SOME (lineDeleteEnd + 1))
in in
@@ -1239,13 +1308,16 @@ struct
val sub2LineStart = forwardBinSearch (sub2Start, rightLinesHd) val sub2LineStart = forwardBinSearch (sub2Start, rightLinesHd)
val sub2Lines = val sub2Lines =
if sub2LineStart < Vector.length rightLinesHd then if sub2LineStart < Vector.length rightLinesHd then
let val _ = println "1242" in let
Vector.tabulate val _ = println "1242"
( Vector.length rightLinesHd - Vector.length sub1Lines in
, fn idx => Vector.tabulate
Vector.sub (rightLinesHd, idx + sub2LineStart) ( Vector.length rightLinesHd - Vector.length sub1Lines
- (String.size rightStringsHd - String.size sub2) , fn idx =>
) end Vector.sub (rightLinesHd, idx + sub2LineStart)
- (String.size rightStringsHd - String.size sub2)
)
end
else else
Vector.fromList [] Vector.fromList []
in in
@@ -1441,15 +1513,19 @@ struct
in in
if start < prevIdx then if start < prevIdx then
(* Continue deleting leftward. *) (* Continue deleting leftward. *)
deleteLeftFromHere let
( start val _ = println "1449"
, prevIdx in
, prevLine deleteLeftFromHere
, leftStringsTl ( start
, leftLinesTl , prevIdx
, rightStrings , prevLine
, rightLines , leftStringsTl
) , leftLinesTl
, rightStrings
, rightLines
)
end
else if start > prevIdx then else if start > prevIdx then
(* Base case: delete end part of this string and return. *) (* Base case: delete end part of this string and return. *)
let let
@@ -1585,6 +1661,26 @@ struct
) )
val newRightStrings = newRightStringsHd :: rightStringsTl val newRightStrings = newRightStringsHd :: rightStringsTl
val newRightLines = newRightLinesHd :: rightLinesTl val newRightLines = newRightLinesHd :: rightLinesTl
in
let
val _ = println "1595"
in
moveLeftAndDelete
( start
, finish
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, newRightStrings
, newRightLines
)
end
end
else
(* Cannot join while staying in limit, so don't. *)
let
val _ = println "1609"
in in
moveLeftAndDelete moveLeftAndDelete
( start ( start
@@ -1593,22 +1689,10 @@ struct
, curLine - Vector.length leftLinesHd , curLine - Vector.length leftLinesHd
, leftStringsTl , leftStringsTl
, leftLinesTl , leftLinesTl
, newRightStrings , leftStringsHd :: rightStrings
, newRightLines , leftLinesHd :: rightLines
) )
end end
else
(* Cannot join while staying in limit, so don't. *)
moveLeftAndDelete
( start
, finish
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
)
| (_, _) => | (_, _) =>
(* Base case: reached empty list while trying to move leftwards. (* Base case: reached empty list while trying to move leftwards.
* Cannot do anything so just return. *) * Cannot do anything so just return. *)
@@ -1637,7 +1721,7 @@ struct
in in
if midpoint >= 0 then if midpoint >= 0 then
let let
val _ = println "1640" val _ = println "1640"
val slice = VectorSlice.slice val slice = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1)) (leftLinesHd, 0, SOME (midpoint + 1))
in in
@@ -1675,37 +1759,68 @@ struct
) )
val sub1Lines = val sub1Lines =
let if Vector.length leftLinesHd > 0 then
val midpoint = binSearch let
(String.size sub1 - 1, leftLinesHd) val midpoint = binSearch
in (String.size sub1 - 1, leftLinesHd)
if midpoint >= 0 then in
let if midpoint >= 0 then
val _ = println "1684" let
val slice = VectorSlice.slice val _ = println "1684"
(leftLinesHd, 0, SOME (midpoint)) val _ = println
in ("midpoint: " ^ Int.toString midpoint)
VectorSlice.vector slice val _ = println
end ("lenth: "
else ^ Int.toString (Vector.length leftLinesHd))
Vector.fromList [] val slice = VectorSlice.slice
end (leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector slice
end
else
Vector.fromList []
end
else
leftLinesHd
val realsub1lines = countLineBreaks sub1
val _ =
if realsub1lines = sub1Lines then
()
else
let
val _ = println "realsub1lines error"
val _ = checkLineBreaks (sub1Lines, realsub1lines)
val _ = println "after realsub1lines error"
in
()
end
val sub2Lines = val sub2Lines =
let let
val midpoint = forwardBinSearch (sub2Start, leftLinesHd) val midpoint = forwardBinSearch (sub2Start, leftLinesHd)
val _ = println "1697" val _ = println "1697"
val _ = println
("leftLinesHd: "
^ Int.toString (Vector.length leftLinesHd))
val _ = println ("midpoint: " ^ Int.toString (midpoint))
in in
if midpoint < Vector.length leftLinesHd then if midpoint < Vector.length leftLinesHd then
Vector.tabulate Vector.tabulate
( Vector.length leftLinesHd - midpoint ( Vector.length leftLinesHd - midpoint
, fn idx => , fn idx =>
Vector.sub (leftLinesHd, idx + midpoint) Vector.sub (leftLinesHd, idx + (midpoint))
- sub2Start - sub2Start
) )
else else
Vector.fromList [] Vector.fromList []
end end
val realsub2lines = countLineBreaks sub2
val _ =
if realsub2lines = sub2Lines then ()
else println "realsub2lines error"
in in
{ idx = prevIdx + String.size sub1 { idx = prevIdx + String.size sub1
, line = , line =
@@ -1772,7 +1887,7 @@ struct
(* Can join while staying in limit. *) (* Can join while staying in limit. *)
let let
val newRightStringsHd = leftStringsHd ^ rightStringsHd val newRightStringsHd = leftStringsHd ^ rightStringsHd
val _ = println "1776" val _ = println "1776"
val newRightLinesHd = val newRightLinesHd =
Vector.tabulate Vector.tabulate
( Vector.length leftLinesHd ( Vector.length leftLinesHd
@@ -1883,7 +1998,6 @@ struct
, rightStrings , rightStrings
, rightLines , rightLines
) )
in in
fun delete (start, length, buffer: t) = fun delete (start, length, buffer: t) =
if length > 0 then if length > 0 then
@@ -1901,58 +2015,4 @@ struct
buffer buffer
end end
(* TEST CODE *)
local
fun lineBreaksToString vec =
(Vector.foldr (fn (el, acc) => Int.toString el ^ ", " ^ acc) "" vec)
^ "\n"
fun checkLineBreaks (v1, v2) =
if v1 = v2 then
()
else
let
val _ = print ("broken: " ^ (lineBreaksToString v1))
val _ = print ("fixed: " ^ (lineBreaksToString v2))
in
()
end
fun goToStart (leftStrings, leftLines, accStrings, accLines) =
case (leftStrings, leftLines) of
(lsHd :: lsTl, llHd :: llTl) =>
goToStart (lsTl, llTl, lsHd :: accStrings, llHd :: accLines)
| (_, _) => (accStrings, accLines)
fun verifyLineList (strings, lines) =
case (strings, lines) of
(strHd :: strTl, lHd :: lTl) =>
let
val checkLines = countLineBreaks strHd
in
if checkLines = lHd then
verifyLineList (strTl, lTl)
else
let
val _ = print "line metadata is incorrect\n"
val _ = checkLineBreaks (lHd, checkLines)
in
raise Empty
end
end
| (_, _) => print "verified lines; no problems\n"
in
fun verifyLines (buffer: t) =
let
val (strings, lines) =
goToStart
( #leftStrings buffer
, #leftLines buffer
, #rightStrings buffer
, #rightLines buffer
)
in
verifyLineList (strings, lines)
end
end
end end

1
tests/compare_to_rope.sml
View File

@@ -19,6 +19,7 @@ struct
val gapBuffer = val gapBuffer =
if strSize > 0 then LineGap.insert (pos, insStr, gapBuffer) if strSize > 0 then LineGap.insert (pos, insStr, gapBuffer)
else gapBuffer else gapBuffer
val _ = LineGap.verifyLines gapBuffer
val ropeString = TinyRope.toString rope val ropeString = TinyRope.toString rope
val gapBufferString = LineGap.toString gapBuffer val gapBufferString = LineGap.toString gapBuffer