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

begin reimplementing search list data structure

Browse Source
This commit is contained in:
Humza Shahid
2025-08-05 13:24:55 +01:00
parent 7dbd37a65b
commit 01369627bf
5 changed files with 118 additions and 543 deletions
Download Patch File Download Diff File Expand all files Collapse all files

605
fcore/search-list.sml
View File

@@ -17,19 +17,64 @@ end
structure SearchList : SEARCH_LIST = structure SearchList : SEARCH_LIST =
struct struct
type t = {left: int vector list, right: int vector list} structure IntSet = MakeGapSet (
struct
type key = int
(* clojure's persistent vectors contain arrays of length 32 val maxNodeSize = 32
* and this data structure is similar to that, so we also use 32 *)
val targetLength = 32
val empty: t = {left = [], right = []} fun l (a: int, b) = a < b
fun eq (a: int, b) = a = b
fun g (a: int, b) = a > b
end
)
type t = IntSet.t
fun helpToVector (left, right) =
case left of
hd :: tl => helpToVector (tl, hd :: right)
| [] => Vector.concat right
(* for testing *)
fun toVector {left, right} = helpToVector (left, right)
val empty = IntSet.empty
fun insert (num, set) =
let
val () = print ("adding num: " ^ Int.toString num ^ "\n")
in
IntSet.add (num, set)
end
val append = IntSet.add
val goToNum = IntSet.moveTo
fun delete (start, length, searchString, set) =
if length > 0 then
let
val firstVec = toVector set
val finish = start + length
val start = start - String.size searchString + 1
val result = IntSet.removeMany (start, finish, set)
val secondVec = toVector result
val () = print ("delete start has " ^ Int.toString (Vector.length
firstVec) ^ "elements\n")
val () = print ("delete result has " ^ Int.toString (Vector.length
secondVec) ^ "elements\n")
in
result
end
else
set
fun isLessThanTarget (v1, v2) = fun isLessThanTarget (v1, v2) =
Vector.length v1 + Vector.length v2 <= targetLength Vector.length v1 + Vector.length v2 <= 32
fun isThreeLessThanTarget (v1, v2, v3) =
Vector.length v1 + Vector.length v2 + Vector.length v3 <= targetLength
fun joinEndOfLeft (new, left) = fun joinEndOfLeft (new, left) =
case left of case left of
@@ -42,496 +87,6 @@ struct
new :: left new :: left
| [] => new :: left | [] => new :: left
fun joinStartOfRight (new, right) =
case right of
hd :: tail =>
if isLessThanTarget (new, hd) then
let val newHd = Vector.concat [new, hd]
in newHd :: tail
end
else
new :: right
| [] => new :: right
fun insMiddle (new, middle, hd, tl, left, right) =
let
val leftSlice = VectorSlice.slice (hd, 0, SOME middle)
val rightLength = Vector.length hd - middle
val rightSlice = VectorSlice.slice (hd, middle, SOME rightLength)
val new = Vector.fromList [new]
val new = VectorSlice.full new
in
if Vector.length hd < targetLength then
let val newHd = VectorSlice.concat [leftSlice, new, rightSlice]
in {left = joinEndOfLeft (newHd, tl), right = right}
end
else if middle < targetLength then
(* leftSlice is less than targetLength *)
let
val hd1 = VectorSlice.concat [leftSlice, new]
val hd2 = VectorSlice.vector rightSlice
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
else
let
val hd1 = VectorSlice.vector leftSlice
val hd2 = VectorSlice.concat [new, rightSlice]
in
{ left = joinEndOfLeft (hd1, tl)
, right = joinStartOfRight (hd2, right)
}
end
end
fun insLeft (new, left, right) =
case left of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
in
if new < first then
insLeft (new, tl, joinStartOfRight (hd, right))
else if new > first then
let
val last = Vector.sub (hd, Vector.length hd - 1)
in
if new < last then
(* new is or should be in middle *)
let
val middle = BinSearch.equalOrMore (new, hd)
in
if new <> Vector.sub (hd, middle) then
(* not in middle, so insert *)
insMiddle (new, middle, hd, tl, left, right)
else
(* new is in middle, so just return *)
{left = left, right = right}
end
else if new > last then
(* have to insert new at end of left
* or start of right (both are equivalent) *)
{ left = left
, right = joinStartOfRight (Vector.fromList [new], right)
}
else
(* new = last so just return *)
{left = left, right = right}
end
else
(* new = first *)
{left = left, right = right}
end
| [] =>
let val new = Vector.fromList [new]
in {left = left, right = joinStartOfRight (new, right)}
end
fun insRight (new, left, right) =
case right of
hd :: tl =>
let
val last = Vector.sub (hd, Vector.length hd - 1)
in
if new > last then
insRight (new, joinEndOfLeft (hd, left), tl)
else if new < last then
let
val first = Vector.sub (hd, 0)
in
if new > first then
(* have to insert in middle *)
let
val middle = BinSearch.equalOrMore (new, hd)
in
if new <> Vector.sub (hd, middle) then
(* not in middle, so insert *)
insMiddle (new, middle, hd, tl, left, right)
else
(* new is in middle, so return *)
{left = left, right = right}
end
else if new < first then
(* have to insert new at start of right
* or end of left (both are equivalent) *)
{ left = left
, right = joinStartOfRight (Vector.fromList [new], right)
}
else
(* new = first so just return *)
{left = left, right = right}
end
else
(* new = last *)
{left = left, right = right}
end
| [] =>
let val new = Vector.fromList [new]
in {left = joinEndOfLeft (new, left), right = right}
end
fun insert (new, {left, right}: t) =
(* look at elements to see which way to traverse *)
case right of
hd :: _ =>
if new > Vector.sub (hd, 0) then insRight (new, left, right)
else insLeft (new, left, right)
| [] => insLeft (new, left, right)
fun helpAppend (new, left, right) =
case right of
hd :: tl => helpAppend (new, joinEndOfLeft (hd, left), tl)
| [] => {left = joinEndOfLeft (Vector.fromList [new], left), right = right}
fun append (new, {left, right}: t) = helpAppend (new, left, right)
fun helpGoToNumLeft (num, left, right) =
case left of
hd :: tl =>
if num < Vector.sub (hd, 0) then
(* continue *)
helpGoToNumLeft (num, tl, joinStartOfRight (hd, right))
else
(* greater or equal to first element so return.
* Note: caller which destructures list expects found hd to always be
* on right. *)
{left = tl, right = joinStartOfRight (hd, right)}
| [] => {left = left, right = right}
fun helpGoToNumRight (num, left, right) =
case right of
hd :: tl =>
if num > Vector.sub (hd, Vector.length hd - 1) then
(* continue *)
helpGoToNumRight (num, joinEndOfLeft (hd, left), tl)
else
(* less than or equal to last element so return *)
{left = left, right = right}
| [] => {left = left, right = right}
fun goToNum (num, {left, right}: t) =
case right of
hd :: tl =>
if Vector.length hd > 0 then
if Vector.sub (hd, 0) >= Vector.sub (hd, 0) then
(* num is greater or equal to first el on right so go right *)
helpGoToNumRight (num, left, right)
else
(* num is less than first el on right so go left *)
helpGoToNumLeft (num, left, right)
else
helpGoToNumLeft (num, left, right)
| [] => helpGoToNumLeft (num, left, right)
fun delRightFromHere (finish, left, right) =
case right of
hd :: tl =>
let
val last = Vector.sub (hd, Vector.length hd - 1)
in
if finish > last then
delRightFromHere (finish, left, tl)
else if finish < Vector.sub (hd, 0) then
(* finish < first *)
{left = left, right = right}
else if finish < last then
let
val delstart = BinSearch.equalOrMore (finish, hd)
val dellength = Vector.length hd - delstart
val newHd = VectorSlice.slice (hd, delstart, SOME dellength)
val newHd = VectorSlice.vector newHd
in
{left = left, right = joinStartOfRight (newHd, tl)}
end
else
(* finish = last *)
{left = left, right = tl}
end
| [] => {left = left, right = right}
fun moveRightAndDelete (start, finish, left, right) =
case right of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
val last = Vector.sub (hd, Vector.length hd - 1)
in
if start > last then
moveRightAndDelete (start, finish, joinEndOfLeft (hd, left), tl)
else if start > first then
if finish < last then
(* we want to delete frrom the middle of hd *)
let
val len1 = BinSearch.equalOrMore (start, hd)
val start2 = BinSearch.equalOrMore (finish, hd)
in
if len1 = start2 then
(* There is a chance the user will want to delete text
* that is not within a search point but between.
* This case just prevents an extra unnecessary vector
* allocation for tht case. *)
{left = left, right = right}
else
let
val len2 = Vector.length hd - start2
val lhd = VectorSlice.slice (hd, 0, SOME len1)
val rhd = VectorSlice.slice (hd, start2, SOME len2)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, tl)
}
end
end
else if finish = last then
(* deletion range is from middle of this vector to end
* which means we want to preserve first half *)
let
val length = BinSearch.equalOrMore (start, hd)
val newHd = VectorSlice.slice (hd, 0, SOME length)
val newHd = VectorSlice.vector newHd
in
{left = left, right = joinStartOfRight (newHd, tl)}
end
else
(* finish > last *)
let
val length = BinSearch.equalOrMore (start, hd)
val newHd = VectorSlice.slice (hd, 0, SOME length)
val newHd = VectorSlice.vector newHd
val left = joinEndOfLeft (newHd, left)
in
delRightFromHere (finish, left, right)
end
else if start < last then
if finish > last then
(* delete part of hd, and continue deleting rightwards *)
let
val delpoint = BinSearch.equalOrMore (start, hd)
val newHd = VectorSlice.slice (hd, 0, SOME delpoint)
val newHd = VectorSlice.vector newHd
in
delRightFromHere (finish, joinEndOfLeft (newHd, left), tl)
end
else if finish < last then
(* have to delete from middle of hd and then return *)
let
val startpoint = BinSearch.equalOrMore (start, hd)
val finishpoint = BinSearch.equalOrMore (finish, hd)
val lhd = VectorSlice.slice (hd, 0, SOME
(Vector.length hd - startpoint))
val rhd = VectorSlice.slice (hd, finishpoint, SOME
(Vector.length hd - finishpoint))
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, right)
}
end
else
(* finish = last, which means delete from last part of hd *)
let
val startpoint = BinSearch.equalOrMore (start, hd)
val newHd = VectorSlice.slice (hd, 0, SOME startpoint)
val newHd = VectorSlice.vector newHd
in
{left = left, right = joinStartOfRight (newHd, tl)}
end
else
(* start = last, meaning delete last and then continue deleting right*)
let
val length = Vector.length hd - 1
val newHd = VectorSlice.slice (hd, 0, SOME length)
val newHd = VectorSlice.vector newHd
in
delRightFromHere (finish, joinEndOfLeft (newHd, left), tl)
end
end
| [] => {left = left, right = right}
fun delLeftFromHere (start, left, right) =
case left of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
in
if start < first then
delLeftFromHere (start, tl, right)
else if start > Vector.sub (hd, Vector.length hd - 1) then
(* start > last *)
{left = left, right = right}
else if start > first then
let
val delpoint = BinSearch.equalOrMore (start, hd)
val newLength = Vector.length hd - delpoint
val newHd = VectorSlice.slice (hd, delpoint, SOME newLength)
val newHd = VectorSlice.vector newHd
in
{left = joinEndOfLeft (newHd, tl), right = right}
end
else
(* start = first *)
{left = tl, right = right}
end
| [] => {left = left, right = right}
fun moveLeftAndDelete (start, finish, left, right) =
case left of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
val last = Vector.sub (hd, Vector.length hd - 1)
in
if finish < first then
moveLeftAndDelete (start, finish, tl, joinStartOfRight (hd, right))
else if finish > last then
if start > last then
{left = left, right = right}
else if start = last then
let
val len = Vector.length hd - 1
val newHd = VectorSlice.slice (hd, 0, SOME len)
val newHd = VectorSlice.vector newHd
in
{left = joinEndOfLeft (newHd, tl), right = right}
end
else
(* start < last *)
let
val len1 = BinSearch.equalOrMore (start, hd)
val start2 = BinSearch.equalOrMore (finish, hd)
in
if len1 = start2 then
{left = left, right = right}
else
let
val len2 = Vector.length hd - start2
val lhd = VectorSlice.slice (hd, 0, SOME len1)
val rhd = VectorSlice.slice (hd, start2, SOME len2)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, tl)
}
end
end
else if finish > first then
if start < first then
(* delete from start of hd and continue deleting leftwards *)
let
val startpoint = BinSearch.equalOrMore (finish, hd)
val len = Vector.length hd - startpoint
val newHd = VectorSlice.slice (hd, startpoint, SOME len)
val newHd = VectorSlice.vector newHd
in
delLeftFromHere (start, tl, joinStartOfRight (newHd, right))
end
else if start > first then
(* delete from middle and then return *)
let
val llen = BinSearch.equalOrMore (start, hd)
val rstart = BinSearch.equalOrMore (finish, hd)
val rlen = Vector.length hd - rstart
val lhd = VectorSlice.slice (hd, 0, SOME llen)
val rhd = VectorSlice.slice (hd, rstart, SOME rlen)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, tl)
, right = joinStartOfRight (rhd, right)
}
end
else
(* start = first and finish > first
* have to delete from start of hd and return*)
let
val startpoint = BinSearch.equalOrMore (finish, hd)
val len = Vector.length hd - startpoint
val newHd = VectorSlice.slice (hd, startpoint, SOME len)
val newHd = VectorSlice.vector newHd
in
{left = joinEndOfLeft (newHd, tl), right = right}
end
else
(* finish = first *)
let
val len = Vector.length hd - 1
val newHd = VectorSlice.slice (hd, 1, SOME len)
val newHd = VectorSlice.vector newHd
in
if start < first then
delLeftFromHere (start, tl, joinStartOfRight (newHd, right))
else
(* start = first *)
{left = tl, right = joinStartOfRight (newHd, right)}
end
end
| [] => {left = left, right = right}
fun delFromLeftAndRight (start, finish, left, right) =
let val {left, right} = delRightFromHere (finish, left, right)
in delLeftFromHere (start, left, right)
end
fun del (start, finish, left, right) =
case right of
rhd :: rtl =>
let
val rfirst = Vector.sub (rhd, 0)
in
if start < rfirst then
if finish < rfirst then
(case left of
lhd :: ltl =>
let
val llast = Vector.sub (lhd, Vector.length lhd - 1)
in
if finish = llast then delLeftFromHere (start, left, right)
else moveLeftAndDelete (start, finish, left, right)
end
| [] => {left = left, right = right})
else
(* finish >= rfirst *)
delFromLeftAndRight (start, finish, left, right)
else if start = rfirst then
delRightFromHere (finish, left, right)
else
(* finish > rfirst *)
moveRightAndDelete (start, finish, left, right)
end
| [] =>
(case left of
lhd :: ltl =>
let
val llast = Vector.sub (lhd, Vector.length lhd - 1)
in
if finish >= llast then
delLeftFromHere (start, left, right)
else
(* finish < last *)
moveLeftAndDelete (start, finish, left, right)
end
| [] =>
(* left and right are both empty *)
{left = left, right = right})
fun delete (start, length, searchString, {left, right}: t) =
if length > 0 then
let
val finish = start + length
val start = start - String.size searchString + 1
in
del (start, finish, left, right)
end
else
{left = left, right = right}
(* go all the way to the end of the list, mapping each hd, (* go all the way to the end of the list, mapping each hd,
* joining the hd to the left, * joining the hd to the left,
* and return when we have reached the end *) * and return when we have reached the end *)
@@ -576,59 +131,23 @@ struct
fun mapFrom (num, mapBy, lst) = fun mapFrom (num, mapBy, lst) =
let let
(* goToNum always places vector where num was found to the right list *) (* goToNum always places vector where num was found to the right list *)
val {left, right} = goToNum (num, lst) val () = print ("mapping by " ^ Int.toString num ^ "\n")
val {left, right} = goToNum (0, lst)
in in
moveRightAndMap (num, mapBy, left, right) moveRightAndMap (num, 0, left, right)
end end
fun helpExistsRight (num, right) = val exists = IntSet.exists
case right of
hd :: tl =>
let
val rlast = Vector.sub (hd, Vector.length hd - 1)
in
if num > rlast then helpExistsRight (num, tl)
else BinSearch.exists (num, hd)
end
| [] => false
fun helpExistsLeft (num, left) =
case left of
hd :: tl =>
let
val lfirst = Vector.sub (hd, 0)
in
if num < lfirst then helpExistsLeft (num, tl)
else BinSearch.exists (num, hd)
end
| [] => false
fun exists (num, {left, right}) =
case right of
rhd :: rtl =>
let
val rfirst = Vector.sub (rhd, 0)
in
if num = rfirst then true
else if num > rfirst then helpExistsRight (num, right)
else helpExistsLeft (num, left)
end
| [] => helpExistsLeft (num, left)
fun helpToVector (left, right) =
case left of
hd :: tl => helpToVector (tl, hd :: right)
| [] => Vector.concat right
(* for testing *)
fun toVector {left, right} = helpToVector (left, right)
fun toString {left, right} = fun toString {left, right} =
let let
val vec = toVector {left = left, right = right} val vec = toVector {left = left, right = right}
val () = print ("toString has " ^ Int.toString (Vector.length vec) ^
"elements\n")
val strList = Vector.foldr (fn (num, acc) => Int.toString num :: acc) [] vec val strList = Vector.foldr (fn (num, acc) => Int.toString num :: acc) [] vec
in in
String.concatWith ", " strList ""
end end
end end

