use concurrency for rebuilding search list after deletion so we don't block main thread on very, very large files

This commit is contained in:
2025-08-07 12:20:57 +01:00
parent fab8cfcf20
commit 704854c80f
10 changed files with 220 additions and 137 deletions

View File

@@ -9,6 +9,14 @@ struct
fun clearMode app =
AppWith.mode (app, NORMAL_MODE "", [])
fun withSearchList (app: app_type, searchList) =
let
val {buffer, searchString, cursorIdx, ...} = app
val app = AppWith.searchList (app, searchList, buffer, searchString)
in
Finish.buildTextAndClear (app, buffer, cursorIdx, searchList, [])
end
fun resizeText (app: app_type, newWidth, newHeight) =
let
val
@@ -33,6 +41,7 @@ struct
, newHeight
, searchList
, searchString
, []
)
in
AppWith.bufferAndSize
@@ -44,7 +53,8 @@ struct
* where the cursor may possibly jump off window by a wide marigin.
* Since the cursor may move away a lot, it is best to recenter.
* *)
fun buildTextAndClearAfterChr (app: app_type, buffer, cursorIdx, searchList) =
fun buildTextAndClearAfterChr
(app: app_type, buffer, cursorIdx, searchList, initialMsg) =
let
val {windowWidth, windowHeight, startLine, searchString, ...} = app
@@ -68,6 +78,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
val mode = NORMAL_MODE ""
@@ -104,6 +115,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
in
AppWith.bufferAndCursorIdx
@@ -129,6 +141,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
val mode = NORMAL_MODE ""
@@ -169,6 +182,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
val mode = NORMAL_MODE ""
@@ -211,6 +225,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
val mode = NORMAL_MODE ""
@@ -253,6 +268,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
in
AppWith.bufferAndCursorIdx
@@ -283,6 +299,7 @@ struct
, windowHeight
, searchList
, searchString
, []
)
in
AppWith.bufferAndCursorIdx
@@ -309,12 +326,12 @@ struct
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val cursorIdx = Cursor.firstNonSpaceChr (buffer, cursorIdx)
in
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app)
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, [])
end
fun helpMoveToChr (app: app_type, buffer, cursorIdx, count, fMove, chr) =
if count = 0 then
buildTextAndClearAfterChr (app, buffer, cursorIdx, #searchList app)
buildTextAndClearAfterChr (app, buffer, cursorIdx, #searchList app, [])
else
let
(* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *)
@@ -335,6 +352,7 @@ struct
CHAR_EVENT chr => moveToChr (app, count, fMove, chr)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
fun handleGo (count, app, newCmd) =
case newCmd of
@@ -346,12 +364,19 @@ struct
| _ => clearMode app)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
(* text-delete functions *)
(** equivalent of vi's 'x' command **)
fun helpRemoveChr (app: app_type, buffer, searchList, cursorIdx, count) =
fun helpRemoveChr (app: app_type, buffer, cursorIdx, count) =
if count = 0 then
Finish.buildTextAndClear (app, buffer, cursorIdx, searchList)
let
val buffer = LineGap.goToEnd buffer
val initialMsg = [SEARCH (buffer, #searchString app)]
in
Finish.buildTextAndClear
(app, buffer, cursorIdx, SearchList.empty, initialMsg)
end
else
let
val buffer = LineGap.goToIdx (cursorIdx, buffer)
@@ -374,9 +399,9 @@ struct
(* vi simply doesn't do anything on 'x' command
* when cursor is at start of line, and next chr is line break
* so skip to end of loop by passing count of 0 *)
helpRemoveChr (app, buffer, searchList, cursorIdx, 0)
helpRemoveChr (app, buffer, cursorIdx, 0)
else if cursorIsStart then
helpRemoveChr (app, buffer, searchList, cursorIdx, 0)
helpRemoveChr (app, buffer, cursorIdx, 0)
else if nextIsEnd then
let
(* delete char at cursor and then decrement cursorIdx by 1
@@ -384,8 +409,6 @@ struct
val searchString = #searchString app
val buffer = LineGap.delete (cursorIdx, 1, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
val cursorIdx =
if
Cursor.isPrevChrStartOfLine (buffer, cursorIdx)
@@ -393,21 +416,19 @@ struct
then cursorIdx
else cursorIdx - 1
in
helpRemoveChr (app, buffer, searchList, cursorIdx, count - 1)
helpRemoveChr (app, buffer, cursorIdx, count - 1)
end
else
let
val searchString = #searchString app
val buffer = LineGap.delete (cursorIdx, 1, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
in
helpRemoveChr (app, buffer, searchList, cursorIdx, count - 1)
helpRemoveChr (app, buffer, cursorIdx, count - 1)
end
end
fun removeChr (app: app_type, count) =
helpRemoveChr (app, #buffer app, #searchList app, #cursorIdx app, count)
helpRemoveChr (app, #buffer app, #cursorIdx app, count)
fun helpDelete (app: app_type, buffer, cursorIdx, otherIdx, count, fMove) =
(* As a small optimisation to reduce allocations,
@@ -426,8 +447,9 @@ struct
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToEnd buffer
val searchString = #searchString app
val (buffer, searchList) = SearchList.build (buffer, searchString)
val initialMsg = [SEARCH (buffer, searchString)]
(* If we have deleted from the buffer so that cursorIdx
* is no longer a valid idx,
@@ -435,7 +457,8 @@ struct
val buffer = LineGap.goToIdx (low, buffer)
val cursorIdx = Cursor.clipIdx (buffer, low)
in
Finish.buildTextAndClear (app, buffer, cursorIdx, searchList)
Finish.buildTextAndClear
(app, buffer, cursorIdx, SearchList.empty, initialMsg)
end
else
let
@@ -463,11 +486,12 @@ struct
val buffer = LineGap.delete (low, length, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
val buffer = LineGap.goToEnd buffer
val initialMsg = [SEARCH (buffer, searchString)]
val buffer = LineGap.goToIdx (low, buffer)
in
Finish.buildTextAndClear (app, buffer, low, searchList)
Finish.buildTextAndClear (app, buffer, low, SearchList.empty, initialMsg)
end
fun deleteToEndOfLine (app: app_type) =
@@ -489,12 +513,8 @@ struct
val lastChr = Cursor.viDlr (buffer, cursorIdx, 1)
val length = lastChr - cursorIdx
val buffer = LineGap.delete (cursorIdx, length, buffer)
(* delete from searchList and map *)
val searchString = #searchString app
val (buffer, searchList) = SearchList.build (buffer, searchString)
in
helpRemoveChr (app, buffer, searchList, cursorIdx, 1)
helpRemoveChr (app, buffer, cursorIdx, 1)
end
end
@@ -509,11 +529,13 @@ struct
val length = finishIdx - startIdx
val buffer = LineGap.delete (startIdx, length, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
val buffer = LineGap.goToEnd buffer
val initialMsg = [SEARCH (buffer, searchString)]
val buffer = LineGap.goToIdx (startIdx, buffer)
in
Finish.buildTextAndClear (app, buffer, startIdx, searchList)
Finish.buildTextAndClear
(app, buffer, startIdx, SearchList.empty, initialMsg)
end
fun helpDeleteLineBack (app, buffer, low, high, count) =
@@ -523,12 +545,14 @@ struct
val length = high - low
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToEnd buffer
val searchString = #searchString app
val (buffer, searchList) = SearchList.build (buffer, searchString)
val initialMsg = [SEARCH (buffer, searchString)]
val buffer = LineGap.goToIdx (low, buffer)
in
Finish.buildTextAndClear (app, buffer, low, searchList)
Finish.buildTextAndClear
(app, buffer, low, SearchList.empty, initialMsg)
end
else
let
@@ -575,9 +599,11 @@ struct
val length = high - low
val buffer = LineGap.delete (low, length, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
val buffer = LineGap.goToEnd buffer
val initialMsg = [SEARCH (buffer, searchString)]
in
Finish.buildTextAndClear (app, buffer, low, searchList)
Finish.buildTextAndClear (app, buffer, low, SearchList.empty, initialMsg)
end
fun helpDeleteToChr
@@ -589,10 +615,12 @@ struct
val length = high - low
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToEnd buffer
val searchString = #searchString app
val (buffer, searchList) = SearchList.build (buffer, searchString)
val initialMsg = [SEARCH (buffer, searchString)]
in
buildTextAndClearAfterChr (app, buffer, low, searchList)
buildTextAndClearAfterChr
(app, buffer, low, SearchList.empty, initialMsg)
end
else
let
@@ -625,6 +653,9 @@ struct
val buffer = LineGap.delete (0, cursorIdx, buffer)
val (buffer, searchList) = SearchList.build (buffer, searchString)
val buffer = LineGap.goToEnd buffer
val initialMsg = [SEARCH (buffer, #searchString app)]
val cursorIdx = 0
val startLine = 0
val buffer = LineGap.goToIdx (cursorIdx, buffer)
@@ -637,6 +668,7 @@ struct
, windowHeight
, searchList
, searchString
, initialMsg
)
val mode = NORMAL_MODE ""
@@ -767,6 +799,7 @@ struct
| _ => clearMode app)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
else
(* have to continue parsing string *)
case String.sub (str, strPos + 1) of
@@ -776,27 +809,31 @@ struct
CHAR_EVENT chr =>
deleteToChr (app, 1, Cursor.tillNextChr, op+, chr)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height))
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList))
| #"T" =>
(* delete till chr, backwards *)
(case newCmd of
CHAR_EVENT chr =>
deleteToChr (app, 1, Cursor.tillPrevChr, op-, chr)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height))
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList))
| #"f" =>
(case newCmd of
CHAR_EVENT chr =>
deleteToChr (app, count, Cursor.toNextChr, op+, chr)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height))
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList))
| #"F" =>
(* delete to chr, backwards *)
(case newCmd of
CHAR_EVENT chr =>
deleteToChr (app, count, Cursor.toPrevChr, op-, chr)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height))
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList))
| #"g" =>
(* same events as handleGo *)
(case newCmd of
@@ -807,7 +844,8 @@ struct
| #"g" => deleteToStart app
| _ => clearMode app)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height))
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList))
| _ => clearMode app
(* useful reference as list of non-terminal commands *)
@@ -849,6 +887,7 @@ struct
CHAR_EVENT chr => handleChr (app, 1, chr, str)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
else if String.size str = 1 then
case newCmd of
CHAR_EVENT chr =>
@@ -857,6 +896,7 @@ struct
| NONE => parseAfterCount (0, str, 1, app, newCmd))
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
else
let
val numLength = getNumLength (0, str)
@@ -872,6 +912,7 @@ struct
CHAR_EVENT chr => handleChr (app, count, chr, str)
| KEY_ESC => clearMode app
| RESIZE_EVENT (width, height) => resizeText (app, width, height)
| WITH_SEARCH_LIST searchList => withSearchList (app, searchList)
else
(* continue parsing. *)
parseAfterCount (numLength, str, count, app, newCmd)

