File size: 9,745 Bytes
ffc07fb | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | ! Layer 3 β Sovereign IDE Text Buffer (Rope + Undo Tree)
! O(log n) insert/delete, persistent undo tree
! Maps to: errant QTT tags, sovereign-array Lean 4 proofs
MODULE sovereign_text_buffer
USE iso_c_binding
USE sovereign_runtime, ONLY: runtime_panic, arena_alloc
IMPLICIT NONE
PRIVATE
! ββ Rope node kinds ββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
INTEGER, PARAMETER :: NODE_LEAF = 0
INTEGER, PARAMETER :: NODE_BRANCH = 1
INTEGER, PARAMETER :: MAX_NODES = 1048576 ! 1M nodes per buffer
INTEGER, PARAMETER :: LEAF_MAX = 1024 ! max chars in a leaf
! ββ Rope node βββββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
! QTT tag from errant: provenance token for LSP change tracking
TYPE :: rope_node_t
INTEGER :: kind = NODE_LEAF
INTEGER :: length = 0
INTEGER :: lines = 0 ! newline count in subtree
INTEGER :: left = 0 ! index into node pool (0 = nil)
INTEGER :: right = 0
INTEGER :: qtt_tag = 0 ! errant provenance tag
CHARACTER(LEN=LEAF_MAX) :: text = '' ! only valid for LEAF
END TYPE rope_node_t
! ββ Undo tree node ββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
INTEGER, PARAMETER :: MAX_UNDO = 65536
TYPE :: undo_node_t
INTEGER :: parent = 0 ! 0 = root
INTEGER :: rope_root = 0 ! index of rope root at this snapshot
INTEGER :: timestamp = 0
INTEGER :: cursor_pos = 0
END TYPE undo_node_t
! ββ Buffer state ββββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
TYPE :: text_buffer_t
TYPE(rope_node_t) :: nodes(MAX_NODES)
INTEGER :: node_count = 0
INTEGER :: root = 0
TYPE(undo_node_t) :: undo(MAX_UNDO)
INTEGER :: undo_count = 0
INTEGER :: undo_head = 0
END TYPE text_buffer_t
PUBLIC :: buffer_init
PUBLIC :: buffer_insert
PUBLIC :: buffer_delete
PUBLIC :: buffer_slice
PUBLIC :: buffer_length
PUBLIC :: buffer_line_count
PUBLIC :: buffer_offset_to_line_col
PUBLIC :: buffer_undo
PUBLIC :: buffer_redo
CONTAINS
! ---------------------------------------------------------------------------
SUBROUTINE buffer_init(buf, initial_text)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: initial_text
buf%node_count = 0
buf%undo_count = 0
buf%undo_head = 0
IF (PRESENT(initial_text)) THEN
buf%root = make_leaf(buf, initial_text)
ELSE
buf%root = make_leaf(buf, '')
END IF
END SUBROUTINE buffer_init
! ---------------------------------------------------------------------------
! Insert text at byte offset; O(log n)
SUBROUTINE buffer_insert(buf, offset, text)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
INTEGER, INTENT(IN) :: offset
CHARACTER(LEN=*), INTENT(IN) :: text
INTEGER :: left_root, right_root, text_node
! Split at offset, concat with new leaf, concat remainder
CALL rope_split(buf, buf%root, offset, left_root, right_root)
text_node = make_leaf(buf, text)
buf%root = rope_concat(buf, rope_concat(buf, left_root, text_node), right_root)
CALL push_undo(buf, offset + LEN_TRIM(text))
END SUBROUTINE buffer_insert
! ---------------------------------------------------------------------------
! Delete [offset, offset+length); O(log n)
SUBROUTINE buffer_delete(buf, offset, length)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
INTEGER, INTENT(IN) :: offset, length
INTEGER :: l, m, r
CALL rope_split(buf, buf%root, offset, l, m)
CALL rope_split(buf, m, length, m, r)
buf%root = rope_concat(buf, l, r) ! discard m (deleted region)
CALL push_undo(buf, offset)
END SUBROUTINE buffer_delete
! ---------------------------------------------------------------------------
FUNCTION buffer_length(buf) RESULT(n)
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER :: n
IF (buf%root == 0) THEN; n = 0; RETURN; END IF
n = buf%nodes(buf%root)%length
END FUNCTION buffer_length
! ---------------------------------------------------------------------------
FUNCTION buffer_line_count(buf) RESULT(n)
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER :: n
IF (buf%root == 0) THEN; n = 1; RETURN; END IF
n = buf%nodes(buf%root)%lines + 1
END FUNCTION buffer_line_count
! ---------------------------------------------------------------------------
SUBROUTINE buffer_slice(buf, offset, length, out_text)
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER, INTENT(IN) :: offset, length
CHARACTER(LEN=*), INTENT(OUT) :: out_text
out_text = ''
! TODO: rope traversal collecting chars in [offset, offset+length)
END SUBROUTINE buffer_slice
! ---------------------------------------------------------------------------
SUBROUTINE buffer_offset_to_line_col(buf, offset, line, col)
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER, INTENT(IN) :: offset
INTEGER, INTENT(OUT) :: line, col
line = 1; col = 1
! TODO: O(log n) line index traversal
END SUBROUTINE buffer_offset_to_line_col
! ---------------------------------------------------------------------------
SUBROUTINE buffer_undo(buf)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
IF (buf%undo_head <= 1) RETURN
buf%undo_head = buf%undo_head - 1
buf%root = buf%undo(buf%undo_head)%rope_root
END SUBROUTINE buffer_undo
SUBROUTINE buffer_redo(buf)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
IF (buf%undo_head >= buf%undo_count) RETURN
buf%undo_head = buf%undo_head + 1
buf%root = buf%undo(buf%undo_head)%rope_root
END SUBROUTINE buffer_redo
! ββ Internal helpers ββββββββββββββββββββββββββββββββββββββββββββββββββββββ
FUNCTION make_leaf(buf, text) RESULT(idx)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
CHARACTER(LEN=*), INTENT(IN) :: text
INTEGER :: idx
IF (buf%node_count >= MAX_NODES) &
CALL runtime_panic('text_buffer: node pool exhausted')
buf%node_count = buf%node_count + 1
idx = buf%node_count
buf%nodes(idx)%kind = NODE_LEAF
buf%nodes(idx)%text = text(1:MIN(LEN_TRIM(text), LEAF_MAX))
buf%nodes(idx)%length = LEN_TRIM(text)
buf%nodes(idx)%lines = COUNT_NEWLINES(text)
END FUNCTION make_leaf
FUNCTION rope_concat(buf, l, r) RESULT(idx)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
INTEGER, INTENT(IN) :: l, r
INTEGER :: idx
IF (l == 0) THEN; idx = r; RETURN; END IF
IF (r == 0) THEN; idx = l; RETURN; END IF
buf%node_count = buf%node_count + 1
idx = buf%node_count
buf%nodes(idx)%kind = NODE_BRANCH
buf%nodes(idx)%left = l
buf%nodes(idx)%right = r
buf%nodes(idx)%length = buf%nodes(l)%length + buf%nodes(r)%length
buf%nodes(idx)%lines = buf%nodes(l)%lines + buf%nodes(r)%lines
END FUNCTION rope_concat
RECURSIVE SUBROUTINE rope_split(buf, root, offset, left_out, right_out)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
INTEGER, INTENT(IN) :: root, offset
INTEGER, INTENT(OUT) :: left_out, right_out
INTEGER :: left_len, ll, lr, rl, rr
IF (root == 0 .OR. offset <= 0) THEN
left_out = 0; right_out = root; RETURN
END IF
IF (offset >= buf%nodes(root)%length) THEN
left_out = root; right_out = 0; RETURN
END IF
IF (buf%nodes(root)%kind == NODE_LEAF) THEN
! Split the leaf text
left_out = make_leaf(buf, buf%nodes(root)%text(1:offset))
right_out = make_leaf(buf, buf%nodes(root)%text(offset+1:buf%nodes(root)%length))
RETURN
END IF
left_len = buf%nodes(buf%nodes(root)%left)%length
IF (offset <= left_len) THEN
CALL rope_split(buf, buf%nodes(root)%left, offset, ll, lr)
left_out = ll
right_out = rope_concat(buf, lr, buf%nodes(root)%right)
ELSE
CALL rope_split(buf, buf%nodes(root)%right, offset - left_len, rl, rr)
left_out = rope_concat(buf, buf%nodes(root)%left, rl)
right_out = rr
END IF
END SUBROUTINE rope_split
SUBROUTINE push_undo(buf, cursor_pos)
TYPE(text_buffer_t), INTENT(INOUT) :: buf
INTEGER, INTENT(IN) :: cursor_pos
IF (buf%undo_count >= MAX_UNDO) RETURN ! TODO: compact old history
buf%undo_count = buf%undo_count + 1
buf%undo_head = buf%undo_count
buf%undo(buf%undo_count)%rope_root = buf%root
buf%undo(buf%undo_count)%cursor_pos = cursor_pos
buf%undo(buf%undo_count)%timestamp = buf%undo_count
END SUBROUTINE push_undo
PURE FUNCTION COUNT_NEWLINES(s) RESULT(n)
CHARACTER(LEN=*), INTENT(IN) :: s
INTEGER :: n, i
n = 0
DO i = 1, LEN_TRIM(s)
IF (s(i:i) == CHAR(10)) n = n + 1
END DO
END FUNCTION COUNT_NEWLINES
END MODULE sovereign_text_buffer
|