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

Add 'brolib-sml/' from commit 'fd96032949434207dda3b288f48d7fe579f59e4e'

Browse Source 
git-subtree-dir: brolib-sml
git-subtree-mainline: 64471ecf7f
git-subtree-split: fd96032949
This commit is contained in:
Humza Shahid
2026-04-24 00:26:04 +01:00
parent 64471ecf7f fd96032949
commit 401408448f
48 changed files with 468057 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
brolib-sml/.DS_Store vendored Normal file
View File

Binary file not shown.

21
brolib-sml/.gitignore vendored Normal file
View File

@@ -0,0 +1,21 @@
/bench/gap_buffer_svelte
/bench/gap_buffer_rust
/bench/gap_buffer_seph
/bench/gap_buffer_automerge
/bench/line_gap_svelte
/bench/line_gap_rust
/bench/line_gap_seph
/bench/line_gap_automerge
/bench/rope_svelte
/bench/rope_rust
/bench/rope_seph
/bench/rope_automerge
/bench/svelte.md
/bench/rust.md
/bench/seph.md
/bench/automerge.md
/tests/compare

5
brolib-sml/LICENSE Normal file
View File

@@ -0,0 +1,5 @@
Copyright (C) 2024 by Humza Shahid <humzasaur@gmail.com>
Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

7
brolib-sml/README.md Normal file
View File

@@ -0,0 +1,7 @@
# Brolib-sml
## Introduction
Implementations of various data structures for manipulating text (inserting into the data structure and removing from it).
Currently experimenting; not for public use.

47
brolib-sml/bench/Makefile Normal file
View File

@@ -0,0 +1,47 @@
bench: gap_buffer_svelte gap_buffer_rust gap_buffer_seph gap_buffer_automerge line_gap_svelte line_gap_rust line_gap_seph line_gap_automerge rope_svelte rope_rust rope_seph rope_automerge
hyperfine './gap_buffer_svelte' './rope_svelte' './line_gap_svelte' --export-markdown svelte.md
hyperfine './gap_buffer_rust' './rope_rust' './line_gap_rust' --export-markdown rust.md
hyperfine './gap_buffer_seph' './rope_seph' './line_gap_seph' --export-markdown seph.md
hyperfine './gap_buffer_automerge' './rope_automerge' './line_gap_automerge' --export-markdown automerge.md
gap_buffer_svelte:
mlton gap_buffer_svelte.mlb
gap_buffer_rust:
mlton gap_buffer_rust.mlb
gap_buffer_seph:
mlton gap_buffer_seph.mlb
gap_buffer_automerge:
mlton gap_buffer_automerge.mlb
line_gap_svelte:
mlton line_gap_svelte.mlb
line_gap_rust:
mlton line_gap_rust.mlb
line_gap_seph:
mlton line_gap_seph.mlb
line_gap_automerge:
mlton line_gap_automerge.mlb
rope_svelte:
mlton rope_svelte.mlb
rope_rust:
mlton rope_rust.mlb
rope_seph:
mlton rope_seph.mlb
rope_automerge:
mlton rope_automerge.mlb
clean:
rm -f gap_buffer_svelte gap_buffer_rust gap_buffer_seph gap_buffer_automerge
rm -f line_gap_svelte line_gap_rust line_gap_seph line_gap_automerge
rm -f rope_svelte rope_rust rope_seph rope_automerge
rm -f svelte.md rust.md seph.md automerge.md

13
brolib-sml/bench/gap_buffer_automerge.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/automerge.sml
end
transaction.sml
run.sml
../src/gap_buffer.sml
gap_buffer_automerge.sml

13
brolib-sml/bench/gap_buffer_automerge.sml Normal file
View File

@@ -0,0 +1,13 @@
structure GapBufferAutomerge: TRANSACTION =
struct
type t = GapBuffer.t
val empty = GapBuffer.empty
val insert = GapBuffer.insert
val delete = GapBuffer.delete
val toString = GapBuffer.toString
val txns = AutomergePaper.txns
end
structure Main = Run(GapBufferAutomerge)
val _ = Main.run ()

13
brolib-sml/bench/gap_buffer_rust.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/rust.sml
end
transaction.sml
run.sml
../src/gap_buffer.sml
gap_buffer_rust.sml

13
brolib-sml/bench/gap_buffer_rust.sml Normal file
View File

@@ -0,0 +1,13 @@
structure GapBufferRust: TRANSACTION =
struct
type t = GapBuffer.t
val empty = GapBuffer.empty
val insert = GapBuffer.insert
val delete = GapBuffer.delete
val toString = GapBuffer.toString
val txns = RustCode.txns
end
structure Main = Run(GapBufferRust)
val _ = Main.run ()

13
brolib-sml/bench/gap_buffer_seph.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/seph.sml
end
transaction.sml
run.sml
../src/gap_buffer.sml
gap_buffer_seph.sml

13
brolib-sml/bench/gap_buffer_seph.sml Normal file
View File

@@ -0,0 +1,13 @@
structure GapBufferSeph: TRANSACTION =
struct
type t = GapBuffer.t
val empty = GapBuffer.empty
val insert = GapBuffer.insert
val delete = GapBuffer.delete
val toString = GapBuffer.toString
val txns = SephBlog.txns
end
structure Main = Run(GapBufferSeph)
val _ = Main.run ()

13
brolib-sml/bench/gap_buffer_svelte.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/svelte.sml
end
transaction.sml
run.sml
../src/gap_buffer.sml
gap_buffer_svelte.sml

13
brolib-sml/bench/gap_buffer_svelte.sml Normal file
View File

@@ -0,0 +1,13 @@
structure GapBufferSvelete: TRANSACTION =
struct
type t = GapBuffer.t
val empty = GapBuffer.empty
val insert = GapBuffer.insert
val delete = GapBuffer.delete
val toString = GapBuffer.toString
val txns = SvelteComponent.txns
end
structure Main = Run(GapBufferSvelete)
val _ = Main.run ()

13
brolib-sml/bench/line_gap_automerge.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/automerge.sml
end
transaction.sml
run.sml
../src/line_gap.sml
line_gap_automerge.sml

13
brolib-sml/bench/line_gap_automerge.sml Normal file
View File

@@ -0,0 +1,13 @@
structure LineGapAutomerge: TRANSACTION =
struct
type t = LineGap.t
val empty = LineGap.empty
val insert = LineGap.insert
val delete = LineGap.delete
val toString = LineGap.toString
val txns = AutomergePaper.txns
end
structure Main = Run(LineGapAutomerge)
val _ = Main.run ()

13
brolib-sml/bench/line_gap_rust.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/rust.sml
end
transaction.sml
run.sml
../src/line_gap.sml
line_gap_rust.sml

13
brolib-sml/bench/line_gap_rust.sml Normal file
View File

@@ -0,0 +1,13 @@
structure LineGapRust: TRANSACTION =
struct
type t = LineGap.t
val empty = LineGap.empty
val insert = LineGap.insert
val delete = LineGap.delete
val toString = LineGap.toString
val txns = RustCode.txns
end
structure Main = Run(LineGapRust)
val _ = Main.run ()

13
brolib-sml/bench/line_gap_seph.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/seph.sml
end
transaction.sml
run.sml
../src/line_gap.sml
line_gap_seph.sml

13
brolib-sml/bench/line_gap_seph.sml Normal file
View File

@@ -0,0 +1,13 @@
structure LineGapSeph: TRANSACTION =
struct
type t = LineGap.t
val empty = LineGap.empty
val insert = LineGap.insert
val delete = LineGap.delete
val toString = LineGap.toString
val txns = SephBlog.txns
end
structure Main = Run(LineGapSeph)
val _ = Main.run ()

13
brolib-sml/bench/line_gap_svelte.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/svelte.sml
end
transaction.sml
run.sml
../src/line_gap.sml
line_gap_svelte.sml

13
brolib-sml/bench/line_gap_svelte.sml Normal file
View File

@@ -0,0 +1,13 @@
structure LineGapSvelete: TRANSACTION =
struct
type t = LineGap.t
val empty = LineGap.empty
val insert = LineGap.insert
val delete = LineGap.delete
val toString = LineGap.toString
val txns = SvelteComponent.txns
end
structure Main = Run(LineGapSvelete)
val _ = Main.run ()

13
brolib-sml/bench/rope_automerge.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/automerge.sml
end
transaction.sml
run.sml
../src/tiny_rope.sml
rope_automerge.sml

13
brolib-sml/bench/rope_automerge.sml Normal file
View File

@@ -0,0 +1,13 @@
structure RopeAutomerge: TRANSACTION =
struct
type t = TinyRope.t
val empty = TinyRope.empty
val insert = TinyRope.insert
val delete = TinyRope.delete
val toString = TinyRope.toString
val txns = AutomergePaper.txns
end
structure Main = Run(RopeAutomerge)
val _ = Main.run ()

13
brolib-sml/bench/rope_rust.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/rust.sml
end
transaction.sml
run.sml
../src/tiny_rope.sml
rope_rust.sml

13
brolib-sml/bench/rope_rust.sml Normal file
View File

@@ -0,0 +1,13 @@
structure RopeRust: TRANSACTION =
struct
type t = TinyRope.t
val empty = TinyRope.empty
val insert = TinyRope.insert
val delete = TinyRope.delete
val toString = TinyRope.toString
val txns = RustCode.txns
end
structure Main = Run(RopeRust)
val _ = Main.run ()

13
brolib-sml/bench/rope_seph.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/seph.sml
end
transaction.sml
run.sml
../src/tiny_rope.sml
rope_seph.sml

13
brolib-sml/bench/rope_seph.sml Normal file
View File

@@ -0,0 +1,13 @@
structure RopeSeph: TRANSACTION =
struct
type t = TinyRope.t
val empty = TinyRope.empty
val insert = TinyRope.insert
val delete = TinyRope.delete
val toString = TinyRope.toString
val txns = SephBlog.txns
end
structure Main = Run(RopeSeph)
val _ = Main.run ()

13
brolib-sml/bench/rope_svelte.mlb Normal file
View File

@@ -0,0 +1,13 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/svelte.sml
end
transaction.sml
run.sml
../src/tiny_rope.sml
rope_svelte.sml

13
brolib-sml/bench/rope_svelte.sml Normal file
View File

@@ -0,0 +1,13 @@
structure RopeSvelte: TRANSACTION =
struct
type t = TinyRope.t
val empty = TinyRope.empty
val insert = TinyRope.insert
val delete = TinyRope.delete
val toString = TinyRope.toString
val txns = SvelteComponent.txns
end
structure Main = Run(RopeSvelte)
val _ = Main.run ()

23
brolib-sml/bench/run.sml Normal file
View File

@@ -0,0 +1,23 @@
functor Run(Txn: TRANSACTION) =
struct
local
fun folder ((pos, delNum, insStr), buffer) =
let
val buffer =
if delNum > 0 then Txn.delete (pos, delNum, buffer) else buffer
in
if String.size insStr > 0 then Txn.insert (pos, insStr, buffer)
else buffer
end
in
fun runTxns () =
Vector.foldl folder Txn.empty Txn.txns
end
fun run () =
let
val buffer = runTxns ()
in
()
end
end

9
brolib-sml/bench/transaction.sml Normal file
View File

@@ -0,0 +1,9 @@
signature TRANSACTION =
sig
type t
val empty: t
val insert: int * string * t -> t
val delete: int * int * t -> t
val toString: t -> string
val txns : (int * int * string) vector
end

259783
brolib-sml/data-sets/automerge.sml Normal file
View File

File diff suppressed because it is too large Load Diff

41081
brolib-sml/data-sets/rust.sml Normal file
View File

File diff suppressed because one or more lines are too long

138556
brolib-sml/data-sets/seph.sml Normal file
View File

File diff suppressed because one or more lines are too long

19994
brolib-sml/data-sets/svelte.sml Normal file
View File

File diff suppressed because one or more lines are too long

6
brolib-sml/examples/examples.mlb Normal file
View File

@@ -0,0 +1,6 @@
$(SML_LIB)/basis/basis.mlb
tiny_rope.sml
tiny_rope23.sml
rope.sml
examples.sml

139
brolib-sml/examples/examples.sml Normal file
View File