View File

@@ -2,7 +2,7 @@ structure Finish =
struct
open AppType
fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList) =
fun buildTextAndClear (app: app_type, buffer, cursorIdx, searchList, msgs) =
let
val {windowWidth, windowHeight, startLine, searchString, ...} = app
@@ -18,7 +18,7 @@ struct
val buffer = LineGap.goToLine (startLine, buffer)
val lineIdx = TextBuilder.getLineAbsIdx (startLine, buffer)
val drawMsg = TextBuilder.build
val msgs = TextBuilder.build
( startLine
, cursorIdx
, buffer
@@ -26,11 +26,12 @@ struct
, windowHeight
, searchList
, searchString
, msgs
)
val mode = NORMAL_MODE ""
in
AppWith.bufferAndCursorIdx
(app, buffer, cursorIdx, mode, startLine, searchList, drawMsg)
(app, buffer, cursorIdx, mode, startLine, searchList, msgs)
end
end

View File

@@ -12,7 +12,7 @@ functor MakeMove(Fn: MOVE): MAKE_MOVE =
struct
fun helpMove (app: AppType.app_type, buffer, cursorIdx, count) =
if count = 0 then
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app)
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, [])
else
(* move LineGap to cursorIdx, which is necessary for finding newCursorIdx *)
let
@@ -62,7 +62,7 @@ struct
val buffer = LineGap.goToIdx (cursorIdx, buffer)
val cursorIdx = Fn.fMove (buffer, cursorIdx, count)
in
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app)
Finish.buildTextAndClear (app, buffer, cursorIdx, #searchList app, [])
end
end

View File

@@ -4,7 +4,15 @@ sig
val getLineAbsIdx: int * LineGap.t -> int
(* Prerequisites: LineGap is moved to requested line first. *)
val build: int * int * LineGap.t * int * int * SearchList.t * string
val build:
int
* int
* LineGap.t
* int
* int
* SearchList.t
* string
* MailboxType.t list
-> MailboxType.t list
end
@@ -12,35 +20,6 @@ structure TextBuilder :> TEXT_BUILDER =
struct
open TextConstants
fun accToDrawMsg (textAcc, cursorAcc, bgAcc) =
let
open MailboxType
open DrawMsg
val textAcc = Vector.concat textAcc
val bgAcc = Vector.concat bgAcc
val textMsg = REDRAW_TEXT textAcc
val cursorMsg = REDRAW_CURSOR cursorAcc
val bgMsg = REDRAW_BG bgAcc
in
[DRAW bgMsg, DRAW textMsg, DRAW cursorMsg]
end
(* builds text from a string with char-wrap.
* char-wrap is a similar concept to word-wrap,
* but it breaks on character in the middle of a word.
*
* Will likely want multiple versions of these two mutually recursive
* functions for each selection and cursor type:
* cursor over an individual character,
* range selection where multiple characters are selected, etc.
*
* Todo:
* - Possibly add visual horizontal indentation when char-wrap occurs
* on an indented line *)
(* same as buildTextStringAfterCursor, except this keeps track of absolute
* index and cursor pos too *)
type env_data =
{ r: Real32.real
, g: Real32.real
@@ -57,8 +36,40 @@ struct
(* fw/fh = float window width and float window height *)
, fw: Real32.real
, fh: Real32.real
, msgs: MailboxType.t list
}
fun accToDrawMsg (textAcc, cursorAcc, bgAcc, env: env_data) =
let
open MailboxType
open DrawMsg
val msgs = #msgs env
val textAcc = Vector.concat textAcc
val bgAcc = Vector.concat bgAcc
val textMsg = REDRAW_TEXT textAcc
val cursorMsg = REDRAW_CURSOR cursorAcc
val bgMsg = REDRAW_BG bgAcc
in
DRAW bgMsg :: DRAW textMsg :: DRAW cursorMsg :: msgs
end
(* builds text from a string with char-wrap.
* char-wrap is a similar concept to word-wrap,
* but it breaks on character in the middle of a word.
*
* Will likely want multiple versions of these two mutually recursive
* functions for each selection and cursor type:
* cursor over an individual character,
* range selection where multiple characters are selected, etc.
*
* Todo:
* - Possibly add visual horizontal indentation when char-wrap occurs
* on an indented line *)
(* same as buildTextStringAfterCursor, except this keeps track of absolute
* index and cursor pos too *)
fun buildTextString
( pos
, str
@@ -159,7 +170,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
| chr =>
let
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
@@ -213,7 +224,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
else
(* equal to cursor *)
let
@@ -278,7 +289,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
end
end
else
@@ -299,7 +310,7 @@ struct
, bgAcc
, env
)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc, env)
fun isInSearchRange (absIdx, searchPos, searchHd, searchLen) =
let val searchIdx = Vector.sub (searchHd, searchPos)
@@ -474,7 +485,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
| chr =>
let
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
@@ -582,7 +593,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
else
(* equal to cursor *)
let
@@ -652,7 +663,7 @@ struct
)
end
else
accToDrawMsg (acc, cursorAcc, bgAcc)
accToDrawMsg (acc, cursorAcc, bgAcc, env)
end
end
else
@@ -676,7 +687,7 @@ struct
, searchPos
, searchLen
)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc)
| [] => accToDrawMsg (acc, cursorAcc, bgAcc, env)
(* gets line start idx, relative to right hd *)
fun helpGetLineStartIdx (startLine, curLine, rLnHd) =
@@ -718,6 +729,7 @@ struct
, windowHeight
, searchList: SearchList.t
, searchString
, msgs
) =
let
val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} =
@@ -742,6 +754,7 @@ struct
, hr = 0.211
, hg = 0.219
, hb = 0.25
, msgs = msgs
}
val cursorAcc = Vector.fromList []