49
fcore/search/search-line-gap.sml Normal file
View File

@@ -0,0 +1,49 @@
structure SearchLineGap =
struct
fun searchStep (pos, hd, absIdx, tl, acc, searchPos, searchString) =
if searchPos < 0 then
(absIdx + 1) :: acc
else if pos < 0 then
case tl of
hd :: tl =>
searchStep (String.size hd - 1, hd, absIdx, tl, acc, searchPos, searchString)
| [] => acc
else
let
val bufferChr = String.sub (hd, pos)
val searchChr = String.sub (searchString, searchPos)
in
if bufferChr = searchChr then
searchStep (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString)
else
acc
end
fun loopSearch (pos, hd, absIdx, tl, acc, searchString) =
if pos < 0 then
case tl of
hd :: tl =>
loopSearch (String.size hd - 1, hd, absIdx, tl, acc, searchString)
| [] => acc
else
let
val acc = searchStep
(pos, hd, absIdx, tl, acc, String.size searchString - 1, searchString)
in
loopSearch (pos - 1, hd, absIdx - 1, tl, acc, searchString)
end
fun search (buffer, searchString) =
if String.size searchString = 0 then
[]
else
let
val buffer = LineGap.goToEnd buffer
val {leftStrings, idx = absIdx, ...} = buffer
in
case leftStrings of
hd :: tl =>
loopSearch (String.size hd - 1, hd, absIdx - 1, tl, [], searchString)
| [] => []
end
end

