mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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: ;;; Code:
(define-module (ice-9 gap-buffer) (define-module (ice-9 gap-buffer)
:autoload (srfi srfi-13) (string-join) #:use-module (srfi srfi-9)
:export (gb? #:export (gb?
make-gap-buffer make-gap-buffer
gb-point gb-point
gb-point-min gb-point-min
gb-point-max gb-point-max
gb-insert-string! gb-insert-string!
gb-insert-char! gb-insert-char!
gb-delete-char! gb-delete-char!
gb-erase! gb-erase!
gb-goto-char gb-goto-char
gb->string gb->string
gb-filter! gb-filter!
gb->lines gb->lines
gb-filter-lines! gb-filter-lines!
make-gap-buffer-port)) make-gap-buffer-port))
(define gap-buffer (define-record-type gap-buffer
(make-record-type 'gap-buffer (new)
'(s ; the buffer, a string gb?
all-sz ; total allocation (s s: s!) ; the buffer, a string
gap-ofs ; GAP starts, aka (1- point) (all-sz all-sz: all-sz!) ; total allocation
aft-ofs ; AFTER starts (gap-ofs gap-ofs: gap-ofs!) ; GAP starts, aka (1- point)
))) (aft-ofs aft-ofs: 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))
;; todo: expose ;; todo: expose
(define default-initial-allocation 128) (define default-initial-allocation 128)
@ -133,8 +121,6 @@
(define (round-up n) (define (round-up n)
(* default-chunk-size (+ 1 (quotient n default-chunk-size)))) (* default-chunk-size (+ 1 (quotient n default-chunk-size))))
(define new (record-constructor gap-buffer '()))
(define (realloc gb inc) (define (realloc gb inc)
(let* ((old-s (s: gb)) (let* ((old-s (s: gb))
(all-sz (all-sz: gb)) (all-sz (all-sz: gb))