add code for clojure-style persistent vectors

This commit is contained in:
2025-08-30 18:12:47 +01:00
parent 0647589f13
commit 7497dc7e7a
3 changed files with 132 additions and 12 deletions

View File

@@ -2,6 +2,86 @@ structure SearchList =
struct struct
type t = int vector type t = int vector
structure PersistentVector =
struct
(* Clojure-style persistent vector,
* as intermediary data structure
* for building search list *)
datatype t =
BRANCH of t vector
| LEAF of int vector
val maxSize = 32
val empty = LEAF (Vector.fromList [])
datatype append_result = APPEND of t | UPDATE of t
fun helpAppend (key, tree) =
case tree of
BRANCH nodes =>
let
val lastNode = Vector.sub (nodes, Vector.length nodes - 1)
in
case helpAppend (key, lastNode) of
UPDATE newLast =>
let
val newNode = Vector.update
(nodes, Vector.length nodes - 1, newLast)
val newNode = BRANCH newNode
in
UPDATE newNode
end
| APPEND newVec =>
if Vector.length nodes + 1 > maxSize then
let val newNode = BRANCH #[newVec]
in APPEND newNode
end
else
let
val newNodes = Vector.concat [nodes, #[newVec]]
val newNodes = BRANCH newNodes
in
UPDATE newNodes
end
end
| LEAF vec =>
if Vector.length vec + 1 > maxSize then
let val newNode = LEAF #[key]
in APPEND newNode
end
else
let
val newNode = Vector.concat [vec, #[key]]
val newNode = LEAF newNode
in
UPDATE newNode
end
fun append (key, tree) =
case helpAppend (key, tree) of
UPDATE t => t
| APPEND newNode => BRANCH #[tree, newNode]
fun branchToList (pos, nodes, acc) =
if pos < 0 then
acc
else
let
val node = Vector.sub (nodes, pos)
val acc = helpToVector (node, acc)
in
branchToList (pos - 1, nodes, acc)
end
and helpToVector (tree, acc) =
case tree of
BRANCH nodes => branchToList (Vector.length nodes - 1, nodes, acc)
| LEAF vec => vec :: acc
fun toVector tree = helpToVector (tree, [])
end
val empty = Vector.fromList [] val empty = Vector.fromList []
(* (*
@@ -32,17 +112,27 @@ struct
* there should be two results: "[abba]bb[abba]". * there should be two results: "[abba]bb[abba]".
* However, the last result gets filtered out. * However, the last result gets filtered out.
* *) * *)
fun cons (foundIdx, searchStringSize, acc) = fun cons (foundIdx, searchStringSize, acc, lastFilteredIdx) =
case acc of case acc of
hd :: tl => hd :: tl =>
if foundIdx + searchStringSize >= hd then foundIdx :: tl if foundIdx + searchStringSize >= hd then
else foundIdx :: acc case lastFilteredIdx of
| [] => foundIdx :: acc ~1 => (foundIdx :: tl, hd)
| _ =>
if hd + searchStringSize >= lastFilteredIdx then
(foundIdx :: lastFilteredIdx :: tl, hd)
else
(foundIdx :: tl, hd)
else
(foundIdx :: acc, lastFilteredIdx)
| [] => (foundIdx :: acc, lastFilteredIdx)
fun searchStep (pos, hd, absIdx, tl, acc, searchPos, searchString) = fun searchStep
(pos, hd, absIdx, tl, acc, searchPos, searchString, lastFilteredIdx) =
if searchPos < 0 then if searchPos < 0 then
let let
val acc = cons (absIdx + 1, String.size searchString, acc) val (acc, lastFilteredIdx) =
cons (absIdx + 1, String.size searchString, acc, lastFilteredIdx)
in in
searchStep searchStep
( pos + 1 ( pos + 1
@@ -52,13 +142,22 @@ struct
, acc , acc
, String.size searchString - 1 , String.size searchString - 1
, searchString , searchString
, lastFilteredIdx
) )
end end
else if pos < 0 then else if pos < 0 then
case tl of case tl of
hd :: tl => hd :: tl =>
searchStep searchStep
(String.size hd - 1, hd, absIdx, tl, acc, searchPos, searchString) ( String.size hd - 1
, hd
, absIdx
, tl
, acc
, searchPos
, searchString
, lastFilteredIdx
)
| [] => acc | [] => acc
else else
let let
@@ -67,7 +166,15 @@ struct
in in
if bufferChr = searchChr then if bufferChr = searchChr then
searchStep searchStep
(pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString) ( pos - 1
, hd
, absIdx - 1
, tl
, acc
, searchPos - 1
, searchString
, lastFilteredIdx
)
else else
searchStep searchStep
( pos - 1 ( pos - 1
@@ -77,13 +184,22 @@ struct
, acc , acc
, String.size searchString - 1 , String.size searchString - 1
, searchString , searchString
, lastFilteredIdx
) )
end end
fun loopSearch (pos, hd, absIdx, tl, acc, searchString) = fun loopSearch (pos, hd, absIdx, tl, acc, searchString) =
let let
val acc = searchStep val acc = searchStep
(pos, hd, absIdx, tl, acc, String.size searchString - 1, searchString) ( pos
, hd
, absIdx
, tl
, acc
, String.size searchString - 1
, searchString
, ~1
)
in in
Vector.fromList acc Vector.fromList acc
end end
@@ -153,7 +269,7 @@ struct
fun rangeSearchStep (pos, hd, absIdx, tl, acc, searchPos, searchString, low) = fun rangeSearchStep (pos, hd, absIdx, tl, acc, searchPos, searchString, low) =
if searchPos < 0 then if searchPos < 0 then
cons (absIdx + 1, String.size searchString, acc) raise Fail "todo"
else if absIdx < low then else if absIdx < low then
acc acc
else if pos < 0 then else if pos < 0 then

View File

@@ -11,7 +11,11 @@ message-types/draw-msg.sml
message-types/mailbox-type.sml message-types/mailbox-type.sml
fcore/bin-search.sml fcore/bin-search.sml
ann
"allowVectorExps true"
in
fcore/search-list.sml fcore/search-list.sml
end
fcore/app-type.sml fcore/app-type.sml
fcore/app-with.sml fcore/app-with.sml

View File

@@ -1,4 +1,4 @@
abbabbabba abbabbabbabba
signature TEXT_BUILDER = signature TEXT_BUILDER =
aaron baron carrot durian aaron baron carrot durian
(* Prerequisite: LineGap is moved to requested line first. *) (* Prerequisite: LineGap is moved to requested line first. *)