3
shell/update-thread.sml
View File

@@ -32,6 +32,9 @@ struct
val app = AppUpdate.update (app, inputMsg) handle e => ExceptionLogger.log e val app = AppUpdate.update (app, inputMsg) handle e => ExceptionLogger.log e
val searchList = #searchList app
val searchList = SearchList.toString searchList ^ "\n"
val () = sendMsgs (#msgs app, drawMailbox) val () = sendMsgs (#msgs app, drawMailbox)
in in
loop (app, inputMailbox, drawMailbox) loop (app, inputMailbox, drawMailbox)

2
shf-tests.mlb
View File

@@ -2,6 +2,7 @@ $(SML_LIB)/basis/basis.mlb
(* LIBRARIEES *) (* LIBRARIEES *)
lib/brolib-sml/src/line_gap.sml lib/brolib-sml/src/line_gap.sml
lib/brolib-sml/src/gap_set.sml
lib/cozette-sml/fonts/cozette-ascii.mlb lib/cozette-sml/fonts/cozette-ascii.mlb
(* FUNCTIONAL CORE *) (* FUNCTIONAL CORE *)
@@ -15,6 +16,7 @@ fcore/search-list.sml
fcore/app-type.sml fcore/app-type.sml
fcore/app-with.sml fcore/app-with.sml
fcore/search/search-line-gap.sml
fcore/build-search-list.sml fcore/build-search-list.sml
fcore/text-constants.sml fcore/text-constants.sml
ann ann

2
shf.mlb
View File

@@ -2,6 +2,7 @@ $(SML_LIB)/basis/basis.mlb
(* LIBRARIEES *) (* LIBRARIEES *)
lib/brolib-sml/src/line_gap.sml lib/brolib-sml/src/line_gap.sml
lib/brolib-sml/src/gap_set.sml
lib/cozette-sml/fonts/cozette-ascii.mlb lib/cozette-sml/fonts/cozette-ascii.mlb
(* FUNCTIONAL CORE *) (* FUNCTIONAL CORE *)
@@ -15,6 +16,7 @@ fcore/search-list.sml
fcore/app-type.sml fcore/app-type.sml
fcore/app-with.sml fcore/app-with.sml
fcore/search/search-line-gap.sml
fcore/build-search-list.sml fcore/build-search-list.sml
fcore/text-constants.sml fcore/text-constants.sml
ann ann