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

remove usage of concurrent ml, deciding that we prefer to run everything in the main thread instead

Browse Source
This commit is contained in:
Humza Shahid
2025-10-17 23:08:16 +01:00
parent 0799128f7c
commit 111e0cf66d
15 changed files with 43 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
fcore/normal-mode/make-normal-delete.sml
View File

@@ -11,14 +11,7 @@ struct
fun finishAfterDeletingBuffer (app: app_type, low, buffer, time, msgs) =
let
val buffer = LineGap.goToIdx (low, buffer)
val buffer = LineGap.goToStart buffer
val msgs = SEARCH (buffer, #dfa app, time) :: msgs
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, low + 1111, #dfa app)
val (buffer, searchList) = SearchList.build (buffer, #dfa app)
val buffer = LineGap.goToIdx (low, buffer)
in
NormalFinish.buildTextAndClear (app, buffer, low, searchList, msgs, time)
@@ -233,12 +226,7 @@ struct
val initialMsg = Fn.initMsgs (low, length, buffer)
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, #dfa app, time) :: initialMsg
val buffer = LineGap.goToIdx (cursorIdx - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, cursorIdx + 1111, #dfa app)
val (buffer, searchList) = SearchList.build (buffer, #dfa app)
(* If we have deleted from the buffer so that cursorIdx
* is no longer a valid idx,
@@ -736,12 +724,9 @@ struct
val buffer = LineGap.delete (0, cursorIdx, buffer)
val buffer =
if #textLength buffer = 0 then LineGap.fromString "\n" else buffer
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (cursorIdx - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, cursorIdx + 1111, dfa)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val cursorIdx = 0
val startLine = 0
@@ -813,11 +798,7 @@ struct
val initialMsg = Fn.initMsgs (low, length, buffer)
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) = SearchList.buildRange (buffer, low + 1111, dfa)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val buffer = LineGap.goToIdx (low, buffer)
in
@@ -873,12 +854,7 @@ struct
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, low + 1111, dfa)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val buffer = LineGap.goToIdx (low, buffer)
in
@@ -904,13 +880,7 @@ struct
let
val initialMsg = Fn.initMsgs (low, length, buffer)
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, low + 1111, dfa)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val buffer = LineGap.goToIdx (low, buffer)
in
@@ -934,12 +904,7 @@ struct
val initialMsg = Fn.initMsgs (low, length, buffer)
val buffer = LineGap.delete (low, length, buffer)
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, low + 1111, dfa)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val buffer = LineGap.goToIdx (origLow, buffer)
in
@@ -1037,6 +1002,8 @@ struct
val initialMsg = Fn.initMsgs (low, length, buffer)
val buffer = LineGap.delete (low, length, buffer)
val (buffer, searchList) = SearchList.build (buffer, dfa)
val buffer = LineGap.goToIdx (low, buffer)
val low =
@@ -1047,13 +1014,6 @@ struct
else
low
val buffer = LineGap.goToStart buffer
val initialMsg = SEARCH (buffer, dfa, time) :: initialMsg
val buffer = LineGap.goToIdx (low - 1111, buffer)
val (buffer, searchList) =
SearchList.buildRange (buffer, low + 1111, dfa)
val buffer = LineGap.goToIdx (low, buffer)
in
NormalFinish.buildTextAndClear

18
fcore/normal-mode/normal-finish.sml
View File

@@ -62,24 +62,6 @@ struct
)
end
fun withSearchList (app: app_type, searchList, searchTime) =
let
open Time
in
if searchTime >= #bufferModifyTime app then
let
val {buffer, cursorIdx, bufferModifyTime, ...} = app
val app =
NormalModeWith.searchList
(app, searchList, buffer, bufferModifyTime)
in
buildTextAndClear
(app, buffer, cursorIdx, searchList, [], bufferModifyTime)
end
else
app
end
fun resizeText (app: app_type, newWidth, newHeight) =
let
val

8
fcore/normal-mode/normal-mode.sml
View File

