functorise some additional functions to reduce boilerplate

This commit is contained in:
2025-08-04 03:44:45 +01:00
parent cef8467ff6
commit aca8ba44b9

View File

@@ -153,91 +153,74 @@ struct
cursorIdx cursorIdx
end end
fun helpViH (strIdx, hd, cursorIdx, leftStrings) = structure ViH =
if strIdx > 0 then MakeIfCharFolderPrev
(* bounds check: can access prev char in hd *) (struct
if String.sub (hd, strIdx - 1) = #"\n" then fun helpViH (strIdx, hd, cursorIdx, leftStrings) =
(* prev char is line break *) if strIdx > 0 then
if strIdx - 1 > 0 then (* bounds check: can access prev char in hd *)
(* bounds check: can access two chars back in hd *) if String.sub (hd, strIdx - 1) = #"\n" then
if String.sub (hd, strIdx - 2) = #"\n" then (* prev char is line break *)
(* line break followed by line break if strIdx - 1 > 0 then
* so it is fine to decrement by 1 *) (* bounds check: can access two chars back in hd *)
cursorIdx - 1 if String.sub (hd, strIdx - 2) = #"\n" then
else (* line break followed by line break
(* non-line break followed by line break * so it is fine to decrement by 1 *)
* so we have to decrement by two, cursorIdx - 1
* skipping over line break *) else
cursorIdx - 2 (* non-line break followed by line break
else * so we have to decrement by two,
(* need to check two chars back in leftStrings *) * skipping over line break *)
(case leftStrings of cursorIdx - 2
lhd :: ltl =>
if String.sub (lhd, String.size lhd - 1) = #"\n" then
(* double line break *)
cursorIdx - 1
else else
(* non-line break precedes line break *) (* need to check two chars back in leftStrings *)
cursorIdx - 2 (case leftStrings of
| [] => cursorIdx - 1) lhd :: ltl =>
else if String.sub (lhd, String.size lhd - 1) = #"\n" then
(* prev char is not line break so we can decrement by 1 *) (* double line break *)
cursorIdx - 1 cursorIdx - 1
else else
(* prev char is in leftStrings *) (* non-line break precedes line break *)
(case leftStrings of cursorIdx - 2
lhd :: ltl => | [] => cursorIdx - 1)
if String.sub (lhd, String.size lhd - 1) = #"\n" then
(* one line break *)
if String.size lhd > 1 then
(* bounds check: prev-prev chr is in lhd *)
if String.sub (lhd, String.size lhd - 2) = #"\n" then
(* double line break *)
cursorIdx - 1
else
(* non-line break precedes line break *)
cursorIdx - 2
else else
(* prev-prev chr is in ltl *) (* prev char is not line break so we can decrement by 1 *)
(case ltl of cursorIdx - 1
ltlhd :: _ =>
if String.sub (ltlhd, String.size ltlhd - 1) = #"\n" then
(* double line break *)
cursorIdx - 1
else
(* non-line break precedes line break *)
cursorIdx - 2
| [] => cursorIdx - 1)
else else
(* no line break *) (* prev char is in leftStrings *)
cursorIdx - 1 (case leftStrings of
| [] => 0) lhd :: ltl =>
if String.sub (lhd, String.size lhd - 1) = #"\n" then
(* one line break *)
if String.size lhd > 1 then
(* bounds check: prev-prev chr is in lhd *)
if String.sub (lhd, String.size lhd - 2) = #"\n" then
(* double line break *)
cursorIdx - 1
else
(* non-line break precedes line break *)
cursorIdx - 2
else
(* prev-prev chr is in ltl *)
(case ltl of
ltlhd :: _ =>
if String.sub (ltlhd, String.size ltlhd - 1) = #"\n" then
(* double line break *)
cursorIdx - 1
else
(* non-line break precedes line break *)
cursorIdx - 2
| [] => cursorIdx - 1)
else
(* no line break *)
cursorIdx - 1
| [] => 0)
(* Prerequisite: lineGap is moved to requested idx first. *) fun fStart (strIdx, hd, _, cursorIdx, leftStrings, _) =
fun viH (lineGap: LineGap.t, cursorIdx) = helpViH (strIdx, hd, cursorIdx, leftStrings)
let end)
val {rightStrings, leftStrings, idx = bufferIdx, ...} = lineGap
in val viH = ViH.foldPrev
case rightStrings of
hd :: tl =>
let
(* convert absolute cursorIdx to idx relative to hd string *)
val strIdx = cursorIdx - bufferIdx
in
if strIdx < String.size hd then
(* strIdx in hd *)
helpViH (strIdx, hd, cursorIdx, leftStrings)
else
(* strIdx in tl *)
(case tl of
tlhd :: tltl =>
let val strIdx = strIdx - String.size hd
in helpViH (strIdx, tlhd, cursorIdx, hd :: leftStrings)
end
| [] => cursorIdx)
end
| [] => cursorIdx
end
fun helpGetCursorColumn (distanceFromLine, strList, lineList) = fun helpGetCursorColumn (distanceFromLine, strList, lineList) =
case (strList, lineList) of case (strList, lineList) of
@@ -452,230 +435,215 @@ struct
| (_, _) => (* nowhere to go rightward, so return cursorIdx *) cursorIdx | (_, _) => (* nowhere to go rightward, so return cursorIdx *) cursorIdx
end end
fun helpViK structure ViK =
( strPos MakeIfCharFolderPrev
, str (struct
, absIdx fun helpViK
, lineColumn ( strPos
, preferredColumn , str
, hasPassedLine , absIdx
, strTl , lineColumn
, lineHd , preferredColumn
, lineTl , hasPassedLine
) = , strTl
if strPos < 0 then , lineHd
case (strTl, lineTl) of , lineTl
(shd :: stl, lhd :: ltl) => ) =
helpViK if strPos < 0 then
( String.size shd - 1 case (strTl, lineTl) of
, shd (shd :: stl, lhd :: ltl) =>
, absIdx helpViK
, lineColumn ( String.size shd - 1
, preferredColumn , shd
, hasPassedLine , absIdx
, stl , lineColumn
, lhd , preferredColumn
, ltl , hasPassedLine
) , stl
| (_, _) => (* empty, so return start of previous string *) absIdx + 1 , lhd
else , ltl
case String.sub (str, strPos) of )
#"\n" => | (_, _) => (* empty, so return start of previous string *)
if hasPassedLine then absIdx + 1
(* reached line break twice, else
* but line has fewer chars than preferredColumn case String.sub (str, strPos) of
* so go back to chr immediately after this second line break *) #"\n" =>
absIdx + 1 if hasPassedLine then
else (* reached line break twice,
(* reached start of line once; * but line has fewer chars than preferredColumn
* have to check if this is a double linebreak, * so go back to chr immediately after this second line break *)
* and return idx of second linebreak if so *) absIdx + 1
let else
(* have to calculate column of current line (* reached start of line once;
* so we know which line to stop searching at *) * have to check if this is a double linebreak,
val lineColumn = getCursorColumn * and return idx of second linebreak if so *)
(strPos - 1, str, lineHd, strTl, lineTl, absIdx - 1) let
in (* have to calculate column of current line
helpViK * so we know which line to stop searching at *)
( strPos - 1 val lineColumn = getCursorColumn
, str (strPos - 1, str, lineHd, strTl, lineTl, absIdx - 1)
, absIdx - 1 in
, lineColumn helpViK
, preferredColumn ( strPos - 1
, true , str
, strTl , absIdx - 1
, lineHd , lineColumn
, lineTl , preferredColumn
) , true
end , strTl
| _ => , lineHd
if lineColumn <= preferredColumn andalso hasPassedLine then , lineTl
(* We're at or before the preferredColumn so return absIdx )
* context: current line may have fewer columns end
* than our preferred column value. | _ =>
* If this is the case, we want to check if lineColumn <= preferredColumn andalso hasPassedLine then
* "is lineColumn equal to or before preferredColumn?". *) (* We're at or before the preferredColumn so return absIdx
absIdx * context: current line may have fewer columns
else * than our preferred column value.
(* we're not in the preferred column, so keep iterating *) * If this is the case, we want to check
helpViK * "is lineColumn equal to or before preferredColumn?". *)
( strPos - 1 absIdx
, str else
, absIdx - 1 (* we're not in the preferred column, so keep iterating *)
, lineColumn - 1 helpViK
, preferredColumn ( strPos - 1
, hasPassedLine , str
, strTl , absIdx - 1
, lineHd , lineColumn - 1
, lineTl , preferredColumn
) , hasPassedLine
, strTl
, lineHd
, lineTl
)
fun startViK (strIdx, shd, cursorIdx, leftStrings, lhd, leftLines) = fun fStart (strIdx, shd, lhd, cursorIdx, leftStrings, leftLines) =
if String.sub (shd, strIdx) = #"\n" then if String.sub (shd, strIdx) = #"\n" then
(* ? -> ? -> \n *) (* ? -> ? -> \n *)
if strIdx > 0 then if strIdx > 0 then
(* strIdx - 1 is in shd *) (* strIdx - 1 is in shd *)
if String.sub (shd, strIdx - 1) = #"\n" then if String.sub (shd, strIdx - 1) = #"\n" then
(* ? -> \n -> \n *) (* ? -> \n -> \n *)
if strIdx > 1 then if strIdx > 1 then
(* strIdx - 2 is in shd *) (* strIdx - 2 is in shd *)
if String.sub (shd, strIdx - 2) = #"\n" then if String.sub (shd, strIdx - 2) = #"\n" then
(* \n -> \n -> \n (* \n -> \n -> \n
* so it is safe to decrement cursorIdx by 1 *) * so it is safe to decrement cursorIdx by 1 *)
cursorIdx - 1 cursorIdx - 1
else else
(* graphical-chr -> \n -> \n (* graphical-chr -> \n -> \n
* so go to beginning of line, * so go to beginning of line,
* starting from graphical-chr *) * starting from graphical-chr *)
startVi0 startVi0
(strIdx - 2, shd, lhd, cursorIdx - 2, leftStrings, leftLines) ( strIdx - 2
else , shd
(* strIdx - 2 is in leftStrings *) , lhd
case (leftStrings, leftLines) of , cursorIdx - 2
(lshd :: lstl, llhd :: lltl) => , leftStrings
if String.sub (lshd, String.size lshd - 1) = #"\n" then , leftLines
(* \n -> \n -> \n )
* so it is safe to decrement cursorIdx by 1 *) else
cursorIdx - 1 (* strIdx - 2 is in leftStrings *)
else case (leftStrings, leftLines) of
(* graphical-chr -> \n -> \n (lshd :: lstl, llhd :: lltl) =>
* so go to beginning of line, if String.sub (lshd, String.size lshd - 1) = #"\n" then
* starting from graphical-chr *) (* \n -> \n -> \n
startVi0 * so it is safe to decrement cursorIdx by 1 *)
( String.size lshd - 1 cursorIdx - 1
, lshd else
, llhd (* graphical-chr -> \n -> \n
, cursorIdx - 2 * so go to beginning of line,
, lstl * starting from graphical-chr *)
, lltl startVi0
) ( String.size lshd - 1
| (_, _) => , lshd
(* nothing to the left, so we are at start of buffer *) , llhd
0 , cursorIdx - 2
else , lstl
(* ? -> graphical-chr -> \n , lltl
* Don't expect this case to happen )
* but if it does, go to start of line. *) | (_, _) =>
startVi0 (strIdx - 1, shd, lhd, cursorIdx - 1, leftStrings, leftLines) (* nothing to the left, so we are at start of buffer *)
else 0
(* strIdx - 1 is in leftStrings *) else
case (leftStrings, leftLines) of (* ? -> graphical-chr -> \n
(lshd :: lstl, llhd :: lltl) => * Don't expect this case to happen
if String.sub (lshd, String.size lshd - 1) = #"\n" then * but if it does, go to start of line. *)
(* ? -> \n -> \n *) startVi0
if String.size lshd > 1 then (strIdx - 1, shd, lhd, cursorIdx - 1, leftStrings, leftLines)
(* cursorIdx - 2 is in this string *) else
if String.sub (lshd, String.size lshd - 2) = #"\n" then (* strIdx - 1 is in leftStrings *)
(* \n -> \n -> \n *) case (leftStrings, leftLines) of
cursorIdx - 1 (lshd :: lstl, llhd :: lltl) =>
else if String.sub (lshd, String.size lshd - 1) = #"\n" then
(* graphical-chr -> \n -> \n *) (* ? -> \n -> \n *)
startVi0 if String.size lshd > 1 then
( String.size lshd - 2 (* cursorIdx - 2 is in this string *)
, lshd if String.sub (lshd, String.size lshd - 2) = #"\n" then
, llhd (* \n -> \n -> \n *)
, cursorIdx - 2 cursorIdx - 1
, lstl else
, lltl (* graphical-chr -> \n -> \n *)
) startVi0
else ( String.size lshd - 2
(* cursorIdx - 2 is in lstl *) , lshd
(case (lstl, lltl) of , llhd
(stlhd :: stltl, ltlhd :: lltl) => , cursorIdx - 2
if String.sub (stlhd, String.size stlhd - 1) = #"\n" then , lstl
(* \n -> \n -> \n *) , lltl
cursorIdx - 1 )
else else
(* graphical-chr -> \n -> \n *) (* cursorIdx - 2 is in lstl *)
startVi0 (case (lstl, lltl) of
( String.size stlhd - 1 (stlhd :: stltl, ltlhd :: lltl) =>
, stlhd if String.sub (stlhd, String.size stlhd - 1) = #"\n" then
, ltlhd (* \n -> \n -> \n *)
, cursorIdx - 2 cursorIdx - 1
, lstl else
, lltl (* graphical-chr -> \n -> \n *)
) startVi0
| (_, _) => 0) ( String.size stlhd - 1
else , stlhd
(* ? -> graphical-chr -> \n *) , ltlhd
startVi0 , cursorIdx - 2
( String.size lshd - 1 , lstl
, lshd , lltl
, llhd )
, cursorIdx - 1 | (_, _) => 0)
, leftStrings else
, leftLines (* ? -> graphical-chr -> \n *)
) startVi0
| (_, _) => (* leftStrings is empty so go to start of buffer *) 0 ( String.size lshd - 1
else , lshd
(* ? -> ? -> graphical-chr , llhd
* Normal case where we call startViK. *) , cursorIdx - 1
let , leftStrings
val lineColumn = getCursorColumn , leftLines
(strIdx, shd, lhd, leftStrings, leftLines, cursorIdx) )
in | (_, _) => (* leftStrings is empty so go to start of buffer *) 0
helpViK else
( strIdx (* ? -> ? -> graphical-chr
, shd * Normal case where we call startViK. *)
, cursorIdx let
, lineColumn val lineColumn = getCursorColumn
, lineColumn (strIdx, shd, lhd, leftStrings, leftLines, cursorIdx)
, false in
, leftStrings helpViK
, lhd ( strIdx
, leftLines , shd
) , cursorIdx
end , lineColumn
, lineColumn
, false
, leftStrings
, lhd
, leftLines
)
end
fun viK (lineGap: LineGap.t, cursorIdx) = end)
let
val val viK = ViK.foldPrev
{rightStrings, idx = bufferIdx, rightLines, leftStrings, leftLines, ...} =
lineGap
in
case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) =>
let
(* convert absolute cursorIdx to idx relative to hd string *)
val strIdx = cursorIdx - bufferIdx
in
if strIdx < String.size shd then
startViK (strIdx, shd, cursorIdx, leftStrings, lhd, leftLines)
else
case (stl, ltl) of
(stlhd :: stltl, ltlhd :: ltltl) =>
let
val strIdx = strIdx - String.size shd
val leftStrings = shd :: leftStrings
val leftLines = lhd :: leftLines
in
startViK
(strIdx, stlhd, cursorIdx, leftStrings, ltlhd, leftLines)
end
| (_, _) => cursorIdx
end
| (_, _) => (* nowhere to go rightward, so return cursorIdx *) cursorIdx
end
(* equivalent of vi's 'w' command *) (* equivalent of vi's 'w' command *)
val nextWord = ViWordDfa.startOfNextWord val nextWord = ViWordDfa.startOfNextWord
@@ -703,60 +671,36 @@ struct
val endOfWORD = ViWORDDfa.endOfCurrentWORD val endOfWORD = ViWORDDfa.endOfCurrentWORD
val endOfWORDForDelete = ViWORDDfa.endOfCurrentWORDForDelete val endOfWORDForDelete = ViWORDDfa.endOfCurrentWORDForDelete
fun helpFirstNonSpaceChr (strPos, str, absIdx, stl, ltl) =
if strPos = String.size str then
case (stl, ltl) of
(shd :: stl, lhd :: ltl) =>
helpFirstNonSpaceChr (0, shd, absIdx, stl, ltl)
| (_, _) => absIdx - 1
else
let
val chr = String.sub (str, strPos)
in
if chr = #" " then
helpFirstNonSpaceChr (strPos + 1, str, absIdx + 1, stl, ltl)
else
absIdx
end
fun startFirstNonSpaceChr (shd, strIdx, absIdx, stl, ltl) =
if strIdx < String.size shd then
helpFirstNonSpaceChr (strIdx, shd, absIdx, stl, ltl)
else
case (stl, ltl) of
(stlhd :: stltl, ltlhd :: ltltl) =>
helpFirstNonSpaceChr (0, stlhd, absIdx, stltl, ltltl)
| (_, _) => (* tl is empty; just return absIdx *) absIdx
(* Prerequisite: (* Prerequisite:
* LineGap has been moved to start of line (provided with vi0). *) * LineGap has been moved to start of line (provided with vi0). *)
fun firstNonSpaceChr (lineGap: LineGap.t, cursorIdx) = structure FirstNonSpaceChr =
let MakeIfCharFolderPrev
val {rightStrings, rightLines, idx = bufferIdx, ...} = lineGap (struct
in fun helpFirstNonSpaceChr (strPos, str, absIdx, stl) =
case (rightStrings, rightLines) of if strPos = String.size str then
(shd :: stl, lhd :: ltl) => case stl of
let shd :: stl => helpFirstNonSpaceChr (0, shd, absIdx, stl)
(* convert absolute cursorIdx to idx relative to hd string *) | [] => absIdx - 1
val strIdx = cursorIdx - bufferIdx else
in let
if strIdx < String.size shd then val chr = String.sub (str, strPos)
(* strIdx is in this string *) in
startFirstNonSpaceChr (shd, strIdx, cursorIdx, stl, ltl) if chr = #" " then
else helpFirstNonSpaceChr (strPos + 1, str, absIdx + 1, stl)
(* strIdx is in tl *) else
(case (stl, ltl) of absIdx
(stlhd :: stltl, ltlhd :: ltltl) => end
let
val strIdx = strIdx - String.size shd fun fStart (strIdx, shd, _, absIdx, stl, _) =
in if strIdx < String.size shd then
startFirstNonSpaceChr helpFirstNonSpaceChr (strIdx, shd, absIdx, stl)
(stlhd, strIdx, cursorIdx, stltl, ltltl) else
end case stl of
| (_, _) => cursorIdx) stlhd :: stltl => helpFirstNonSpaceChr (0, stlhd, absIdx, stltl)
end | [] => (* tl is empty; just return absIdx *) absIdx
| (_, _) => cursorIdx end)
end
val firstNonSpaceChr = FirstNonSpaceChr.foldPrev
fun helpToNextChr (strPos, str, absIdx, stl, ltl, origIdx, findChr) = fun helpToNextChr (strPos, str, absIdx, stl, ltl, origIdx, findChr) =
if strPos = String.size str then if strPos = String.size str then