@@ -0,0 +1,139 @@
(* An empty rope, containing no strings. *)
val rope = Rope.empty;
(* Initialise rope from a string.
*
* You probably want to avoid initialising the rope with very long strings,
* because a rope is meant to represent a long string
* by holding nodes that contain smaller strings in a binary tree.
* The implementation avoids building strings that are ever larger than 1024,
* but that was done in an attempt to find the ideal length for performance.
* A user shouldn't notice any delays in larger lengths like 65535 either.
*
* In their text buffer (a piece-tree, which is slower than a rope),
* the VS Code team had other issues with excessively large strings.
* https://code.visualstudio.com/blogs/2018/03/23/text-buffer-reimplementation#_avoid-the-string-concatenation-trap *)
val rope = Rope.fromString "hello, world!\n";
(* Convert a rope to a string.
*
* This may involve allocating an extremely large string in some cases,
* which should be avoided for the reason mentioned in the above comment. *)
val str = Rope.toString rope;
(* Insert a string into the rope.
*
* There isn't any validation to check that you inserted at a reasonable
* position.
* If you insert at an index lower than 0, your inserted string is just
* prepended to the start.
* If you insert at an index greater than the length, your inserted string is
* just appended to the end.
*
* One thing to watch out for if you are using the line-rope is making sure
* that you don't insert in the middle of a \r\n pair, separating \r from \n.
* That would mess up the line metadata the rope contains and make the line
* metadata invalid. *)
val rope = Rope.insert (14, "goodbye, world!", rope);
(* Append a string into the rope. *)
val rope = Rope.append ("hello again\n", rope);
(* Append a string into the rope, providing line metadata with it.
*
* The point of this function is for performance: the other insertion functions
* calculate the line metadata by scanning the string itself, but in some cases
* this is already known. The larger example below is such a case. *)
val rope = Rope.appendLine ("my new line", Vector.fromList [], rope);
(** Second larger example motivating String.appendLine below. *)
(*** Returns the start index of a line,
*** returning the index of \r if line ends with a \r\n pair. *)
fun getLineStart line =
let
val lastIdx = String.size line - 1
val lastChr = String.sub (line, lastIdx)
in
if lastChr = #"\n" andalso lastIdx - 1 >= 0 then
if String.sub (line, lastIdx - 1) = #"\r" then lastIdx - 1 else lastIdx
else
lastIdx
end;
(*** Appends the lines in a file to a rope. *)
fun readLines (rope, file) =
case TextIO.inputLine file of
SOME line =>
let
(* Don't need to scan string to find line breaks,
* because we already know. *)
val lineIdx = getLineStart (line)
val vec = Vector.fromList [lineIdx]
val rope = Rope.appendLine (line, vec, rope)
in
readLines (rope, file)
end
| NONE => rope;
val licenseRope = readLines (Rope.empty, TextIO.openIn "LICENSE");
(* Deletes the given range from rope, from the start index to the end index.
*
* As with insert, one should make sure they don't corrupt the line metadata.
* Specifically, in a \r\n pair, the line metadata points to \r.
* Deleting \r would corrupt it, but deleting \n would be fine.
* In general, if you want to delete a line break, you would want to delete both
* \r and \n. The user thinks of the \r\n pair as a single character so they are
* expecting the whole line break to be deleted. *)
(** Initialise new rope. *)
val rope = Rope.fromString "hello, world!";
(** New rope contains "hello world!" without comma. *)
val rope = Rope.delete (5, 1, rope);
(* Folds over the characters in a rope, starting from the given index.
*
* This is meant to be an alternative to queries for a specific line or a
* substring.
* If a rope is meant to avoid allocating large strings, then it seems more
* performant to query its contents through higher-order functions rather than
* allocating substrings and querying the substring. *)
val rope = Rope.fromString "hello!";;
fun apply (chr, lst) = chr :: lst;
(** val result = [#"!",#"o",#"l",#"l",#"e"] : char list *)
val result = Rope.foldFromIdx (apply, 1, rope, []);
(* Folds over the characters in a rope, accepting a predicate function
* that terminates the fold when it returns true. *)
fun apply (chr, acc) =
(print (Char.toString chr); acc + 1);
fun term acc = acc = 3;
(** Below function prints first three letters, "hel",
** and then steops folding. *)
val _ = Rope.foldFromIdxTerm (apply, term, 0, rope, 0);
(* Folds over the characters in a rope, starting from the given line number.
*
* This is just like the foldFromIdxTerm function, except that it starts folding
* from the given line number instead. *)
val rope = Rope.fromString "hello, world!\ngoodbye, world!\nhello again!";
fun apply (chr, _) =
print (Char.toString chr);
fun term _ = false;
(** Below line prints the whole string, one character at a time. *)
Rope.foldLines (apply, term, 0, rope, ());
(** Prints starting from #"g" in "goodbye". *)
Rope.foldLines (apply, term, 1, rope, ());
(** Prints the very last line. *)
Rope.foldLines (apply, term, 2, rope, ());
(** Prints the whole string if specifying a line before 0, which doesn't exist. *)
Rope.foldLines (apply, term, ~3, rope, ());
(** Raises a subscript exception: there is no corresponding line in the rope. *)
Rope.foldLines (apply, term, 4, rope, ());

416
brolib-sml/src/gap_buffer.sml Normal file
View File

@@ -0,0 +1,416 @@
signature GAP_BUFFER =
sig
type t = {idx: int, left: string list, right: string list}
val empty: t
val fromString: string -> t
val toString: t -> string
val insert: int * string * t -> t
val delete: int * int * t -> t
end
structure GapBuffer: GAP_BUFFER =
struct
type t = {idx: int, left: string list, right: string list}
val targetLength = 1024
val empty = {idx = 0, left = [], right = []}
fun fromString string =
{idx = String.size string, left = [string], right = []}
local
fun toList (acc, input) =
case input of
hd :: tl => toList (hd :: acc, tl)
| [] => acc
in
fun toString ({left, right, ...}: t) =
let val lst = toList (right, left)
in String.concat lst
end
end
fun isLessThanTarget (s1, s2) =
String.size s1 + String.size s2 <= targetLength
fun isThreeLessThanTarget (s1, s2, s3) =
String.size s1 + String.size s2 + String.size s3 <= targetLength
fun consLeft (curIdx, newString, left, right) =
{ idx = curIdx + String.size newString
, left = newString :: left
, right = right
}
fun joinEndOfLeft (newString, left) =
case left of
hd :: tail =>
if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
else newString :: left
| [] => newString :: left
fun joinStartOfRight (newString, right) =
case right of
hd :: tail =>
if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
else newString :: right
| [] => newString :: right
fun preferInsertLeft (curIdx, newString, left, right) =
case left of
hd :: tail =>
if isLessThanTarget (hd, newString) then
{ idx = curIdx + String.size newString
, left = (hd ^ newString) :: tail
, right = right
}
else
(case right of
hd :: tail =>
if isLessThanTarget (hd, newString) then
{idx = curIdx, left = left, right = (newString ^ hd) :: tail}
else
consLeft (curIdx, newString, left, right)
| [] => consLeft (curIdx, newString, left, right))
| [] => consLeft (curIdx, newString, left, right)
fun insLeft (prevIdx, idx, newString, curIdx, hd, tail, right) =
(* The requested index is either:
* - At the start of the left string
* - In the middle of the left string
* Find out which and split the middle of the string if necessary. *)
if idx = prevIdx then
(* At start of string. *)
{ idx = curIdx + String.size newString
, right = right
, left =
(* These two meant to look reversed,
* with respect to newString and hd.
*
* The line
* `newString ^ hd`
* places the contents of newString before hd,
* and the line
* `hd :: newString`
* in a zipper also places newString before hd.
*
* Using `newString ^ hd` with `newString :: hd` gives
* different contents in the case of a zipper.
* *)
if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
else hd :: newString :: tail
}
else
(* In middle of string. *)
let
val length = idx - prevIdx
val sub1 = String.substring (hd, 0, length)
val sub2 = String.substring (hd, length, String.size hd - length)
in
if isThreeLessThanTarget (sub1, newString, sub2) then
{ idx = curIdx + String.size newString
, left = (sub1 ^ newString ^ sub2) :: tail
, right = right
}
else if isLessThanTarget (sub1, newString) then
{ idx = prevIdx + String.size sub1 + String.size newString
, left = (sub1 ^ newString) :: tail
, right = joinStartOfRight (sub2, right)
}
else if isLessThanTarget (newString, sub2) then
{ idx = prevIdx + String.size sub1
, left = joinEndOfLeft (sub1, tail)
, right = (newString ^ sub2) :: right
}
else
{ idx = prevIdx
, left = tail
, right = sub1 :: newString :: sub2 :: right
}
end
fun insRight (nextIdx, idx, newString, curIdx, left, hd, tail) =
if idx = nextIdx then
(* At end of next string. *)
{ idx = curIdx
, left = left
, right =
if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
else hd :: (joinStartOfRight (newString, tail))
}
else
let
val length = idx - curIdx
val sub1 = String.substring (hd, 0, length)
val sub2 = String.substring (hd, length, String.size hd - length)
in
if isThreeLessThanTarget (sub1, newString, sub2) then
{ idx =
curIdx + String.size sub1 + String.size newString
+ String.size sub2
, left = (sub1 ^ newString ^ sub2) :: left
, right = tail
}
else if isLessThanTarget (sub1, newString) then
{ idx = curIdx + String.size sub1 + String.size newString
, left = (sub1 ^ newString) :: left
, right = joinStartOfRight (sub2, tail)
}
else if isLessThanTarget (newString, sub2) then
{ idx = curIdx + String.size sub1
, left = sub1 :: left
, right = (newString ^ sub2) :: tail
}
else
{ idx = curIdx + String.size sub1 + String.size newString
, left = newString :: sub1 :: left
, right = joinStartOfRight (sub2, tail)
}
end
fun ins (idx, newString, curIdx, left, right) : t =
if curIdx = idx then
preferInsertLeft (curIdx, newString, left, right)
else if idx < curIdx then
(* Need to insert on the left. *)
case left of
[] =>
(* If there is no string on the left, then add the new string there. *)
{idx = String.size newString, left = [newString], right = right}
| hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if idx < prevIdx then
(* The requested index is prior to the string on the left,
* so move leftward one string. *)
ins (idx, newString, prevIdx, tail, joinStartOfRight (hd, right))
else
insLeft (prevIdx, idx, newString, curIdx, hd, tail, right)
end
else
(* Need to insert to the right. *)
case right of
[] => {idx = curIdx, left = left, right = [newString]}
| hd :: tail =>
let
val nextIdx = String.size hd + curIdx
in
if idx > nextIdx then
ins (idx, newString, nextIdx, joinEndOfLeft (hd, left), tail)
else
insRight (nextIdx, idx, newString, curIdx, left, hd, tail)
end
fun insert (idx, newString, buffer: t) =
ins (idx, newString, #idx buffer, #left buffer, #right buffer)
fun deleteRightFromHere (curIdx, finish, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < finish then
deleteRightFromHere (nextIdx, finish, tail)
else if nextIdx > finish then
let
val newStrStart = finish - curIdx
val newStr = String.substring
(hd, newStrStart, String.size hd - newStrStart)
in
newStr :: tail
end
else
(* nextIdx = finish
* Delete current head but no further. *)
tail
end
| [] => right
fun moveRightAndDelete (start, finish, curIdx, left, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < start then
(* Keep moving right: haven't reached start yet. *)
moveRightAndDelete
(start, finish, nextIdx, joinEndOfLeft (hd, left), tail)
else if nextIdx > start then
if nextIdx < finish then
(* Delete the start range contained in this string,
* and then continue deleting right. *)
let
val length = start - curIdx
val newString = String.substring (hd, 0, length)
in
{ idx = curIdx + String.size newString
, left = joinEndOfLeft (newString, left)
, right = deleteRightFromHere (nextIdx, finish, tail)
}
end
else if nextIdx > finish then
(* Have to delete from middle of string. *)
let
val sub1Length = start - curIdx
val sub1 = String.substring (hd, 0, sub1Length)
val sub2Start = finish - curIdx
val sub2 = String.substring
(hd, sub2Start, String.size hd - sub2Start)
in
{ idx = curIdx + sub1Length
, left = joinEndOfLeft (sub1, left)
, right = joinStartOfRight (sub2, tail)
}
end
else
(* nextIdx = finish
* Have to delete from end of this string. *)
let
val strLength = start - curIdx
val str = String.substring (hd, 0, strLength)
in
{ idx = curIdx + strLength
, left = joinEndOfLeft (str, left)
, right = tail
}
end
else
(* nextIdx = start
* The start range is contained fully at the next node,
* without having to remove part of a string at this node.*)
let
val newRight = deleteRightFromHere (nextIdx, finish, tail)
in
{ idx = curIdx
, left = left
, right = joinStartOfRight (hd, newRight)
}
end
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteLeftFromHere (start, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if start < prevIdx then
deleteLeftFromHere (start, prevIdx, tail, right)
else if start > prevIdx then
(* Need to delete from some part of this string. *)
let
val length = start - prevIdx
val newStr = String.substring (hd, 0, length)
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (newStr, right)
}
end
else
(* if start = prevIdx
* Need to remove the current node without deleting any further. *)
{idx = prevIdx, left = tail, right = right}
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteFromLeftAndRight (start, finish, curIdx, left, right) =
let val right = deleteRightFromHere (curIdx, finish, right)
in deleteLeftFromHere (start, curIdx, left, right)
end
fun moveLeftAndDelete (start, finish, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if prevIdx > finish then
moveLeftAndDelete
(start, finish, prevIdx, tail, joinStartOfRight (hd, right))
else if prevIdx < finish then
if prevIdx > start then
(* Delete from start point of this string,
* and then call function to continue deleting leftward. *)
let
val hdStart = finish - prevIdx
val newHd = String.substring
(hd, hdStart, String.size hd - hdStart)
val right = joinStartOfRight (newHd, right)
in
deleteLeftFromHere (start, prevIdx, tail, right)
end
else if prevIdx < start then
(* We want to delete in the middle of this current string. *)
let
val sub1Length = start - prevIdx
val sub1 = String.substring (hd, 0, sub1Length)
val sub2Start = finish - prevIdx
val sub2 = String.substring
(hd, sub2Start, String.size hd - sub2Start)
in
{ idx = prevIdx + sub1Length
, left = joinEndOfLeft (sub1, tail)
, right = joinStartOfRight (sub2, right)
}
end
else
(* prevIdx = start
* We want to delete from the start of this string and stop. *)
let
val strStart = finish - prevIdx
val str = String.substring
(hd, strStart, String.size hd - strStart)
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (str, right)
}
end
else
(* prevIdx = finish *)
deleteLeftFromHere
(start, prevIdx, tail, joinStartOfRight (hd, right))
end
| [] => {idx = curIdx, left = left, right = right}
fun del (start, finish, curIdx, left, right) : t =
if start > curIdx then
(* If start is greater than current index,
* then finish must be greater too.
* Move buffer rightwards until finish is reached,
* and delete along the way. *)
moveRightAndDelete (start, finish, curIdx, left, right)
else if start < curIdx then
(* If start is less than current index,
* then finish could be either less than or equal/greater
* than the current index.
* We can treat equal/greater than as one case. *)
if finish <= curIdx then
(* Move leftward and delete along the way. *)
moveLeftAndDelete (start, finish, curIdx, left, right)
else
(* Delete rightward up to finish index,
* and then delete leftward until start index.*)
deleteFromLeftAndRight (start, finish, curIdx, left, right)
else
(* If start is equal to the current index,
* then only examine the right list.
* Just need to delete until reaching the finish index. *)
{ idx = curIdx
, left = left
, right = deleteRightFromHere (curIdx, finish, right)
}
fun delete (start, length, buffer: t) =
if length > 0 then
del (start, start + length, #idx buffer, #left buffer, #right buffer)
else
buffer
end

1034
brolib-sml/src/gap_map.sml Normal file
View File

File diff suppressed because it is too large Load Diff

773
brolib-sml/src/gap_set.sml Normal file
View File

@@ -0,0 +1,773 @@
signature GAP_SET_ELEMENT =
sig
type key
val l: key * key -> bool
val eq: key * key -> bool
val g: key * key -> bool
val maxNodeSize: int
end
signature GAP_SET =
sig
structure Fn: GAP_SET_ELEMENT
type t
val empty: t
val isEmpty: t -> bool
val singleton: Fn.key -> t
val add: Fn.key * t -> t
val remove: Fn.key * t -> t
val removeMany: Fn.key * Fn.key * t -> t
val fromList: Fn.key list -> t
val toVector: t -> Fn.key vector
val exists: Fn.key * t -> bool
val min: t -> Fn.key option
val max: t -> Fn.key option
val moveToStart: t -> t
val moveToEnd: t -> t
val moveTo: Fn.key * t -> t
end
functor MakeGapSet(Fn: GAP_SET_ELEMENT): GAP_SET =
struct
structure Fn = Fn
type t = {left: Fn.key vector list, right: Fn.key vector list}
val empty = {left = [], right = []}
fun isEmpty {left = [], right = []} = true
| isEmpty _ = false
fun singleton x =
{left = [], right = [Vector.fromList [x]]}
fun isLessThanTarget (v1, v2) =
Vector.length v1 + Vector.length v2 <= Fn.maxNodeSize
fun joinEndOfLeft (new, left) =
case left of
hd :: tail =>
if isLessThanTarget (new, hd) then
let val newHd = Vector.concat [hd, new]
in newHd :: tail
end
else
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 reverseLinearSearch (pos, findNum, vec) =
if pos < 0 then
~1
else
let
val curNum = Vector.sub (vec, pos)
in
if Fn.l (findNum, curNum) then pos
else reverseLinearSearch (pos - 1, findNum, vec)
end
fun forwardLinearSearch (pos, findNum, vec) =
if pos = Vector.length vec then
Vector.length vec
else
let
val curNum = Vector.sub (vec, pos)
in
if Fn.g (findNum, curNum) then pos + 1
else forwardLinearSearch (pos + 1, findNum, vec)
end
fun helpFindInsPos (findNum, vec, low, high, prevMid) =
if high >= low then
let
val mid = low + ((high - low) div 2)
val curNum = Vector.sub (vec, mid)
in
if Fn.eq (curNum, findNum) then
mid
else if Fn.l (curNum, findNum) then
helpFindInsPos (findNum, vec, mid + 1, high, mid)
else
helpFindInsPos (findNum, vec, low, mid - 1, mid)
end
else
let
val curNum = Vector.sub (vec, prevMid)
in
if Fn.g (findNum, curNum) then
forwardLinearSearch (prevMid, findNum, vec)
else
reverseLinearSearch (prevMid, findNum, vec)
end
fun findInsPos (findNum, vec) =
if Vector.length vec = 0 then ~1
else helpFindInsPos (findNum, vec, 0, Vector.length vec - 1, 0)
fun insWithPos (vec, elem, insPos) =
if insPos < 0 then
Vector.concat [Vector.fromList [elem], vec]
else if insPos = Vector.length vec then
Vector.concat [vec, Vector.fromList [elem]]
else
let
val elem = Vector.fromList [elem]
val elem = VectorSlice.full elem
val s2len = Vector.length vec - insPos
val slice1 = VectorSlice.slice (vec, 0, SOME insPos)
val slice2 = VectorSlice.slice (vec, insPos, SOME s2len)
in
VectorSlice.concat [slice1, elem, slice2]
end
fun insMiddle (hd, insPos, new, left, right) =
(* insert in middle *)
if Fn.eq (Vector.sub (hd, insPos), new) then
(* already have this key so no need to insert again *)
{left = left, right = right}
else if Vector.length hd + 1 > Fn.maxNodeSize then
let
(* split into two vectors and join with new *)
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
val rhdLen = Vector.length hd - insPos
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
val lhd = VectorSlice.vector lhd
val new = Vector.fromList [new]
val new = VectorSlice.full new
val rhd = VectorSlice.concat [new, rhd]
in
{left = joinEndOfLeft (lhd, left), right = rhd :: right}
end
else
let
(* insert without splitting *)
val newHd = insWithPos (hd, new, insPos)
in
{left = joinEndOfLeft (newHd, left), right = right}
end
fun insLeft (new, left, right) =
case left of
hd :: tl =>
let
val insPos = findInsPos (new, hd)
in
if insPos = ~1 then
insLeft (new, tl, joinStartOfRight (hd, right))
else if insPos = Vector.length hd then
(* insert at end *)
if Vector.length hd + 1 > Fn.maxNodeSize then
let
(* hd is full so join new to start of right *)
val right = joinStartOfRight (Vector.fromList [new], right)
in
{left = left, right = right}
end
else
let
(* join to end without splitting *)
val lhd = Vector.concat [hd, Vector.fromList [new]]
in
{left = joinEndOfLeft (lhd, tl), right = right}
end
else
insMiddle (hd, insPos, new, left, 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 insPos = findInsPos (new, hd)
in
if insPos = Vector.length hd then
insRight (new, joinEndOfLeft (hd, left), tl)
else if insPos < 0 then
(* insert at start *)
if Vector.length hd + 1 > Fn.maxNodeSize then
let
(* hd is full so join new to end of left *)
val left = joinEndOfLeft (Vector.fromList [new], left)
in
{left = left, right = right}
end
else
let
(* join to start without splitting *)
val rhd = Vector.concat [Vector.fromList [new], hd]
in
{left = left, right = joinStartOfRight (rhd, tl)}
end
else
insMiddle (hd, insPos, new, left, right)
end
| [] =>
let val new = Vector.fromList [new]
in {left = joinEndOfLeft (new, left), right = right}
end
fun add (new, {left, right}: t) =
(* look at elements to see which way to traverse *)
case right of
hd :: _ =>
let
val rfirst = Vector.sub (hd, 0)
in
if Fn.g (new, rfirst) then insRight (new, left, right)
else if Fn.l (new, rfirst) then insLeft (new, left, right)
else {left = left, right = right}
end
| [] => insLeft (new, left, right)
fun helpMoveToStart (left, right) =
case left of
hd :: tl => helpMoveToStart (tl, joinStartOfRight (hd, right))
| [] => {left = left, right = right}
fun moveToStart {left, right} =
case left of
hd :: tl => helpMoveToStart (tl, joinStartOfRight (hd, right))
| [] => {left = left, right = right}
fun helpMoveToEnd (left, right) =
case right of
hd :: tl => helpMoveToEnd (joinEndOfLeft (hd, left), tl)
| [] => {left = left, right = right}
fun moveToEnd {left, right} =
case right of
hd :: tl => helpMoveToEnd (joinEndOfLeft (hd, left), tl)
| [] => {left = left, right = right}
fun moveLeft (to, left, right) =
case left of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
in
if Fn.l (to, first) then
moveLeft (to, tl, joinStartOfRight (hd, right))
else
{left = left, right = right}
end
| [] => {left = left, right = right}
fun moveRight (to, left, right) =
case right of
hd :: tl =>
let
val last = Vector.sub (hd, Vector.length hd - 1)
in
if Fn.g (to, last) then moveRight (to, joinEndOfLeft (hd, left), tl)
else {left = left, right = right}
end
| [] => {left = left, right = right}
fun moveToWhenRightIsEmpty (to, left, right) =
case left of
hd :: _ =>
let
val llast = Vector.sub (hd, Vector.length hd - 1)
in
if Fn.l (to, llast) then moveLeft (to, left, right)
else {left = left, right = right}
end
| [] => {left = left, right = right}
fun moveTo (to, {left, right}) =
case right of
hd :: _ =>
let
val rfirst = Vector.sub (hd, 0)
in
if Fn.g (to, rfirst) then moveRight (to, left, right)
else if Fn.l (to, rfirst) then moveLeft (to, left, right)
else {left = left, right = right}
end
| [] => moveToWhenRightIsEmpty (to, left, right)
fun helpMin (hd :: tl, prevHd) = helpMin (tl, hd)
| helpMin ([], prevHd) =
SOME (Vector.sub (prevHd, 0))
fun min {left = hd :: tl, right = _} = helpMin (tl, hd)
| min {left = [], right = hd :: _} =
SOME (Vector.sub (hd, 0))
| min {left = [], right = []} = NONE
fun helpMax (_, hd :: tl) = helpMax (hd, tl)
| helpMax (hd, []) =
SOME (Vector.sub (hd, Vector.length hd - 1))
fun max {left = _, right = hd :: tl} = helpMax (hd, tl)
| max {left = hd :: _, right = []} =
SOME (Vector.sub (hd, Vector.length hd - 1))
| max {left = [], right = []} = NONE
fun existsLeft (check, hd :: tl) =
let
val pos = findInsPos (check, hd)
in
if pos < 0 then existsLeft (check, tl)
else if pos = Vector.length hd then false
else Fn.eq (Vector.sub (hd, pos), check)
end
| existsLeft (_, []) = false
fun existsRight (check, hd :: tl) =
let
val pos = findInsPos (check, hd)
in
if pos = Vector.length hd then existsRight (check, tl)
else if pos < 0 then false
else Fn.eq (Vector.sub (hd, pos), check)
end
| existsRight (_, []) = false
fun exists (check, {left, right}) =
case right of
hd :: tl =>
let
val first = Vector.sub (hd, 0)
in
if Fn.g (check, first) then existsRight (check, tl)
else if Fn.eq (check, first) then true
else existsLeft (check, left)
end
| [] => existsLeft (check, left)
fun removeLeft (toRemove, left, right) =
case left of
hd :: tl =>
let
val insPos = findInsPos (toRemove, hd)
in
if insPos < 0 then
removeLeft (toRemove, tl, joinStartOfRight (hd, right))
else if insPos = Vector.length hd then
{left = tl, right = joinStartOfRight (hd, right)}
else if Fn.eq (toRemove, Vector.sub (hd, insPos)) then
let
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
val rhdLen = Vector.length hd - insPos
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, tl)
, right = joinStartOfRight (rhd, right)
}
end
else
{left = tl, right = joinStartOfRight (hd, right)}
end
| [] => {left = left, right = right}
fun removeRight (toRemove, left, right) =
case right of
hd :: tl =>
let
val insPos = findInsPos (toRemove, hd)
in
if insPos = Vector.length hd then
removeRight (toRemove, joinEndOfLeft (hd, left), right)
else if insPos < 0 then
{left = joinEndOfLeft (hd, left), right = right}
else if Fn.eq (toRemove, Vector.sub (hd, insPos)) then
let
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
val rhdLen = Vector.length hd - insPos
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, tl)
}
end
else
{left = joinEndOfLeft (hd, left), right = tl}
end
| [] => {left = left, right = right}
fun remove (toRemove, {left, right}) =
case right of
hd :: tl =>
let
val rfirst = Vector.sub (hd, 0)
in
if Fn.g (toRemove, rfirst) then
removeRight (toRemove, left, right)
else if Fn.l (toRemove, rfirst) then
removeLeft (toRemove, left, right)
else
let
val len = Vector.length hd - 1
val hd = VectorSlice.slice (hd, 1, SOME len)
val hd = VectorSlice.vector hd
in
{left = left, right = joinStartOfRight (hd, tl)}
end
end
| [] => removeLeft (toRemove, left, right)
fun removeRightFromHere (finish, right) =
case right of
hd :: tl =>
let
val finishPos = findInsPos (finish, hd)
in
if finishPos = Vector.length hd then
removeRightFromHere (finish, tl)
else if finishPos < 0 then
right
else
let
(* keep second half of hd / remove first part of hd *)
val finishPos =
if Fn.eq (finish, Vector.sub (hd, finishPos)) then finishPos + 1
else finishPos
val len = Vector.length hd - finishPos
val slice = VectorSlice.slice (hd, finishPos, SOME len)
val newHd = VectorSlice.vector slice
in
joinStartOfRight (newHd, tl)
end
end
| [] => right
fun removeLeftFromHere (start, left) =
case left of
hd :: tl =>
let
val startPos = findInsPos (start, hd)
in
if startPos < 0 then
removeLeftFromHere (start, tl)
else if startPos = Vector.length hd then
left
else
let
(* keep first half of hd / remove last part of hd *)
val slice = VectorSlice.slice (hd, 0, SOME startPos)
val newHd = VectorSlice.vector slice
in
joinEndOfLeft (newHd, tl)
end
end
| [] => left
fun removeManyFromHd (startPos, finish, finishPos, hd, left, right) =
let
val lhd = VectorSlice.slice (hd, 0, SOME startPos)
val rStart =
if Fn.eq (finish, Vector.sub (hd, finishPos)) then finishPos + 1
else finishPos
val rlen = Vector.length hd - rStart
val rhd = VectorSlice.slice (hd, rStart, SOME rlen)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{left = joinEndOfLeft (lhd, left), right = joinStartOfRight (rhd, right)}
end
fun moveLeftAndRemove (start, finish, left, right) =
case left of
hd :: tl =>
let
val finishPos = findInsPos (finish, hd)
in
if finishPos < 0 then
moveLeftAndRemove (start, finish, tl, joinStartOfRight (hd, right))
else if finishPos = Vector.length hd then
let
val startPos = findInsPos (start, hd)
in
if startPos < 0 then
(* remove hd and continue removing leftwards *)
let val left = removeLeftFromHere (start, left)
in {left = left, right = right}
end
else if startPos = Vector.length hd then
(* return, not removing anything,
* because there are no elements
* between start and finish.
* We do still join hd to tl if pssible for performace reasons. *)
{left = joinEndOfLeft (hd, tl), right = right}
else
(* have to delete from last part of hd *)
let
val slice = VectorSlice.slice (hd, 0, SOME startPos)
val newHd = VectorSlice.vector slice
in
{left = joinEndOfLeft (newHd, tl), right = right}
end
end
else
(* finish pos is somewhere in middle of hd
* but have to check where startPos is. *)
let
val startPos = findInsPos (start, hd)
in
if startPos < 0 then
let
val slice = VectorSlice.slice (hd, 0, SOME finishPos)
val newHd = VectorSlice.vector slice
val left = removeLeftFromHere (start, tl)
in
{left = left, right = right}
end
else
(* startPos is in middle of hd.
* Does not make sense for startPos = Vector.length hd
* because finishPos is in middle as well.
* So, delete from middle. *)
removeManyFromHd (startPos, finish, finishPos, hd, tl, right)
end
end
| [] => {left = left, right = right}
fun moveRightAndRemove (start, finish, left, right) =
case right of
hd :: tl =>
let
val startPos = findInsPos (start, hd)
in
if startPos = Vector.length hd then
(* keep moving rightwards *)
moveRightAndRemove (start, finish, joinEndOfLeft (hd, left), tl)
else if startPos < 0 then
(* start does not exist as it is before this node.
* Does finish exist, and if it does, what is its position? *)
let
val finishPos = findInsPos (finish, hd)
in
if finishPos = Vector.length hd then
(* remove this node and delete right from here. *)
let val right = removeRightFromHere (finish, tl)
in {left = left, right = right}
end
else if finishPos < 0 then
(* finish is less than first element in this node,
* so return. *)
{left = left, right = right}
else
(* have to delete first part of the hd *)
let
val lhd = VectorSlice.slice (hd, 0, SOME startPos)
val rStart =
if Fn.eq (Vector.sub (hd, finishPos), finish) then
finishPos + 1
else
finishPos
val rLen = Vector.length hd - rStart
val rhd = VectorSlice.slice (hd, rStart, SOME rLen)
val lhd = VectorSlice.vector lhd
val rhd = VectorSlice.vector rhd
in
{ left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, right)
}
end
end
else
(* have to delete starting from this node.
* End depends on the `finish` value. *)
let
val finishPos = findInsPos (finish, hd)
in
if finishPos = Vector.length hd then
(* delete last part of this node
* and continue deleting rightwards *)
let
val hd = VectorSlice.slice (hd, 0, SOME startPos)
val hd = VectorSlice.vector hd
val tl = removeRightFromHere (finish, tl)
in
{left = left, right = joinStartOfRight (hd, tl)}
end
else
(* we already checked and found that
* start is somewhere in the middle.
* This means `finish` must be in the middle too,
* if finish is not equal to `Vector.length hd`.
* So we only need to delete some part from the middle of hd. *)
removeManyFromHd (startPos, finish, finishPos, hd, left, tl)
end
end
| [] => {left = left, right = right}
fun removeWhenStartIsLessThanRFirst (start, finish, left, right, rfirst) =
case left of
lhd :: _ =>
let
val llast = Vector.sub (lhd, Vector.length lhd - 1)
in
if Fn.l (start, llast) then
if Fn.g (finish, llast) then
(* have to delete left from here and right from here *)
let
val left = removeLeftFromHere (start, left)
(* removeRightFromHere will not remove anything
* if finish < rfirst *)
val right = removeRightFromHere (finish, right)
in
{left = left, right = right}
end
else
(* either finish < llast or finish = llast
* which means move left and delete
* since finish may be before lhd *)
moveLeftAndRemove (start, finish, left, right)
else if Fn.eq (start, llast) then
if
Fn.eq (finish, llast)
then
(* just need to remove llast as both start and finish range
* are contained in left *)
let val left = removeLeftFromHere (start, left)
in {left = left, right = right}
end
else (* finish > llast
* as finish < llast case is impossible
* since start = llast.
* Check how finish compares to rfirst. *) if
Fn.l (finish, rfirst)
then
(* don't do anything with finish/rfirst,
* because finish is less than rfirst
* but do remove llast from left
* because llast is equal to start *)
let val left = removeLeftFromHere (start, left)
in {left = left, right = right}
end
else
(* finish >= rfirst; in either case, we need to remove
* some elements which are in right. *)
let
val left = removeLeftFromHere (start, left)
val right = removeRightFromHere (finish, right)
in
{left = left, right = right}
end
else (* start > llast *) if Fn.l (finish, rfirst) then
(* no elements in range between start and finish *)
{left = left, right = right}
else
(* whether finish > rfirst or finish = rfirst,
* we have some elements to delete from the right *)
let val right = removeRightFromHere (finish, right)
in {left = left, right = right}
end
end
| [] => {left = left, right = right}
fun removeWhenRightIsEmpty (start, finish, left, right) =
case left of
hd :: tl =>
let
val finishPos = findInsPos (finish, hd)
val startPos = findInsPos (start, hd)
in
if
finishPos = Vector.length hd
then
if startPos = Vector.length hd then
{left = left, right = right}
else if startPos < 0 then
(* remove hd, and continue removing leftwards *)
let val left = removeLeftFromHere (start, left)
in {left = left, right = right}
end
else
(* remove last part of hd, keeping first part *)
let
val slice = VectorSlice.slice (hd, 0, SOME startPos)
val newHd = VectorSlice.vector slice
in
{left = tl, right = [newHd]}
end
else if
finishPos < 0
then
moveLeftAndRemove (start, finish, tl, [hd])
else (* finishPos is in middle; what about startPos? *) if
startPos < 0
then
moveLeftAndRemove (start, finish, left, right)
else
(* startPos is in middle because `start = Vector.length hd`
* is impossible, as finish is in middle already. *)
removeManyFromHd (startPos, finish, finishPos, hd, tl, right)
end
| [] => {left = left, right = right}
(* assumption: 'start' is the minimum element to delete and 'finish' is the
* last element to delete.
* Reason for this assumption is because we don't ask the user for a function
* like `Int.min` or `Int.max` which can be used to get the minimum/maximum.
* So, if the user passes in a `start` that is greater than a `finish`,
* then that's a user error. *)
fun removeMany (start, finish, {left, right}) =
case right of
rhd :: _ =>
let
val rfirst = Vector.sub (rhd, 0)
in
if Fn.g (start, rfirst) then
(* Will need to move rightwards and delete. *)
moveRightAndRemove (start, finish, left, right)
else if Fn.eq (start, rfirst) then
(* need to delete right from here *)
let val right = removeRightFromHere (finish, right)
in {left = left, right = right}
end
else
removeWhenStartIsLessThanRFirst (start, finish, left, right, rfirst)
end
| [] => removeWhenRightIsEmpty (start, finish, left, right)
fun helpFromList (lst, acc) =
case lst of
hd :: tl => let val acc = add (hd, acc) in helpFromList (tl, acc) end
| [] => acc
fun fromList lst = helpFromList (lst, empty)
fun helpToVector (hd :: tl, acc) =
helpToVector (tl, hd :: acc)
| helpToVector ([], acc) = Vector.concat acc
fun toVector {left, right} = helpToVector (left, right)
end

510
brolib-sml/src/gap_vector.sml Normal file
View File

@@ -0,0 +1,510 @@
signature GAP_VECTOR_INPUT =
sig
type elem
val maxNodeSide: int
end
signature GAP_VECTOR =
sig
structure Fn: GAP_VECTOR_INPUT
type t = {idx: int, left: Fn.elem vector list, right: Fn.elem vector list}
val empty: t
val fromVector: Fn.elem vector -> t
val toVector: t -> Fn.elem vector
val insert: int * Fn.elem * t -> t
val insertMany: int * Fn.elem vector * t -> t
val deleteMany: int * int * t -> t
end
functor MakeGapVector(Fn: GAP_VECTOR_INPUT): GAP_VECTOR =
struct
structure Fn = Fn
type t = {idx: int, left: Fn.elem vector list, right: Fn.elem vector list}
val empty = {idx = 0, left = [], right = []}
fun fromVector vec = {idx = Vector.length vec, left = [vec], right = []}
local
fun toList (acc, input) =
case input of
hd :: tl => toList (hd :: acc, tl)
| [] => acc
in
fun toVector ({left, right, ...}: t) =
let val lst = toList (right, left)
in Vector.concat lst
end
end
fun isLessThanTarget (v1, v2) =
Vector.length v1 + Vector.length v2 <= Fn.maxNodeSide
fun isThreeLessThanTarget (v1, v2, v3) =
Vector.length v1 + Vector.length v2 + Vector.length v3 <= Fn.maxNodeSide
fun consLeft (curIdx, newVector, left, right) =
{ idx = curIdx + Vector.length newVector
, left = newVector :: left
, right = right
}
fun joinEndOfLeft (newVector, left) =
case left of
hd :: tail =>
if isLessThanTarget (newVector, hd) then
Vector.concat [hd, newVector] :: tail
else
newVector :: left
| [] => newVector :: left
fun joinStartOfRight (newVector, right) =
case right of
hd :: tail =>
if isLessThanTarget (newVector, hd) then
Vector.concat [newVector, hd] :: tail
else
newVector :: right
| [] => newVector :: right
fun preferInsertLeft (curIdx, newVector, left, right) =
case left of
hd :: tail =>
if isLessThanTarget (hd, newVector) then
{ idx = curIdx + Vector.length newVector
, left = Vector.concat [hd, newVector] :: tail
, right = right
}
else
(case right of
hd :: tail =>
if isLessThanTarget (hd, newVector) then
{ idx = curIdx
, left = left
, right = Vector.concat [newVector, hd] :: tail
}
else
consLeft (curIdx, newVector, left, right)
| [] => consLeft (curIdx, newVector, left, right))
| [] => consLeft (curIdx, newVector, left, right)
fun isSliceLessThanTarget (slice, vec) =
VectorSlice.length slice + Vector.length vec <= Fn.maxNodeSide
fun isThreeSliceLessThanTarget (slice1, slice2, vec) =
VectorSlice.length slice1 + VectorSlice.length slice2 + Vector.length vec
<= Fn.maxNodeSide
fun insLeft (prevIdx, idx, newVector, curIdx, hd, tail, right) =
(* The requested index is either:
* - At the start of the left vector
* - In the middle of the left vector
* Find out which and split the middle of the vector if necessary. *)
if idx = prevIdx then
(* At start of vector. *)
{ idx = curIdx + Vector.length newVector
, right = right
, left =
(* These two meant to look reversed,
* with respect to newVector and hd.
*
* The line
* `newVector ^ hd`
* places the contents of newVector before hd,
* and the line
* `hd :: newVector`
* in a zipper also places newVector before hd.
*
* Using `newVector ^ hd` with `newVector :: hd` gives
* different contents in the case of a zipper.
* *)
if isLessThanTarget (newVector, hd) then
Vector.concat [newVector, hd] :: tail
else
hd :: newVector :: tail
}
else
(* In middle of vector. *)
let
val length = idx - prevIdx
val slice1 = VectorSlice.slice (hd, 0, SOME length)
val slice2 = VectorSlice.slice (hd, length, SOME
(Vector.length hd - length))
in
if isThreeSliceLessThanTarget (slice1, slice2, newVector) then
let
val newVector = VectorSlice.full newVector
val hd = VectorSlice.concat [slice1, newVector, slice2]
in
{ idx = curIdx + VectorSlice.length newVector
, left = hd :: tail
, right = right
}
end
else if isSliceLessThanTarget (slice1, newVector) then
let
val idx =
prevIdx + VectorSlice.length slice1 + Vector.length newVector
val newVector = VectorSlice.full newVector
val lhd = VectorSlice.concat [slice1, newVector]
in
{ idx = idx
, left = joinEndOfLeft (lhd, tail)
, right = joinStartOfRight (VectorSlice.vector slice2, right)
}
end
else if isSliceLessThanTarget (slice2, newVector) then
let
val idx = prevIdx + VectorSlice.length slice1
val newVector = VectorSlice.full newVector
val rhd = VectorSlice.concat [newVector, slice2]
in
{ idx = idx
, left = joinEndOfLeft (VectorSlice.vector slice1, tail)
, right = joinStartOfRight (rhd, right)
}
end
else
let
val slice1 = VectorSlice.vector slice1
val slice2 = VectorSlice.vector slice2
in
{ idx = prevIdx
, left = tail
, right = slice1 :: newVector :: slice2 :: right
}
end
end
fun insRight (nextIdx, idx, newVector, curIdx, left, hd, tail) =
if idx = nextIdx then
(* At end of next Vector. *)
{ idx = curIdx
, left = left
, right =
if isLessThanTarget (newVector, hd) then
Vector.concat [hd, newVector] :: tail
else
hd :: (joinStartOfRight (newVector, tail))
}
else
let
val length = idx - curIdx
val slice1 = VectorSlice.slice (hd, 0, SOME length)
val slice2 = VectorSlice.slice (hd, length, SOME
(Vector.length hd - length))
in
if isThreeSliceLessThanTarget (slice1, slice2, newVector) then
let
val idx =
curIdx + VectorSlice.length slice1 + Vector.length newVector
+ VectorSlice.length slice2
val newVector = VectorSlice.full newVector
val lhd = VectorSlice.concat [slice1, newVector, slice2]
in
{idx = idx, left = joinEndOfLeft (lhd, left), right = tail}
end
else if isSliceLessThanTarget (slice1, newVector) then
let
val idx =
curIdx + VectorSlice.length slice1 + Vector.length newVector
val lhd = VectorSlice.concat [slice1, VectorSlice.full newVector]
in
{ idx = idx
, left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (VectorSlice.vector slice2, tail)
}
end
else if isSliceLessThanTarget (slice2, newVector) then
let
val idx = curIdx + VectorSlice.length slice1
val lhd = VectorSlice.vector slice1
val newVector = VectorSlice.full newVector
val rhd = VectorSlice.concat [newVector, slice2]
in
{ idx = idx
, left = joinEndOfLeft (lhd, left)
, right = joinStartOfRight (rhd, tail)
}
end
else
let
val idx =
curIdx + VectorSlice.length slice1 + Vector.length newVector
val slice1 = VectorSlice.vector slice1
val slice2 = VectorSlice.vector slice2
in
{ idx = idx
, left = newVector :: joinEndOfLeft (slice1, left)
, right = joinStartOfRight (slice2, tail)
}
end
end
fun ins (idx, newVector, curIdx, left, right) : t =
if curIdx = idx then
preferInsertLeft (curIdx, newVector, left, right)
else if idx < curIdx then
(* Need to insert on the left. *)
case left of
[] =>
(* If there is no vector on the left, then add the new vector there. *)
{idx = Vector.length newVector, left = [newVector], right = right}
| hd :: tail =>
let
val prevIdx = curIdx - Vector.length hd
in
if idx < prevIdx then
(* The requested index is prior to the vector on the left,
* so move leftward one vector. *)
ins (idx, newVector, prevIdx, tail, joinStartOfRight (hd, right))
else
insLeft (prevIdx, idx, newVector, curIdx, hd, tail, right)
end
else
(* Need to insert to the right. *)
case right of
[] => {idx = curIdx, left = left, right = [newVector]}
| hd :: tail =>
let
val nextIdx = Vector.length hd + curIdx
in
if idx > nextIdx then
ins (idx, newVector, nextIdx, joinEndOfLeft (hd, left), tail)
else
insRight (nextIdx, idx, newVector, curIdx, left, hd, tail)
end
fun insertMany (idx, newVector, buffer: t) =
ins (idx, newVector, #idx buffer, #left buffer, #right buffer)
fun insert (idx, elem, buffer) =
insertMany (idx, Vector.fromList [elem], buffer)
fun deleteRightFromHere (curIdx, finish, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + Vector.length hd
in
if nextIdx < finish then
deleteRightFromHere (nextIdx, finish, tail)
else if nextIdx > finish then
let
val newVecStart = finish - curIdx
val slice = VectorSlice.slice (hd, newVecStart, SOME
(Vector.length hd - newVecStart))
val newVec = VectorSlice.vector slice
in
newVec :: tail
end
else
(* nextIdx = finish
* Delete current head but no further. *)
tail
end
| [] => right
fun moveRightAndDelete (start, finish, curIdx, left, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + Vector.length hd
in
if nextIdx < start then
(* Keep moving right: haven't reached start yet. *)
moveRightAndDelete
(start, finish, nextIdx, joinEndOfLeft (hd, left), tail)
else if nextIdx > start then
if nextIdx < finish then
(* Delete the start range contained in this vector,
* and then continue deleting right. *)
let
val length = start - curIdx
val newVector = VectorSlice.slice (hd, 0, SOME length)
val newVector = VectorSlice.vector newVector
in
{ idx = curIdx + Vector.length newVector
, left = joinEndOfLeft (newVector, left)
, right = deleteRightFromHere (nextIdx, finish, tail)
}
end
else if nextIdx > finish then
(* Have to delete from middle of vector. *)
let
val sub1Length = start - curIdx
val sub2Start = finish - curIdx
val sub2Len = Vector.length hd - sub2Start
val slice1 = VectorSlice.slice (hd, 0, SOME sub1Length)
val slice2 = VectorSlice.slice (hd, sub2Start, SOME sub2Len)
val slice1 = VectorSlice.vector slice1
val slice2 = VectorSlice.vector slice2
in
{ idx = curIdx + sub1Length
, left = joinEndOfLeft (slice1, left)
, right = joinStartOfRight (slice2, tail)
}
end
else
(* nextIdx = finish
* Have to delete from end of this vector. *)
let
val vecLength = start - curIdx
val vec = VectorSlice.slice (hd, 0, SOME vecLength)
val vec = VectorSlice.vector vec
in
{ idx = curIdx + vecLength
, left = joinEndOfLeft (vec, left)
, right = tail
}
end
else
(* nextIdx = start
* The start range is contained fully at the next node,
* without having to remove part of a vector at this node.*)
let
val newRight = deleteRightFromHere (nextIdx, finish, tail)
in
{ idx = curIdx
, left = left
, right = joinStartOfRight (hd, newRight)
}
end
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteLeftFromHere (start, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - Vector.length hd
in
if start < prevIdx then
deleteLeftFromHere (start, prevIdx, tail, right)
else if start > prevIdx then
(* Need to delete from some part of this vector. *)
let
val length = start - prevIdx
val newVec = VectorSlice.slice (hd, 0, SOME length)
val newVec = VectorSlice.vector newVec
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (newVec, right)
}
end
else
(* if start = prevIdx
* Need to remove the current node without deleting any further. *)
{idx = prevIdx, left = tail, right = right}
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteFromLeftAndRight (start, finish, curIdx, left, right) =
let val right = deleteRightFromHere (curIdx, finish, right)
in deleteLeftFromHere (start, curIdx, left, right)
end
fun moveLeftAndDelete (start, finish, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - Vector.length hd
in
if prevIdx > finish then
moveLeftAndDelete
(start, finish, prevIdx, tail, joinStartOfRight (hd, right))
else if prevIdx < finish then
if prevIdx > start then
(* Delete from start point of this vector,
* and then call function to continue deleting leftward. *)
let
val hdStart = finish - prevIdx
val newLen = Vector.length hd - hdStart
val newHd = VectorSlice.slice (hd, hdStart, SOME newLen)
val newHd = VectorSlice.vector newHd
val right = joinStartOfRight (newHd, right)
in
deleteLeftFromHere (start, prevIdx, tail, right)
end
else if prevIdx < start then
(* We want to delete in the middle of this current vector. *)
let
val sub1Length = start - prevIdx
val sub2Start = finish - prevIdx
val sub2Len = Vector.length hd - sub2Start
val slice1 = VectorSlice.slice (hd, 0, SOME sub1Length)
val slice2 = VectorSlice.slice (hd, sub2Start, SOME sub2Len)
val slice1 = VectorSlice.vector slice1
val slice2 = VectorSlice.vector slice2
in
{ idx = prevIdx + sub1Length
, left = joinEndOfLeft (slice1, tail)
, right = joinStartOfRight (slice2, right)
}
end
else
(* prevIdx = start
* We want to delete from the start of this vector and stop. *)
let
val vecStart = finish - prevIdx
val vecLen = Vector.length hd - vecStart
val vec = VectorSlice.slice (hd, vecStart, SOME vecLen)
val vec = VectorSlice.vector vec
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (vec, right)
}
end
else
(* prevIdx = finish *)
deleteLeftFromHere
(start, prevIdx, tail, joinStartOfRight (hd, right))
end
| [] => {idx = curIdx, left = left, right = right}
fun del (start, finish, curIdx, left, right) : t =
if start > curIdx then
(* If start is greater than current index,
* then finish must be greater too.
* Move buffer rightwards until finish is reached,
* and delete along the way. *)
moveRightAndDelete (start, finish, curIdx, left, right)
else if start < curIdx then
(* If start is less than current index,
* then finish could be either less than or equal/greater
* than the current index.
* We can treat equal/greater than as one case. *)
if finish <= curIdx then
(* Move leftward and delete along the way. *)
moveLeftAndDelete (start, finish, curIdx, left, right)
else
(* Delete rightward up to finish index,
* and then delete leftward until start index.*)
deleteFromLeftAndRight (start, finish, curIdx, left, right)
else
(* If start is equal to the current index,
* then only examine the right list.
* Just need to delete until reaching the finish index. *)
{ idx = curIdx
, left = left
, right = deleteRightFromHere (curIdx, finish, right)
}
fun deleteMany (start, length, buffer: t) =
if length > 0 then
del (start, start + length, #idx buffer, #left buffer, #right buffer)
else
buffer
end

3586
brolib-sml/src/line_gap.sml Normal file
View File

File diff suppressed because it is too large Load Diff

795
brolib-sml/src/rope.sml Normal file
View File

@@ -0,0 +1,795 @@
signature ROPE =
sig
type t
val empty: t
val fromString: string -> t
val toString: t -> string
(* The caller should not insert in the middle of a \r\n pair,
* or else line metadata will become invalid. *)
val insert: int * string * t -> t
(* The append and appendLine function both add a string to the end.
* The difference is that append calculates line metadata
* from the given string, while appendLine accepts
* (possibly incorrect) metadata from the caller. *)
val append: string * t -> t
val appendLine: string * int vector * t -> t
(* The caller should not delete only a single character in a \r\n pair,
* because then line metadata will become invalid. *)
val delete: int * int * t -> t
(* Folds over the characters in the rope starting from the index
* in the second parameter. *)
val foldFromIdx: (char * 'a -> 'a) * int * t * 'a -> 'a
(* Like the foldFromIdx function, but accepts a predicate as the second
* argument.
* If the predicate returns true, terminates and returns the result;
* else, continues folding until predicate returns true or until remaining
* characters have been traversed. *)
val foldFromIdxTerm: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
(* This function folds over the characters in the rope,
* starting from a given line number.
* The second argument is a predicate indicating when to stop folding. *)
val foldLines: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
(* This below function is just for testing.
* It verifies that line metadata is as expected,
* raising an exception if it is different,
* and returning true if it is the same. *)
val verifyLines: t -> bool
end
structure Rope :> ROPE =
struct
(* This function counts line breaks in reverse order,
* from the end of the string to the start.
* Reverse order is used for performance, as it avoids a List.rev at the end. *)
fun helpCountLineBreaks (pos, acc, str) =
if pos < 0 then
Vector.fromList acc
else
let
val chr = String.sub (str, pos)
in
if chr = #"\n" then
(* Is this a \r\n pair? Then the position of \r should be consed. *)
if pos = 0 then
Vector.fromList (0 :: acc)
else
let
val prevChar = String.sub (str, pos - 1)
in
if prevChar = #"\r" then
helpCountLineBreaks (pos - 2, (pos - 1) :: acc, str)
else
helpCountLineBreaks (pos - 1, pos :: acc, str)
end
else if chr = #"\r" then
helpCountLineBreaks (pos - 1, pos :: acc, str)
else
helpCountLineBreaks (pos - 1, acc, str)
end
fun countLineBreaks str =
helpCountLineBreaks (String.size str - 1, [], str)
(* Binary search. Used to find split point in vector. *)
fun binSearch (findNum, lines, low, high) =
if Vector.length lines = 0 then
0
else
let
val mid = low + ((high - low) div 2)
in
if high >= low then
let
val midVal = Vector.sub (lines, mid)
in
if midVal = findNum then
mid
else if midVal < findNum then
binSearch (findNum, lines, mid + 1, high)
else
binSearch (findNum, lines, low, mid - 1)
end
else
mid
end
datatype t =
N0 of string * int vector
| N1 of t
| N2 of t * int * int * t
| L2 of string * int vector * string * int vector
| N3 of t * t * t
exception AuxConstructor
exception Substring of int
fun foldrString (f, state, rope) =
case rope of
N2 (l, _, _, r) =>
let val state = foldrString (f, state, r)
in foldrString (f, state, l)
end
| N1 t => foldrString (f, state, t)
| N0 (s, _) => f (state, s)
| _ => raise AuxConstructor
fun toString rope =
let val strList = foldrString ((fn (acc, str) => str :: acc), [], rope)
in String.concat strList
end
fun foldr (f, state, rope) =
case rope of
N2 (l, _, _, r) =>
let val state = foldr (f, state, r)
in foldr (f, state, l)
end
| N1 t => foldr (f, state, t)
| N0 (s, v) => f (state, s, v)
| _ => raise AuxConstructor
datatype balance = AddedNode | DeletedNode | NoAction
val targetLength = 1024
val targetVecLength = 128
fun id x = x
val emptyVec = Vector.tabulate (0, id)
val empty = N0 ("", emptyVec)
fun fromString string =
let val lineBreaks = countLineBreaks string
in N0 (string, lineBreaks)
end
fun isLessThanTarget (str1, str2, vec1, vec2) =
String.size str1 + String.size str2 <= targetLength
andalso Vector.length vec1 + Vector.length vec2 <= targetVecLength
(* This function creates a new node in the rope, calculating right-metadata.
* This is equivalent to helpSize/size in tiny_rope.ml,
* but because the size function in tiny_rope.ml was only used
* by callers to construct N2 cases,
* it can be replaced with a function that constructs N2 cases
* instead of returning (int * int) metadata which results in
* an extra tuple allocation. *)
fun helpMakeN2 (idxAcc, lineAcc, left, right, rope) =
case rope of
N2 (_, lms, lmv, r) =>
helpMakeN2 (lms + idxAcc, lmv + lineAcc, left, right, r)
| N1 t => helpMakeN2 (idxAcc, lineAcc, left, right, t)
| N0 (str, lines) =>
let
val idxAcc = idxAcc + String.size str
val lineAcc = lineAcc + Vector.length lines
in
N2 (left, idxAcc, lineAcc, right)
end
| _ => raise AuxConstructor
(* Accumulate right-metadata for left rope. *)
fun makeN2 (left, right) =
helpMakeN2 (0, 0, left, right, left)
fun insL2 (s1, v1, s2, v2) =
let
val left = N0 (s1, v1)
val right = N0 (s2, v2)
in
N2 (left, String.size s1, Vector.length v1, right)
end
fun insN3 (t1, t2, t3) =
let
val left = makeN2 (t1, t2)
val right = N1 t3
in
makeN2 (left, right)
end
fun insRoot rope =
case rope of
L2 (s1, v1, s2, v2) => insL2 (s1, v1, s2, v2)
| N3 (t1, t2, t3) => insN3 (t1, t2, t3)
| t => t
fun delRoot rope =
case rope of
N1 t => t
| t => t
fun insN1 rope =
case rope of
L2 (s1, v1, s2, v2) => insL2 (s1, v1, s2, v2)
| N3 (t1, t2, t3) => insN3 (t1, t2, t3)
| t => N1 t
fun insN2Left (left, right) =
case (left, right) of
(L2 (s1, v1, s2, v2), t3) =>
let
val left = N0 (s1, v1)
val middle = N0 (s2, v2)
in
N3 (left, middle, t3)
end
| (N3 (t1, t2, t3), N1 t4) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
in
makeN2 (left, right)
end
| (N3 (t1, t2, t3), t4) =>
let
val left = makeN2 (t1, t2)
val middle = N1 t3
in
N3 (left, middle, t4)
end
| (l, r) => makeN2 (l, r)
fun delN2Left (left, right) =
case (left, right) of
(N1 t1, N1 t2) => let val inner = makeN2 (t1, t2) in N1 inner end
| (N1 (N1 t1), N2 (N1 t2, _, _, (t3 as N2 _))) =>
let
val left = makeN2 (t1, t2)
val inner = makeN2 (left, t3)
in
N1 inner
end
| (N1 (N1 t1), N2 (N2 (t2, _, _, t3), _, _, N1 t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
val inner = makeN2 (left, right)
in
N1 inner
end
| (N1 (t1 as N1 _), N2 ((t2 as N2 _), _, _, (t3 as N2 _))) =>
let
val left = makeN2 (t1, t2)
val right = N1 t3
in
makeN2 (left, right)
end
| (l, r) => makeN2 (l, r)
fun insN2Right (left, right) =
case (left, right) of
(t1, L2 (s1, v1, s2, v2)) =>
let
val middle = N0 (s1, v1)
val right = N0 (s2, v2)
in
N3 (t1, middle, right)
end
| (N1 t1, N3 (t2, t3, t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
in
makeN2 (left, right)
end
| (t1, N3 (t2, t3, t4)) =>
let
val right = makeN2 (t3, t4)
val middle = N1 t2
in
N3 (t1, middle, right)
end
| (l, r) => makeN2 (l, r)
fun delN2Right (left, right) =
case (left, right) of
(N2 (N1 t1, _, _, N2 (t2, _, _, t3)), N1 (N1 t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
val inner = makeN2 (left, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), lms, lmv, N1 t2), N1 (N1 t3)) =>
let
val right = makeN2 (t2, t3)
val inner = N2 (t1, lms, lmv, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), _, _, (t2 as N2 _)), N1 (t3 as N1 _)) =>
let
val left = N1 t1
val right = makeN2 (t2, t3)
in
makeN2 (left, right)
end
| (l, r) => makeN2 (l, r)
fun insVecBefore (oldVec, newVec, newStr) =
let
val oldLen = Vector.length oldVec
val newLen = Vector.length newVec
val total = oldLen + newLen
val newStrLen = String.size newStr
in
Vector.tabulate (total, (fn idx =>
if idx < newLen then Vector.sub (newVec, idx)
else Vector.sub (oldVec, idx - newLen) + newStrLen))
end
fun insVecAfter (oldStr, oldVec, newVec) =
let
val oldLen = Vector.length oldVec
val newLen = Vector.length newVec
val total = oldLen + newLen
val oldStrLen = String.size oldStr
in
Vector.tabulate (total, (fn idx =>
if idx < oldLen then Vector.sub (oldVec, idx)
else Vector.sub (newVec, idx - oldLen) + oldStrLen))
end
fun preLeaf (oldStr, oldVec, newStr, newVec) =
if isLessThanTarget (oldStr, newStr, oldVec, newVec) then
let
val str = newStr ^ oldStr
val vec = insVecBefore (oldVec, newVec, newStr)
in
(N0 (str, vec), NoAction)
end
else
let val l2 = L2 (newStr, newVec, oldStr, oldVec)
in (l2, AddedNode)
end
fun appLeaf (oldStr, oldVec, newStr, newVec) =
if isLessThanTarget (oldStr, newStr, oldVec, newVec) then
let
val str = oldStr ^ newStr
val vec = insVecAfter (oldStr, oldVec, newVec)
in
(N0 (str, vec), NoAction)
end
else
let val l2 = L2 (oldStr, oldVec, newStr, newVec)
in (l2, AddedNode)
end
fun insLeaf (curIdx, newStr, newVec, oldStr, oldVec) =
if curIdx <= 0 then
preLeaf (oldStr, oldVec, newStr, newVec)
else if curIdx >= String.size oldStr then
appLeaf (oldStr, oldVec, newStr, newVec)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
val oldVecLen = Vector.length oldVec
val midPoint = binSearch (String.size sub1, oldVec, 0, oldVecLen)
val newVecLen = Vector.length newVec
in
if
isLessThanTarget (oldStr, newStr, oldVec, newVec)
then
let
val str = sub1 ^ newStr ^ sub2
val totalVecLen = Vector.length oldVec + Vector.length newVec
val vec = Vector.tabulate (totalVecLen, (fn idx =>
if idx < midPoint then
Vector.sub (oldVec, idx)
else if idx < midPoint + newVecLen then
Vector.sub (newVec, idx - midPoint)
else
Vector.sub (oldVec, idx - newVecLen)))
in
(N0 (str, vec), NoAction)
end
else if
curIdx + String.size newStr <= targetLength
andalso midPoint + newVecLen <= targetVecLength
then
let
val str1 = sub1 ^ newStr
val vec1 = Vector.tabulate (midPoint + newVecLen, (fn idx =>
if idx < midPoint then Vector.sub (oldVec, idx)
else Vector.sub (newVec, idx - midPoint)))
val vec2 = Vector.tabulate (oldVecLen - midPoint, (fn idx =>
Vector.sub (oldVec, idx + midPoint)))
val l2 = L2 (str1, vec1, sub2, vec2)
in
(l2, AddedNode)
end
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
andalso (midPoint - oldVecLen) + newVecLen <= targetVecLength
then
let
val str2 = newStr ^ sub2
val newStrLen = String.size newStr
val vec2 =
Vector.tabulate ((midPoint - oldVecLen) + newVecLen, (fn idx =>
if idx < newVecLen then Vector.sub (newVec, idx)
else Vector.sub (oldVec, idx - newVecLen) + newStrLen))
val vec1 = Vector.tabulate (midPoint, (fn idx =>
Vector.sub (oldVec, idx)))
val l2 = L2 (sub1, vec1, str2, vec2)
in
(l2, AddedNode)
end
else
let
val vec1 =
if oldVecLen = 0 then
emptyVec
else
Vector.tabulate (midPoint, (fn idx => Vector.sub (oldVec, idx)))
val vec2 =
if oldVecLen = 0 orelse midPoint >= oldVecLen then
emptyVec
else
Vector.tabulate (oldVecLen - midPoint, (fn idx =>
Vector.sub (oldVec, midPoint + idx)))
val left = N0 (sub1, vec1)
val right = N0 (sub2, vec2)
val mid = N0 (newStr, newVec)
in
(N3 (left, right, mid), AddedNode)
end
end
fun insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action) =
let
val lms = lms + String.size newStr
val lmv = lmv + Vector.length newVec
val node = N2 (l, lms, lmv, r)
in
(node, action)
end
fun insLessThanTarget (s1, s2, v1, v2) =
let
val str = s1 ^ s2
val s1Len = String.size s1
val v1Len = Vector.length v1
val v2Len = Vector.length v2
val vec = Vector.tabulate (v1Len + v2Len, (fn idx =>
if idx < v1Len then Vector.sub (v1, idx)
else Vector.sub (v2, idx - v1Len) + s1Len))
val node = N0 (str, vec)
in
(node, DeletedNode)
end
fun insBalL (l, lms, lmv, newStr, newVec, r, action) =
(case action of
NoAction =>
(case (l, r) of
(N0 (s1, v1), N0 (s2, v2)) =>
if isLessThanTarget (s1, s2, v1, v2) then
insLessThanTarget (s1, s2, v1, v2)
else
insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action)
| _ => insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action))
| AddedNode => (insN2Left (l, r), action)
| DeletedNode => (delN2Left (l, r), action))
fun insBalR (l, r, action) =
(case action of
NoAction =>
(case (l, r) of
(N0 (s1, v1), N0 (s2, v2)) =>
if isLessThanTarget (s1, s2, v1, v2) then
insLessThanTarget (s1, s2, v1, v2)
else
(makeN2 (l, r), action)
| _ => (makeN2 (l, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
fun ins (curIdx, newStr, newVec, rope) =
case rope of
N2 (l, lms, lmv, r) =>
if curIdx < lms then
let val (l, action) = ins (curIdx, newStr, newVec, l)
in insBalL (l, lms, lmv, newStr, newVec, r, action)
end
else
let val (r, action) = ins (curIdx - lms, newStr, newVec, r)
in insBalR (l, r, action)
end
| N1 t =>
let
val (t, action) = ins (curIdx, newStr, newVec, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 (oldStr, oldVec) => insLeaf (curIdx, newStr, newVec, oldStr, oldVec)
| _ => raise AuxConstructor
fun endInsert (rope, action) =
case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope
fun insert (index, str, rope) =
let
val newVec = countLineBreaks str
val (rope, action) = ins (index, str, newVec, rope)
in
endInsert (rope, action)
end
fun app (newStr, newVec, rope) =
case rope of
N2 (l, lms, lmv, r) =>
let val (r, action) = app (newStr, newVec, r)
in insBalR (l, r, action)
end
| N1 t => app (newStr, newVec, t)
| N0 (oldStr, oldVec) => appLeaf (oldStr, oldVec, newStr, newVec)
| _ => raise AuxConstructor
fun append (newStr, rope) =
let
val newVec = countLineBreaks newStr
val (rope, action) = app (newStr, newVec, rope)
in
endInsert (rope, action)
end
fun appendLine (newStr, newVec, rope) =
let val (rope, action) = app (newStr, newVec, rope)
in endInsert (rope, action)
end
fun isDelLessThanTarget (str1, str2, vec, startPoint, endPoint) =
let
val vecLength = Vector.length vec - (endPoint - startPoint)
in
String.size str1 + String.size str2 <= targetLength
andalso vecLength <= targetVecLength
end
fun delLeaf (startIdx, endIdx, str, vec) =
if
startIdx <= 0 andalso endIdx >= String.size str
then
(empty, false)
else if
startIdx > 0 andalso endIdx < String.size str
then
let
val sub1 = String.substring (str, 0, startIdx)
val sub2 = String.substring (str, endIdx, (String.size str - endIdx))
val vecLength = Vector.length vec - 1
val startPoint = binSearch (startIdx, vec, 0, vecLength)
val endPoint = binSearch (endIdx, vec, 0, vecLength)
val difference = endIdx - startIdx
in
if isDelLessThanTarget (sub1, sub2, vec, startPoint, endPoint) then
let
val str = sub1 ^ sub2
val vecDifference = endPoint - startPoint
val vecLength = Vector.length vec - vecDifference
val vec = Vector.tabulate (vecLength, (fn idx =>
let val point = Vector.sub (vec, idx)
in if point < startIdx then point else point - difference
end))
in
(N0 (str, vec), false)
end
else
let
val vec1 =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (startPoint, (fn idx => Vector.sub (vec, idx)))
val vec2 =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (Vector.length vec - startPoint, (fn idx =>
Vector.sub (vec, idx + startPoint) - difference))
in
(L2 (sub1, vec1, sub2, vec2), true)
end
end
else if
startIdx >= 0 andalso startIdx <= String.size str
andalso endIdx >= String.size str
then
let
val str = String.substring (str, 0, startIdx)
val midPoint = binSearch (startIdx, vec, 0, Vector.length vec - 1)
val vec =
if Vector.length vec = 0 then emptyVec
else Vector.tabulate (midPoint, fn idx => Vector.sub (vec, idx))
in
(N0 (str, vec), false)
end
else
let
val str = String.substring (str, endIdx, String.size str - endIdx)
val midPoint = binSearch (endIdx, vec, 0, Vector.length vec - 1)
val vec =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (Vector.length vec - midPoint, fn idx =>
Vector.sub (vec, idx + midPoint))
in
(N0 (str, vec), false)
end
fun del (startIdx, endIdx, rope) =
case rope of
N2 (l, lms, lmv, r) =>
if lms > startIdx andalso lms > endIdx then
let
val (l, didIns) = del (startIdx, endIdx, l)
val rope = if didIns then insN2Left (l, r) else makeN2 (l, r)
in
(rope, didIns)
end
else if lms < startIdx andalso lms < endIdx then
let
val (r, didIns) = del (startIdx - lms, endIdx - lms, r)
val rope = if didIns then insN2Right (l, r) else makeN2 (l, r)
in
(rope, didIns)
end
else
let
val (l, _) = del (startIdx, endIdx, l)
val (r, _) = del (startIdx - lms, endIdx - lms, r)
in
(makeN2 (l, r), false)
end
| N1 t => del (startIdx, endIdx, t)
| N0 (str, vec) => delLeaf (startIdx, endIdx, str, vec)
| _ => raise AuxConstructor
fun delete (start, length, rope) =
let val (rope, didIns) = del (start, start + length, rope)
in if didIns then insRoot rope else rope
end
fun foldStringChars (apply, term, pos, str, strSize, acc) =
if pos < strSize then
if term acc then
acc
else
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldStringChars (apply, term, pos + 1, str, strSize, acc)
end
else
acc
fun foldFromIdxTerm (apply, term, idx, rope, acc) =
case rope of
N2 (l, lm, _, r) =>
if idx < lm then
let
val acc = foldFromIdxTerm (apply, term, idx, l, acc)
in
if term acc then acc
else foldFromIdxTerm (apply, term, idx - lm, r, acc)
end
else
foldFromIdxTerm (apply, term, idx - lm, r, acc)
| N1 t => foldFromIdxTerm (apply, term, idx, t, acc)
| N0 (str, _) =>
foldStringChars (apply, term, idx, str, String.size str, acc)
| _ => raise AuxConstructor
fun noTerm _ = false
fun foldFromIdx (apply, idx, rope, acc) =
foldFromIdxTerm (apply, noTerm, idx, rope, acc)
fun foldLineCharsTerm (apply, term, pos, str, strSize, acc) =
if pos < strSize then
case term acc of
false =>
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldLineCharsTerm (apply, term, pos + 1, str, strSize, acc)
end
| true => acc
else
acc
fun helpFoldLines (apply, term, lineNum, rope, acc) =
case rope of
N2 (l, _, lmv, r) =>
if lineNum < lmv then
let
val acc = helpFoldLines (apply, term, lineNum, rope, acc)
in
if term acc then acc
else helpFoldLines (apply, term, lineNum - lmv, r, acc)
end
else
helpFoldLines (apply, term, lineNum - lmv, r, acc)
| N1 t => helpFoldLines (apply, term, lineNum, t, acc)
| N0 (str, vec) =>
(* We have a few edge cases to handle here.
* 1. If lineNum is 0 or the vector has no elements,
* we should start folding from the start of the string.
* 2. Since the vector points to the start of a linebreak
* (which means either \r or \n when either is alone,
* or \r in a \r\n pair),
* we have to skip the linebreak or linebreak pair when folding
* over the string. That is more intuitive to the user. *)
if lineNum < 0 orelse Vector.length vec = 0 then
foldLineCharsTerm (apply, term, 0, str, String.size str, acc)
else
let
val idx = Vector.sub (vec, lineNum)
in
if idx + 1 < String.size str then
let
val chr = String.sub (str, idx)
val nextChr = String.sub (str, idx + 1)
in
if chr = #"\r" andalso nextChr = #"\n" then
foldLineCharsTerm
(apply, term, idx + 2, str, String.size str, acc)
else
foldLineCharsTerm
(apply, term, idx + 1, str, String.size str, acc)
end
else
acc
end
| _ => raise AuxConstructor
fun foldLines (apply, term, lineNum, rope, acc) =
helpFoldLines (apply, term, lineNum - 1, rope, acc)
fun verifyLines rope =
foldr
( (fn (_, str, vec) =>
let
val strVec = countLineBreaks str
val isSame = strVec = vec
in
if isSame then true else raise Empty
end)
, true
, rope
)
end

176
brolib-sml/src/rrb_rope.sml Normal file
View File

@@ -0,0 +1,176 @@
structure RrbRope =
struct
val bits: Word.word = 0w5
val width: Word.word = 0w32
val mask: Word.word = 0w31
datatype tree = BRANCH of tree vector | LEAF of int vector
type t = {root: tree, shift: word, count: int}
val empty: t = {root = LEAF (Vector.fromList []), shift = 0w0, count = 0}
fun tailoff count =
if count < 32 then
0w0
else
let
val w = Word.fromInt (count - 1)
val w = Word.>> (w, bits)
in
Word.<< (w, bits)
end
datatype append_result = UPDATE | APPEND
fun helpAppend (item, tree) =
case tree of
BRANCH n =>
let
val lastNode = Vector.sub (n, Vector.length n - 1)
in
case helpAppend (item, lastNode) of
(UPDATE, newLast, newDepth) =>
let val n = Vector.update (n, Vector.length n - 1, newLast)
in (UPDATE, BRANCH n, newDepth + 1)
end
| (APPEND, newNode, newDepth) =>
if Vector.length n = 32 then
let val hewNode = BRANCH (Vector.fromList [newNode])
in (APPEND, newNode, newDepth + 1)
end
else
let val n = Vector.concat [n, Vector.fromList [newNode]]
in (UPDATE, BRANCH n, newDepth + 1)
end
end
| LEAF items =>
if Vector.length items = 32 then
let val appendLeaf = LEAF (Vector.fromList [item])
in (APPEND, appendLeaf, 0)
end
else
let val newLeaf = Vector.concat [items, Vector.fromList [item]]
in (UPDATE, LEAF newLeaf, 0)
end
fun append (item, {shift, root, count}: t) =
case helpAppend (item, root) of
(UPDATE, updatedTree, newDepth) =>
{ count = count + 1
, root = updatedTree
, shift = let val w = Word.fromInt newDepth in w * bits end
}
| (APPEND, newLast, newDepth) =>
let
val root = BRANCH (Vector.fromList [root, newLast])
val w = Word.fromInt newDepth
val shift = w * bits
in
{count = count + 1, root = root, shift = shift}
end
fun getLast tree =
case tree of
BRANCH n => getLast (Vector.sub (n, Vector.length n - 1))
| LEAF i => Vector.sub (i, Vector.length i - 1)
fun helpGet (key: Word.word, level, tree) =
case tree of
BRANCH nodes =>
let
val w = Word.>> (key, level)
val w = Word.andb (w, mask)
val node = Vector.sub (nodes, Word.toInt w)
in
helpGet (key, level - bits, node)
end
| LEAF items =>
let val idx = Word.andb (key, mask)
in Vector.sub (items, Word.toInt idx)
end
fun get (key, {shift, root, count}: t) =
let val key = Word.fromInt key
in if key >= tailoff count then getLast root else helpGet (key, shift, root)
end
fun splitKeepingLeft (idx, level, tree) =
case tree of
BRANCH nodes =>
let
val w = Word.>> (idx, level)
val w = Word.andb (w, mask)
val nodeIdx = Word.toInt w
val node = Vector.sub (nodes, nodeIdx)
val newNode = splitKeepingLeft (idx, level - bits, node)
val newNode = Vector.fromList [newNode]
val newNode = VectorSlice.full newNode
val newNodes = VectorSlice.slice (nodes, 0, SOME nodeIdx)
val newNodes = VectorSlice.concat [newNodes, newNode]
in
BRANCH newNodes
end
| LEAF items =>
let
val w = Word.andb (idx, mask)
val idx = Word.toInt w
val items = VectorSlice.slice (items, 0, SOME idx)
val items = VectorSlice.vector items
in
LEAF items
end
fun splitKeepingRight (idx, level, tree) =
case tree of
BRANCH nodes =>
let
val w = Word.>> (idx, level)
val w = Word.andb (w, mask)
val nodeIdx = Word.toInt w
val node = Vector.sub (nodes, nodeIdx)
val newNode = splitKeepingRight (idx, level - bits, node)
val newNode = Vector.fromList [newNode]
val newNode = VectorSlice.full newNode
val newNodes = VectorSlice.slice (nodes, nodeIdx, NONE)
val newNodes = VectorSlice.concat [newNode, newNodes]
in
BRANCH newNodes
end
| LEAF items =>
let
val w = Word.andb (idx, mask)
val idx = Word.toInt w
val items = VectorSlice.slice (items, idx, NONE)
val items = VectorSlice.vector items
in
LEAF items
end
fun replaceStartLeaf (newStart, tree) =
case tree of
BRANCH nodes =>
let
val startNode = replaceStartLeaf (newStart, Vector.sub (nodes, 0))
val nodes = Vector.update (nodes, 0, startNode)
in
BRANCH nodes
end
| LEAF _ => LEAF newStart
fun replaceEndLeaf (newEnd, tree) =
case tree of
BRANCH nodes =>
let
val endNode = Vector.sub (nodes, Vector.length nodes - 1)
val endNode = replaceEndLeaf (newEnd, endNode)
val nodes = Vector.update (nodes, Vector.length nodes - 1, endNode)
in
BRANCH endNode
end
| LEAF _ => LEAF newEnd
end

393
brolib-sml/src/tiny_rope.sml Normal file
View File

@@ -0,0 +1,393 @@
signature TINY_ROPE =
sig
type t
val empty: t
val fromString: string -> t
val size: t -> int
val insert: int * string * t -> t
val append: string * t -> t
val delete: int * int * t -> t
val toString: t -> string
val foldFromIdxTerm: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
val foldFromIdx: (char * 'a -> 'a) * int * t * 'a -> 'a
end
structure TinyRope :> TINY_ROPE =
struct
datatype t =
N0 of string
| N1 of t
| N2 of t * int * t
| L2 of string * string
| N3 of t * t * t
exception AuxConstructor
fun foldr (f, state, rope) =
case rope of
N2 (l, _, r) =>
let val state = foldr (f, state, r)
in foldr (f, state, l)
end
| N1 t => foldr (f, state, t)
| N0 s => f (state, s)
| _ => raise AuxConstructor
local
fun toListFolder (acc, str) = str :: acc
fun toList rope = foldr (toListFolder, [], rope)
in
fun toString rope =
let val lst = toList rope
in String.concat lst
end
end
datatype balance = AddedNode | DeletedNode | NoAction
val targetLength = 1024
val empty = N0 ""
fun fromString string = N0 string
fun isLessThanTarget (str1, str2) =
String.size str1 + String.size str2 <= targetLength
fun helpSize (acc, rope) =
case rope of
N0 s => acc + String.size s
| N1 t => helpSize (acc, t)
| N2 (_, lm, r) => helpSize (acc + lm, r)
| _ => raise AuxConstructor
fun size rope = helpSize (0, rope)
fun insRoot rope =
case rope of
L2 (s1, s2) => N2 (N0 s1, String.size s1, N0 s2)
| N3 (t1, t2, t3) =>
let val left = N2 (t1, size t1, t2)
in N2 (left, size left, N1 t3)
end
| t => t
fun delRoot rope =
case rope of
N1 t => t
| t => t
fun insN1 rope =
case rope of
L2 (s1, s2) => N2 (N0 s1, String.size s1, N0 s2)
| N3 (t1, t2, t3) =>
let val left = N2 (t1, size t1, t2)
in N2 (left, size left, N1 t3)
end
| t => N1 t
fun insN2Left (left, right) =
case (left, right) of
(L2 (s1, s2), t3) => N3 (N0 s1, N0 s2, t3)
| (N3 (t1, t2, t3), N1 t4) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
in
N2 (left, size left, right)
end
| (N3 (t1, t2, t3), t4) =>
let val left = N2 (t1, size t1, t2)
in N3 (left, N1 t3, t4)
end
| (l, r) => N2 (l, size l, r)
fun delN2Left (left, right) =
case (left, right) of
(N1 t1, N1 t2) => N1 (N2 (t1, size t1, t2))
| (N1 (N1 t1), N2 (N1 t2, _, (t3 as N2 _))) =>
let
val left = N2 (t1, size t1, t2)
val inner = N2 (left, size left, t3)
in
N1 inner
end
| (N1 (N1 t1), N2 (N2 (t2, _, t3), _, N1 t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
val inner = N2 (left, size left, right)
in
N1 inner
end
| (N1 (t1 as N1 _), N2 ((t2 as N2 _), _, (t3 as N2 _))) =>
let
val left = N2 (t1, size t1, t2)
val right = N1 t3
in
N2 (left, size left, right)
end
| (l, r) => N2 (l, size l, r)
fun insN2Right (left, right) =
case (left, right) of
(t1, L2 (s1, s2)) => N3 (t1, N0 s1, N0 s2)
| (N1 t1, N3 (t2, t3, t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
in
N2 (left, size left, right)
end
| (t1, N3 (t2, t3, t4)) =>
let val right = N2 (t3, size t3, t4)
in N3 (t1, N1 t2, right)
end
| (l, r) => N2 (l, size l, r)
fun delN2Right (left, right) =
case (left, right) of
(N2 (N1 t1, _, N2 (t2, _, t3)), N1 (N1 t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
val inner = N2 (left, size left, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), lm, N1 t2), N1 (N1 t3)) =>
let
val right = N2 (t2, size t2, t3)
val inner = N2 (t1, lm, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), _, (t2 as N2 _)), N1 (t3 as N1 _)) =>
let
val left = N1 t1
val right = N2 (t2, size t2, t3)
in
N2 (left, size left, right)
end
| (l, r) => N2 (l, size l, r)
fun insLeaf (curIdx, newStr, rope, oldStr) =
if curIdx <= 0 then
if isLessThanTarget (oldStr, newStr) then (N0 (newStr ^ oldStr), NoAction)
else (L2 (newStr, oldStr), AddedNode)
else if curIdx >= String.size oldStr then
if isLessThanTarget (oldStr, newStr) then (N0 (oldStr ^ newStr), NoAction)
else (L2 (oldStr, newStr), AddedNode)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
in
if
isLessThanTarget (oldStr, newStr)
then
(N0 (sub1 ^ newStr ^ sub2), NoAction)
else if
curIdx + String.size newStr <= targetLength
then
(L2 (sub1 ^ newStr, sub2), AddedNode)
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
then
(L2 (sub1, newStr ^ sub2), AddedNode)
else
(N3 (N0 sub1, N0 newStr, N0 sub2), AddedNode)
end
fun ins (curIdx, newStr, rope) =
case rope of
N2 (l, lm, r) =>
if curIdx < lm then
let
val (l, action) = ins (curIdx, newStr, l)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm + String.size newStr, r), action)
| _ => (N2 (l, lm + String.size newStr, r), action))
| AddedNode => (insN2Left (l, r), action)
| DeletedNode => (delN2Left (l, r), action))
end
else
let
val (r, action) = ins (curIdx - lm, newStr, r)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm, r), action)
| _ => (N2 (l, lm, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
end
| N1 t =>
let
val (t, action) = ins (curIdx, newStr, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 oldStr => insLeaf (curIdx, newStr, rope, oldStr)
| _ => raise AuxConstructor
fun insert (index, str, rope) =
let
val (rope, action) = ins (index, str, rope)
in
(case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope)
end
fun app (newStr, rope) =
case rope of
N2 (l, lm, r) =>
let
val (r, action) = app (newStr, r)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm, r), action)
| _ => (N2 (l, lm, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
end
| N1 t =>
let
val (t, action) = app (newStr, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 oldStr =>
if isLessThanTarget (oldStr, newStr) then
(N0 (oldStr ^ newStr), NoAction)
else
(L2 (oldStr, newStr), AddedNode)
| _ => raise AuxConstructor
fun append (str, rope) =
let
val (rope, action) = app (str, rope)
in
(case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope)
end
fun delLeaf (startIdx, endIdx, str) =
if startIdx <= 0 andalso endIdx >= String.size str then
(empty, false)
else if startIdx >= 0 andalso endIdx <= String.size str then
let
val sub1 = String.substring (str, 0, startIdx)
val sub2 = String.substring (str, endIdx, (String.size str - endIdx))
in
if isLessThanTarget (sub1, sub2) then (N0 (sub1 ^ sub2), false)
else (L2 (sub1, sub2), true)
end
else if startIdx >= 0 andalso endIdx >= String.size str then
let val str = String.substring (str, 0, startIdx)
in (N0 str, false)
end
else
let val str = String.substring (str, endIdx, String.size str - endIdx)
in (N0 str, false)
end
fun del (startIdx, endIdx, rope) =
case rope of
N2 (l, lm, r) =>
if lm > startIdx andalso lm > endIdx then
let
val (l, didAdd) = del (startIdx, endIdx, l)
in
if didAdd then (insN2Left (l, r), didAdd)
else (N2 (l, size l, r), didAdd)
end
else if lm < startIdx andalso lm < endIdx then
let
val (r, didAdd) = del (startIdx - lm, endIdx - lm, r)
in
if didAdd then (insN2Right (l, r), didAdd)
else (N2 (l, lm, r), didAdd)
end
else
let
val (r, didAddR) = del (startIdx - lm, endIdx - lm, r)
val (l, didaddL) = del (startIdx, endIdx, l)
in
if didaddL then (insN2Left (l, r), didaddL)
else if didAddR then (insN2Right (l, r), didAddR)
else (N2 (l, size l, r), false)
end
| N1 t =>
let val (t, didAdd) = del (startIdx, endIdx, t)
in if didAdd then (insN1 t, didAdd) else (N1 t, didAdd)
end
| N0 str => delLeaf (startIdx, endIdx, str)
| _ => raise AuxConstructor
fun delete (start, length, rope) =
let val (rope, didAdd) = del (start, start + length, rope)
in if didAdd then insRoot rope else delRoot rope
end
fun foldStringChars (apply, term, pos, str, strSize, acc) =
if pos < strSize then
case term acc of
false =>
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldStringChars (apply, term, pos + 1, str, strSize, acc)
end
| true => acc
else
acc
fun foldFromIdxTerm (apply, term, idx, rope, acc) =
case rope of
N2 (l, lm, r) =>
if idx < lm then
let
val acc = foldFromIdxTerm (apply, term, idx, l, acc)
in
if term acc then acc
else foldFromIdxTerm (apply, term, idx - lm, r, acc)
end
else
foldFromIdxTerm (apply, term, idx - lm, r, acc)
| N1 t => foldFromIdxTerm (apply, term, idx, t, acc)
| N0 str => foldStringChars (apply, term, idx, str, String.size str, acc)
| _ => raise AuxConstructor
fun noTerm _ = false
fun foldFromIdx (apply, idx, rope, acc) =
foldFromIdxTerm (apply, noTerm, idx, rope, acc)
end

283
brolib-sml/src/tiny_rope23.sml Normal file
View File

@@ -0,0 +1,283 @@
structure TinyRope23 =
struct
(* Type of ropes. *)
datatype t =
Leaf of string
| N2 of t * int * t * int
| N3 of t * int * t * int * t * int
fun foldl f state rope =
case rope of
Leaf str => f (str, state)
| N2 (l, _, r, _) => let val state = foldl f state l in foldl f state r end
| N3 (l, _, m, _, r, _) =>
let
val state = foldl f state l
val state = foldl f state m
in
foldl f state r
end
fun foldr f state rope =
case rope of
Leaf str => f (str, state)
| N2 (l, _, r, _) => let val state = foldr f state r in foldr f state l end
| N3 (l, _, m, _, r, _) =>
let
val state = foldr f state r
val state = foldr f state m
in
foldr f state l
end
local
fun toListFolder (str, lst) = str :: lst
fun toList rope =
foldr toListFolder [] rope
in
fun toString rope =
let val lst = toList rope
in String.concat lst
end
end
(* Type used for balancing ropes, used only internally. *)
datatype treeI =
TI of t * int
| OF of t * int * t * int
val targetLength = 1024
val empty = Leaf ""
fun fromString string = Leaf string
fun size rope =
case rope of
Leaf str => String.size str
| N2 (_, lm, _, rm) => rm + rm
| N3 (_, lm, _, mm, _, rm) => lm + mm + rm
fun isLessThanTarget (str1, str2) =
String.size str1 + String.size str2 <= targetLength
fun insLeaf (curIdx, newStr, oldStr) =
if curIdx <= 0 then
if isLessThanTarget (oldStr, newStr) then
let val str = newStr ^ oldStr
in TI (Leaf str, String.size str)
end
else
OF (Leaf newStr, String.size newStr, Leaf oldStr, String.size oldStr)
else if curIdx >= String.size oldStr then
if isLessThanTarget (oldStr, newStr) then
let val str = oldStr ^ newStr
in TI (Leaf str, String.size str)
end
else
OF (Leaf oldStr, String.size oldStr, Leaf newStr, String.size newStr)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
in
if
isLessThanTarget (oldStr, newStr)
then
let val str = sub1 ^ newStr ^ sub2
in TI (Leaf str, String.size str)
end
else if
curIdx + String.size newStr <= targetLength
then
let
val leftString = sub1 ^ newStr
in
OF
( Leaf leftString
, String.size leftString
, Leaf sub2
, String.size sub2
)
end
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
then
let
val rightString = newStr ^ sub2
in
OF
( Leaf sub1
, String.size sub1
, Leaf rightString
, String.size rightString
)
end
else
let
val left =
N2 (Leaf sub1, String.size sub1, Leaf newStr, String.size newStr)
val leftSize = String.size sub1 + String.size newStr
val right = N2 (Leaf sub2, String.size sub2, empty, 0)
val rightSize = String.size sub2
in
OF (left, leftSize, right, rightSize)
end
end
fun ins (curIdx, newStr, rope) =
case rope of
N2 (l, lm, r, rm) =>
if curIdx < lm then
(case ins (curIdx, newStr, l) of
TI (l, lm) => TI (N2 (l, lm, r, rm), lm + rm)
| OF (l1, lm1, l2, lm2) =>
TI (N3 (l1, lm1, l2, lm2, r, rm), lm1 + lm2 + rm))
else
(case (ins (curIdx - lm, newStr, r)) of
TI (r, rm) => TI (N2 (l, lm, r, rm), lm + rm)
| OF (r1, rm1, r2, rm2) =>
TI (N3 (l, lm, r1, rm1, r2, rm2), lm + rm1 + rm2))
| N3 (l, lm, m, mm, r, rm) =>
(*
* Ropes don't usually have N3 nodes so the way we accomodate this is:
* If current index is less than left metadata, use same strategy as
* recursing to the left as N2 nodes.
* Else if current index is less than (left + middle) metadata,
* recurse to middle node while subtracting left metadata.
* Else, recurse to right node while subtracting (left metadata +
* middle metadata).
* This simulates the mathematical operations that would take place
* for the following rope:
* (l, lm)
* / \
* (..., ...) (m, mm, r, rm)
*)
if curIdx < lm then
(case ins (curIdx, newStr, l) of
TI (l, lm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (l1, lm1, l2, lm2) =>
OF (N2 (l1, lm1, l2, lm2), lm1 + lm2, N2 (m, mm, r, rm), mm + rm))
else if curIdx < (lm + mm) then
(case ins (curIdx - lm, newStr, m) of
TI (m, mm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (m1, mm1, m2, mm2) =>
OF (N2 (l, lm, m1, mm1), lm + mm1, N2 (m2, mm2, r, rm), mm2 + rm))
else
(case ins (curIdx - (lm + mm), newStr, r) of
TI (r, rm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (r1, rm1, r2, rm2) =>
OF (N2 (l, lm, m, mm), lm + mm, N2 (r1, rm1, r2, rm2), rm1 + rm2))
| Leaf oldStr => insLeaf (curIdx, newStr, oldStr)
fun insRoot (TI (t, _)) = t
| insRoot (OF (l, lm, r, rm)) = N2 (l, lm, r, rm)
fun insert (idx, newStr, rope) =
insRoot (ins (idx, newStr, rope))
datatype treeD = TD of t | UF of t
exception RopeDeleteError
fun node21 (TD t1, t2) =
let val tree = N2 (t1, size t1, t2, size t2)
in TD (tree)
end
| node21 (UF t1, N2 (t2, t2m, t3, t3m)) =
let val tree = N3 (t1, size t1, t2, t2m, t3, t3m)
in UF (tree)
end
| node21 (UF t1, N3 (t2, t2m, t3, t3m, t4, t4m)) =
let
val t1m = size t1
val left = N2 (t1, t1m, t2, t2m)
val right = N2 (t3, t3m, t4, t4m)
val tree = N2 (left, t1m + t2m, right, t3m + t4m)
in
TD (tree)
end
| node21 _ = raise RopeDeleteError
fun node22 (t1, t1m, TD t2) =
TD (N2 (t1, t1m, t2, size t2))
| node22 (N2 (t1, t1m, t2, t2m), _, UF t3) =
UF (N3 (t1, t1m, t2, t2m, t3, size t3))
| node22 (N3 (t1, t1m, t2, t2m, t3, t3m), _, UF t4) =
let
val t4m = size t4
in
TD (N2
(N2 (t1, t1m, t2, t2m), t1m + t2m, N2 (t3, t3m, t4, t4m), t3m + t4m))
end
| node22 _ = raise RopeDeleteError
fun node31 (TD t1, t2, t2m, t3, t3m) =
TD (N3 (t1, size t1, t2, t2m, t3, t3m))
| node31 (UF t1, N2 (t2, t2m, t3, t3m), _, t4, t4m) =
let
val t1m = size t1
val left = N3 (t1, t1m, t2, t2m, t3, t3m)
val leftSize = t1m + t2m + t3m
val inner = N2 (left, leftSize, t4, t4m)
in
TD inner
end
| node31 (UF t1, N3 (t2, t2m, t3, t3m, t4, t4m), _, t5, t5m) =
let
val t1m = size t1
val left = N2 (t1, t1m, t2, t2m)
val leftSize = t1m + t2m
val middle = N2 (t3, t3m, t4, t4m)
val middleSize = t3m + t4m
val inner = N3 (left, leftSize, middle, middleSize, t5, t5m)
in
TD inner
end
| node31 _ = raise RopeDeleteError
fun node32 (t1, t1m, TD t2, t3) =
TD (N3 (t1, t1m, t2, size t2, t3, size t3))
| node32 (t1, t1m, UF t2, N2 (t3, t3m, t4, t4m)) =
let
val t2m = size t2
val right = N3 (t2, t2m, t3, t3m, t4, t4m)
val inner = N2 (t1, t1m, right, t2m + t3m + t4m)
in
TD inner
end
| node32 (t1, t1m, UF t2, N3 (t3, t3m, t4, t4m, t5, t5m)) =
let
val t2m = size t2
val mid = N2 (t2, t2m, t3, t3m)
val right = N2 (t4, t4m, t5, t5m)
val inner = N3 (t1, t1m, mid, t2m + t3m, right, t4m + t5m)
in
TD inner
end
| node32 _ = raise RopeDeleteError
fun node33 (t1, t1m, t2, t2m, TD t3) =
TD (N3 (t1, t1m, t2, t2m, t3, size t3))
| node33 (t1, t1m, N2 (t2, t2m, t3, t3m), _, UF t4) =
let val t4m = size t4
in TD (N2 (t1, t1m, N3 (t2, t2m, t3, t3m, t4, t4m), t2m + t3m + t4m))
end
| node33 (t1, t1m, N3 (t2, t2m, t3, t3m, t4, t4m), _, UF t5) =
let
val t5m = size t4
in
TD (N3
( t1
, t1m
, N2 (t2, t2m, t3, t3m)
, t2m + t3m
, N2 (t4, t4m, t5, t5m)
, t4m + t5m
))
end
| node33 _ = raise RopeDeleteError
end

18
brolib-sml/tests/compare.mlb Normal file
View File

@@ -0,0 +1,18 @@
$(SML_LIB)/basis/basis.mlb
ann
"allowVectorExps true"
in
../data-sets/svelte.sml
(* other datasets commented out
* because they didn't detect any issues
* and give much longer compile times
../data-sets/rust.sml
../data-sets/seph.sml
../data-sets/automerge.sml
*)
end
../src/tiny_rope.sml
../src/line_gap.sml
compare_to_rope.sml

90
brolib-sml/tests/compare_to_rope.sml Normal file
View File

@@ -0,0 +1,90 @@
structure CompareToRope =
struct
fun compareTxns arr =
Vector.foldli
(fn (idx, (pos, delNum, insStr), (rope, gapBuffer)) =>
let
val _ = print ("txn number: " ^ Int.toString idx ^ "\n")
val oldRope = rope
val strSize = String.size insStr
val rope =
if delNum > 0 then TinyRope.delete (pos, delNum, rope) else rope
val rope =
if strSize > 0 then TinyRope.insert (pos, insStr, rope) else rope
val gapBuffer =
if delNum > 0 then LineGap.delete (pos, delNum, gapBuffer)
else gapBuffer
val _ = LineGap.verifyIndex gapBuffer
val _ = LineGap.verifyLines gapBuffer
val gapBuffer =
if strSize > 0 then LineGap.insert (pos, insStr, gapBuffer)
else gapBuffer
val _ = LineGap.verifyIndex gapBuffer
val _ = LineGap.verifyLines gapBuffer
val ropeString = TinyRope.toString rope
val gapBufferString = LineGap.toString gapBuffer
in
if ropeString = gapBufferString then
(rope, gapBuffer)
else
let
val _ = print
("difference detected at txn number: " ^ (Int.toString idx)
^ "\n")
val txn = String.concat
[ "offending txn: \n"
, "pos: "
, Int.toString pos
, ", delNum: "
, Int.toString delNum
, ", insStr: |"
, insStr
, "|\n"
]
val _ = print txn
val _ = print "before offending string: \n"
val _ = print (TinyRope.toString oldRope)
val _ = print "\n"
val _ = print "rope string: \n"
val _ = print (ropeString ^ "\n")
val _ = print "gap string: \n"
val _ = print (gapBufferString ^ "\n")
val _ = raise Empty
in
(rope, gapBuffer)
end
end) (TinyRope.empty, LineGap.empty) arr
fun main () =
let
val _ = compareTxns SvelteComponent.txns
val _ = print "string contents and line metadata are equal for svelte\n"
(* compile times are much longer with the other datasets included
* but running those datasets did not detect any issues after
* all issues were fixed with Svelte.
* So comment these datasets out.
val _ = compareTxns RustCode.txns
val _ = print "string contents and line metadata are equal for rust\n"
val _ = compareTxns SephBlog.txns
val _ = print "string contents and line metadata equal for seh"
val _ = compareTxns AutomergePaper.txns
val _ = print "string contents and line metadata equal for automerge"
*)
in
()
end
val _ = main ()
end