View File

@@ -1,2 +1,8 @@
structure InputMsg =
struct datatype t = CHAR_EVENT of char | KEY_ESC | RESIZE_EVENT of int * int end
struct
datatype t =
CHAR_EVENT of char
| KEY_ESC
| RESIZE_EVENT of int * int
| WITH_SEARCH_LIST of int vector
end

View File

@@ -1 +1,2 @@
structure MailboxType = struct datatype t = DRAW of DrawMsg.t end
structure MailboxType =
struct datatype t = DRAW of DrawMsg.t | SEARCH of LineGap.t * string end

14
shell/search-thread.sml Normal file
View File

@@ -0,0 +1,14 @@
structure SearchThread =
struct
open CML
(* Prerequisite to sending message: move buffer to end. *)
fun loop (searchMailbox, inputMailbox) =
let
val (buffer, searchString) = Mailbox.recv searchMailbox
val (_, searchList) = SearchList.build (buffer, searchString)
val () = Mailbox.send (inputMailbox, InputMsg.WITH_SEARCH_LIST searchList)
in
loop (searchMailbox, inputMailbox)
end
end

View File

@@ -6,6 +6,7 @@ struct
(* create mailboxes for CML communication *)
val inputMailbox = Mailbox.mailbox ()
val drawMailbox = Mailbox.mailbox ()
val searchMailbox = Mailbox.mailbox ()
fun frameBufferSizeCallback (width, height) =
Mailbox.send (inputMailbox, RESIZE_EVENT (width, height))
@@ -79,7 +80,9 @@ struct
val _ = CML.spawn (fn () => GlDraw.loop (drawMailbox, window))
val _ = CML.spawn (fn () =>
UpdateThread.loop (app, inputMailbox, drawMailbox))
UpdateThread.loop (app, inputMailbox, drawMailbox, searchMailbox))
val _ = CML.spawn (fn () =>
SearchThread.loop (searchMailbox, inputMailbox))
in
()
end