@@ -33,10 +33,9 @@ struct
val {cursorIdx = origCursorIdx, dfa, ...} = app
val buffer = LineGap.goToStart buffer
val initialMsg = [SEARCH (buffer, dfa, time)]
in
NormalDelete.finishAfterDeletingBuffer
(app, origCursorIdx, buffer, time, initialMsg)
(app, origCursorIdx, buffer, time, [])
end
else
let
@@ -127,10 +126,9 @@ struct
loop (nextLine, buffer, count - 1)
val buffer = LineGap.goToStart buffer
val initialMsg = [SEARCH (buffer, dfa, time)]
in
NormalDelete.finishAfterDeletingBuffer
(app, newCursorIdx, buffer, time, initialMsg)
(app, newCursorIdx, buffer, time, [])
end
end
@@ -616,8 +614,6 @@ struct
| KEY_ESC => NormalFinish.clearMode app
| RESIZE_EVENT (width, height) =>
NormalFinish.resizeText (app, width, height)
| WITH_SEARCH_LIST (searchList, time) =>
NormalFinish.withSearchList (app, searchList, time)
(* Don't need to handle these keys in normal mode.
* Everything that is possible through them in Vi and Vim

6
fcore/normal-mode/normal-search-mode.sml
View File

@@ -82,7 +82,7 @@ struct
else CaseInsensitiveDfa.fromString searchString
val buffer = LineGap.goToStart buffer
val initialMsg = [SEARCH (buffer, dfa, time)]
val searchList = SearchList.build (buffer, dfa)
(* move LineGap to first line displayed on screen *)
val buffer = LineGap.goToLine (startLine, buffer)
@@ -101,7 +101,7 @@ struct
)
val drawMsg = Vector.concat drawMsg
val drawMsg = DrawMsg.DRAW_TEXT drawMsg
val msgs = DRAW drawMsg :: initialMsg
val msgs = [DRAW drawMsg]
val mode = NORMAL_MODE ""
in
@@ -253,8 +253,6 @@ struct
, searchScrollColumn
, caseSensitive
)
| WITH_SEARCH_LIST (searchList, time) =>
NormalFinish.withSearchList (app, searchList, time)
| RESIZE_EVENT (width, height) =>
NormalSearchFinish.resize
( app

45
fcore/search-list/search-list.sml
View File

@@ -1,25 +1,30 @@
structure SearchList =
struct
structure DfaGen = CaseInsensitiveDfa
structure Dfa = CaseInsensitiveDfa
fun buildLoop (idx, iterator, dfa, acc, curState, startPos, prevFinalPos) =
fun buildLoop (idx, buffer, dfa, acc, curState, startPos, prevFinalPos) =
let
val iterator = LineGap.moveIteratorToIdx (idx, iterator)
val buffer = LineGap.goToIdx (idx, buffer)
in
if idx = #textLength iterator then
if prevFinalPos < 0 then acc
else PersistentVector.append (startPos, prevFinalPos, acc)
if idx = #textLength buffer then
let
val acc =
if prevFinalPos < 0 then acc
else PersistentVector.append (startPos, prevFinalPos, acc)
in
(buffer, acc)
end
else
let
val chr = LineGap.subIterator (idx, iterator)
val newState = DfaGen.nextState (dfa, curState, chr)
val chr = LineGap.sub (idx, buffer)
val newState = Dfa.nextState (dfa, curState, chr)
val prevFinalPos =
if DfaGen.isFinal (dfa, newState) then idx else prevFinalPos
if Dfa.isFinal (dfa, newState) then idx else prevFinalPos
in
if DfaGen.isDead newState then
if Dfa.isDead newState then
if prevFinalPos = ~1 then
(* no match found: restart search from `startPos + 1` *)
buildLoop (startPos + 1, iterator, dfa, acc, 0, startPos + 1, ~1)
buildLoop (startPos + 1, buffer, dfa, acc, 0, startPos + 1, ~1)
else
(* match found: append and continue *)
let
@@ -28,19 +33,21 @@ struct
(* we start 1 idx after the final position we found *)
val newStart = prevFinalPos + 1
in
buildLoop (newStart, iterator, dfa, acc, 0, newStart, ~1)
buildLoop (newStart, buffer, dfa, acc, 0, newStart, ~1)
end
else
buildLoop
(idx + 1, iterator, dfa, acc, newState, startPos, prevFinalPos)
(idx + 1, buffer, dfa, acc, newState, startPos, prevFinalPos)
end
end
fun build (iterator, dfa) =
fun build (buffer, dfa) =
if Vector.length dfa > 0 then
buildLoop (0, iterator, dfa, PersistentVector.empty, 0, 0, ~1)
let val buffer = LineGap.goToStart buffer
in buildLoop (0, buffer, dfa, PersistentVector.empty, 0, 0, ~1)
end
else
PersistentVector.empty
(buffer, PersistentVector.empty)
fun rangeLoop
( dfa
@@ -64,11 +71,11 @@ struct
let
val buffer = LineGap.goToIdx (bufferPos, buffer)
val chr = LineGap.sub (bufferPos, buffer)
val newState = DfaGen.nextState (dfa, curState, chr)
val newState = Dfa.nextState (dfa, curState, chr)
val prevFinalPos =
if DfaGen.isFinal (dfa, newState) then bufferPos else prevFinalPos
if Dfa.isFinal (dfa, newState) then bufferPos else prevFinalPos
in
if DfaGen.isDead newState then
if Dfa.isDead newState then
if prevFinalPos = ~1 then
(* no match found: restart search from `startPos + 1` *)
rangeLoop

1
message-types/input-msg.sml
View File

@@ -6,7 +6,6 @@ struct
| KEY_ENTER
| KEY_BACKSPACE
| RESIZE_EVENT of int * int
| WITH_SEARCH_LIST of PersistentVector.t * Time.time
| ARROW_LEFT
| ARROW_UP
| ARROW_RIGHT

3
message-types/mailbox-type.sml
View File

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

2
message-types/search-msg.sml
View File

@@ -1,2 +0,0 @@
structure SearchMsg =
struct type t = LineGap.t * int vector vector * Time.time end

1
shell/gl-draw.sml
View File

@@ -1,6 +1,5 @@
structure GlDraw =
struct
open CML
open DrawMsg
(* The name doesn't make it clear, but this structure

2
shell/search-mailbox.sml
View File

@@ -1,2 +0,0 @@
structure SearchMailbox =
struct open CML val mailbox: SearchMsg.t Mailbox.mbox = Mailbox.mailbox () end

16
shell/search-thread.sml
View File

@@ -1,16 +0,0 @@
structure SearchThread =
struct
open CML
fun loop () =
let
val (buffer, dfa, time) = Mailbox.recv SearchMailbox.mailbox
val iterator = LineGap.makeStringIterator buffer
val searchList = SearchList.build (iterator, dfa)
handle e => ExceptionLogger.log e
val msg = InputMsg.WITH_SEARCH_LIST (searchList, time)
val () = InputMailbox.append msg
in
loop ()
end
end

7
shell/shell.sml
View File

@@ -88,12 +88,9 @@ struct
val app = AppType.init (lineGap, 1920, 1080, Time.now ())
val () = registerCallbacks window
val _ = CML.spawn (fn () => GlDraw.loop (app, window))
val _ = CML.spawn SearchThread.loop
in
()
GlDraw.loop (app, window)
end
end
val _ = RunCML.doit (Shell.main, SOME (Time.fromMicroseconds 555))
val () = Shell.main ()

5
shell/updater.sml
View File

@@ -4,10 +4,7 @@ struct
open InputMsg
fun sendMsg msg =
case msg of
DRAW msg => DrawMailbox.append msg
| SEARCH (buffer, searchString, time) =>
Mailbox.send (SearchMailbox.mailbox, (buffer, searchString, time))
case msg of DRAW msg => DrawMailbox.append msg
fun sendMsgs msgList =
case msgList of

1
shf-tests.mlb
View File

@@ -18,7 +18,6 @@ fcore/search-list/search-list.sml
message-types/input-msg.sml
message-types/draw-msg.sml
message-types/search-msg.sml
message-types/mailbox-type.sml
fcore/app-type.sml

4
shf.mlb
View File

@@ -18,7 +18,6 @@ fcore/search-list/search-list.sml
message-types/input-msg.sml
message-types/draw-msg.sml
message-types/search-msg.sml
message-types/mailbox-type.sml
fcore/app-type.sml
@@ -64,7 +63,6 @@ fcore/app-update.sml
(* IMPERATIVE SHELL *)
$(SML_LIB)/basis/mlton.mlb
$(SML_LIB)/cml/cml.mlb
ann
"allowFFI true"
@@ -81,10 +79,8 @@ in
end
shell/input-mailbox.sml
shell/draw-mailbox.sml
shell/search-mailbox.sml
shell/exception-logger.sml
shell/search-thread.sml
shell/updater.sml
shell/gl-shaders.sml
shell/gl-draw.sml