blob: 7f699ac49ac831535dd97bb5d7ccb29864ca74d1 (
plain)
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
|
;; INTERNAL BUFFERS: The indirection level of the buffer records is cool, so we
;; can resize the underlying strings and keep all the pieces untouched and
;; pointing to the correct thing.
;; There's nothing preventing the programmer from writing in the ro-buffer...
;; but it will be hidden under the piece-table interface so nothing should
;; happen
(define-record-type <ro-buffer>
(make-ro-buffer string)
ro-buffer?
(string ro-buffer-string))
;; This is where things are added, it's able to grow to handle new additions
(define-record-type <add-buffer>
(%make-add-buffer string used)
add-buffer?
(string add-buffer-string set-add-buffer-string!)
(used add-buffer-used set-add-buffer-used!))
;; TODO think about a way to make all this polymorphism automagic
(define (buffer->string buffer)
"Returns the underlying string of the buffer"
(cond
((add-buffer? buffer) (add-buffer-string buffer))
((ro-buffer? buffer) (ro-buffer-string buffer))))
;;
(define *add-buffer-length* (make-parameter 100))
(define (make-add-buffer)
(%make-add-buffer (make-string (*add-buffer-length*)) 0))
(define (enlarge-add-buffer! add-buffer at-least)
(let* ((str (add-buffer-string add-buffer))
(len (string-length str))
; TODO: Better algo here?
(new (make-string (+ len at-least (*add-buffer-length*)))))
(set-add-buffer-string! add-buffer new)
(string-copy! new 0 str)))
(define (add-buffer-append! add-buffer str)
"Appends to add buffer, growing if necessary"
(let ((append-len (string-length str))
(buffer-used (add-buffer-used add-buffer))
(buffer-size (string-length (add-buffer-string add-buffer))))
(when (>= (+ append-len buffer-used) buffer-size)
(enlarge-add-buffer! add-buffer append-len))
(string-copy! (add-buffer-string add-buffer) buffer-used str)
(set-add-buffer-used! add-buffer (+ append-len buffer-used))))
|
