mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Re-implement (ice-9 gap-buffer) records in terms of srfi-9

Browse source 
* module/ice-9/gap-buffer.scm (gap-buffer): Use srfi-9.
This commit is contained in:
Andy Wingo 2019-10-22 13:47:02 +02:00
parent 40395c0dff
commit 0c8d20d2d0
1 changed files with 23 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

60
module/ice-9/gap-buffer.scm
View file

@ -88,42 +88,30 @@
;;; Code:
(define-module (ice-9 gap-buffer)
:autoload (srfi srfi-13) (string-join)
:export (gb?
make-gap-buffer
gb-point
gb-point-min
gb-point-max
gb-insert-string!
gb-insert-char!
gb-delete-char!
gb-erase!
gb-goto-char
gb->string
gb-filter!
gb->lines
gb-filter-lines!
make-gap-buffer-port))
#:use-module (srfi srfi-9)
#:export (gb?
make-gap-buffer
gb-point
gb-point-min
gb-point-max
gb-insert-string!
gb-insert-char!
gb-delete-char!
gb-erase!
gb-goto-char
gb->string
gb-filter!
gb->lines
gb-filter-lines!
make-gap-buffer-port))
(define gap-buffer
(make-record-type 'gap-buffer
'(s ; the buffer, a string
all-sz ; total allocation
gap-ofs ; GAP starts, aka (1- point)
aft-ofs ; AFTER starts
)))
(define gb? (record-predicate gap-buffer))
(define s: (record-accessor gap-buffer 's))
(define all-sz: (record-accessor gap-buffer 'all-sz))
(define gap-ofs: (record-accessor gap-buffer 'gap-ofs))
(define aft-ofs: (record-accessor gap-buffer 'aft-ofs))
(define s! (record-modifier gap-buffer 's))
(define all-sz! (record-modifier gap-buffer 'all-sz))
(define gap-ofs! (record-modifier gap-buffer 'gap-ofs))
(define aft-ofs! (record-modifier gap-buffer 'aft-ofs))
(define-record-type gap-buffer
(new)
gb?
(s s: s!) ; the buffer, a string
(all-sz all-sz: all-sz!) ; total allocation
(gap-ofs gap-ofs: gap-ofs!) ; GAP starts, aka (1- point)
(aft-ofs aft-ofs: aft-ofs!)) ; AFTER starts
;; todo: expose
(define default-initial-allocation 128)
@ -133,8 +121,6 @@
(define (round-up n)
(* default-chunk-size (+ 1 (quotient n default-chunk-size))))
(define new (record-constructor gap-buffer '()))
(define (realloc gb inc)
(let* ((old-s (s: gb))
(all-sz (all-sz: gb))