View File

@@ -4,18 +4,21 @@ struct
open MailboxType
open InputMsg
fun sendMsg (msg, drawMailbox) =
case msg of DRAW msg => Mailbox.send (drawMailbox, msg)
fun sendMsg (msg, drawMailbox, searchMailbox) =
case msg of
DRAW msg => Mailbox.send (drawMailbox, msg)
| SEARCH (buffer, searchString) =>
Mailbox.send (searchMailbox, (buffer, searchString))
fun sendMsgs (msgList, drawMailbox) =
fun sendMsgs (msgList, drawMailbox, searchMailbox) =
case msgList of
hd :: tl =>
let val _ = sendMsg (hd, drawMailbox)
in sendMsgs (tl, drawMailbox)
let val _ = sendMsg (hd, drawMailbox, searchMailbox)
in sendMsgs (tl, drawMailbox, searchMailbox)
end
| [] => ()
fun loop (app: AppType.app_type, inputMailbox, drawMailbox) =
fun loop (app: AppType.app_type, inputMailbox, drawMailbox, searchMailbox) =
let
val inputMsg = Mailbox.recv inputMailbox
val () =
@@ -33,8 +36,8 @@ struct
val app = AppUpdate.update (app, inputMsg)
handle e => ExceptionLogger.log e
val () = sendMsgs (#msgs app, drawMailbox)
val () = sendMsgs (#msgs app, drawMailbox, searchMailbox)
in
loop (app, inputMailbox, drawMailbox)
loop (app, inputMailbox, drawMailbox, searchMailbox)
end
end

View File

@@ -47,6 +47,7 @@ in
end
shell/exception-logger.sml
shell/search-thread.sml
shell/update-thread.sml
shell/gl-shaders.sml
shell/gl-draw.sml