Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add array-packed? tests on empty arrays.

Browse source 
Issue #959.
This commit is contained in:
Alex Shinn 2024-05-24 19:41:47 +09:00
parent 09a5c431a2
commit 0ce4614457
7 changed files with 81 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lib/chibi/text/base.scm
View file

@ -5,7 +5,7 @@
(if text
(lp (text-next text)
(+ sum
(string-length (utf8->string! (text-source text)
(string-length (utf8->string! (text-bytes text)
(text-start text)
(text-end text)))))
sum)))
@ -34,19 +34,19 @@
(make-text bv start end #f #f '() #f)))
(define (text-string text)
(utf8->string (text-source text) (text-start text) (text-end text)))
(utf8->string (text-bytes text) (text-start text) (text-end text)))
;;> Returns the utf8 representation of the codepoints in \var{text}.
(define (text->utf8 text)
(if (and (not (text-prev text)) (not (text-next text)))
(bytevector-copy (text-source text) (text-start text) (text-end text))
(bytevector-copy (text-bytes text) (text-start text) (text-end text))
(let ((out (open-output-bytevector)))
(let lp ((piece (text-first text)))
(cond
((not piece)
(get-output-bytevector out))
(else
(write-bytevector (text-source piece) out (text-start piece) (text-end piece))
(write-bytevector (text-bytes piece) out (text-start piece) (text-end piece))
(lp (text-next piece))))))))
;;> Returns a string representing the same codepoints as \var{text}.
@ -61,25 +61,25 @@
(let lp ((text (text-prev (mark-text mark))))
(and text
(if (< (text-start text) (text-end text))
(utf8-ref (text-source text) (- (text-end text) 1))
(utf8-ref (text-bytes text) (- (text-end text) 1))
(lp (text-prev text))))))
((>= (mark-offset mark) (text-end (mark-text mark)))
(let lp ((text (text-next (mark-text mark))))
(and text
(if (< (text-start text) (text-end text))
(utf8-ref (text-source text) (text-start text))
(utf8-ref (text-bytes text) (text-start text))
(lp (text-next text))))))
(else
(utf8-ref (text-source (mark-text mark)) (mark-offset mark)))))
(utf8-ref (text-bytes (mark-text mark)) (mark-offset mark)))))
(define (text-piece-copy text)
(let ((res (make-text (bytevector-copy (text-source text))
(let ((res (make-text (bytevector-copy (text-bytes text))
(text-start text)
(text-end text)
(text-prev text)
(text-next text)
'()
(text-data text))))
(text-source text))))
(text-marks-set! res
(map (lambda (mk)
(make-mark res (mark-offset mk) (mark-data mk)))
@ -144,9 +144,9 @@
(size (max (- at-offset (text-start text))
(if (pair? o) (car o) 64)))
(right (text-new-right! text size)))
(bytevector-copy! (text-source right)
(bytevector-copy! (text-bytes right)
0
(text-source text)
(text-bytes text)
at-offset
(text-end text))
(text-end-set! right (- (text-end text) at-offset))
@ -170,7 +170,7 @@
(let* ((at-offset (mark-offset at-mark))
(src (string->utf8 str))
(size (bytevector-length src))
(dst (text-source text))
(dst (text-bytes text))
(dst-size (bytevector-length dst)))
(cond
((= at-offset (text-end text))
@ -189,7 +189,7 @@
;; TODO: better sizing?
(let ((right (text-new-right! text (* 2 size)))
(right-size (- size copy-size)))
(bytevector-copy! (text-source right) 0 src copy-size size)
(bytevector-copy! (text-bytes right) 0 src copy-size size)
(text-end-set! right right-size)))
text))
;; ((= at-offset (text-start text))
@ -244,11 +244,7 @@
(let lp ((text (text-next from-text)) (marks '()))
(cond
((and text (not (eq? text to-text)))
;; TODO: splice out the nodes themselves
(let ((new-marks (text-marks text)))
(text-start-set! text (text-end text))
(text-marks-set! text '())
(lp (text-next text) (cons new-marks marks))))
(lp (text-next text) (cons (text-splice! text) marks)))
(else
(text-marks-set! to-text
(append

6
lib/chibi/text/marks.scm
View file

@ -39,18 +39,18 @@
(data (and (pair? o) (pair? (cdr o)) (cadr o))))
(let lp ((n index)
(text text)
(bv (text-source text))
(bv (text-bytes text))
(sc (text-start text)))
(cond
((positive? n)
(if (>= sc (text-end text))
(let ((text2 (text-next text)))
(lp n text2 (text-source text2) (text-start text2)))
(lp n text2 (text-bytes text2) (text-start text2)))
(lp (- n 1) text bv (utf8-next bv sc (text-end text)))))
((zero? n)
(values text (make-mark text sc data)))
(else
(if (<= sc (text-start text))
(let ((text2 (text-prev text)))
(lp n text2 (text-source text2) (text-end text2)))
(lp n text2 (text-bytes text2) (text-end text2)))
(lp (+ n 1) text bv (utf8-prev bv sc (text-start text))))))))))

12
lib/chibi/text/movement.scm
View file

@ -7,8 +7,8 @@
(cond
((< (mark-offset mark) (text-end (mark-text mark)))
;; there was space in the current piece
(let ((ch (utf8-ref (text-source (mark-text mark)) (mark-offset mark)))
(offset2 (utf8-next (text-source (mark-text mark))
(let ((ch (utf8-ref (text-bytes (mark-text mark)) (mark-offset mark)))
(offset2 (utf8-next (text-bytes (mark-text mark))
(mark-offset mark)
(text-end (mark-text mark)))))
(mark-offset-set! mark offset2)
@ -18,8 +18,8 @@
(and text
(if (< (text-start text) (text-end text))
;; advanced to a new piece, need to also move the mark
(let ((ch (utf8-ref (text-source text) (text-start text)))
(offset2 (utf8-next (text-source text)
(let ((ch (utf8-ref (text-bytes text) (text-start text)))
(offset2 (utf8-next (text-bytes text)
(text-start text)
(text-end text))))
(mark-offset-set! mark offset2)
@ -38,7 +38,7 @@
(cond
((> (mark-offset mark) (text-start (mark-text mark)))
(cond
((utf8-prev (text-source (mark-text mark))
((utf8-prev (text-bytes (mark-text mark))
(mark-offset mark)
(text-start (mark-text mark)))
=> (lambda (offset) (mark-offset-set! mark offset) (text-ref mark)))
@ -49,7 +49,7 @@
(if (< (text-start text) (text-end text))
;; advanced to a new piece, need to also move the mark
(cond
((utf8-prev (text-source text) (text-end text) (text-start text))
((utf8-prev (text-bytes text) (text-end text) (text-start text))
=> (lambda (offset)
(mark-offset-set! mark offset)
(text-marks-set! (mark-text mark)

2
lib/chibi/text/search.scm
View file

@ -7,7 +7,7 @@
(let lp ((tx (mark-text mk)))
(and tx
;; Note string size is mis-named, it's actually the end offset.
(let* ((bv (text-source tx))
(let* ((bv (text-bytes tx))
(start (if (eqv? tx (mark-text mk)) (mark-offset mk) (text-start tx)))
(end (text-end tx))
(str (utf8->string! bv start end))

34
lib/chibi/text/types.scm
View file

@ -7,15 +7,15 @@
;; Basically implemented as a piece table with mark management.
(define-record-type Text
(make-text source start end prev next marks data)
(make-text bytes start end prev next marks source)
text?
(source text-source text-source-set!)
(bytes text-bytes text-bytes-set!)
(start text-start text-start-set!)
(end text-end text-end-set!)
(prev text-prev text-prev-set!)
(next text-next text-next-set!)
(marks text-marks text-marks-set!)
(data text-data text-data-set!))
(source text-source text-source-set!))
(define (text-first text)
(cond ((text-prev text) => text-first)
@ -25,9 +25,37 @@
(cond ((text-next text) => text-last)
(else text)))
(define (text-splice! text)
;; TODO: splice out the nodes themselves
(let ((marks (text-marks text)))
(text-start-set! text (text-end text))
(text-marks-set! text '())
marks))
(define-record-type Mark
(make-mark text offset data)
mark?
(text mark-text mark-text-set!)
(offset mark-offset mark-offset-set!)
(data mark-data mark-data-set!))
(define-record-type Text-Source
(make-text-source loader path data)
text-source?
(loader text-source-loader text-source-loader-set!)
(path text-source-path text-source-path-set!)
(data text-source-data text-source-data-set!))
(define-record-type Text-Loader
(make-text-loader load reload write modified?)
text-loader?
;; load is used on construction
(load text-loader-load text-loader-load-set!)
;; reload updates the text to match the file (discards changes)
(reload text-loader-reload text-loader-reload-set!)
;; write updates the file to match the text (overwrites external edits)
(write text-loader-write text-loader-write-set!)
;; modified tells us if the file has been modified since we last synced
;; (either write or reload)
(modified? text-loader-modified? text-loader-modified?-set!)
)

16
lib/chibi/text/types.sld
View file

@ -3,16 +3,26 @@
(import (scheme base))
(export
make-text text?
text-source text-source-set!
text-bytes text-bytes-set!
text-start text-start-set!
text-end text-end-set!
text-prev text-prev-set!
text-next text-next-set!
text-marks text-marks-set!
text-data text-data-set!
text-source text-source-set!
text-first text-last
make-mark mark?
mark-text mark-text-set!
mark-offset mark-offset-set!
mark-data mark-data-set!)
mark-data mark-data-set!
;; loading
make-text-source text-source?
text-source-loader text-source-loader-set!
text-source-path text-source-path-set!
text-source-data text-source-data-set!
make-text-loader text-loader?
text-loader-load text-loader-load-set!
text-loader-reload text-loader-reload-set!
text-loader-write text-loader-write-set!
text-loader-modified? text-loader-modified?-set!)
(include "types.scm"))

19
lib/srfi/231/test.sld
View file

@ -1311,14 +1311,21 @@
(test #\a
(array-ref (make-specialized-array (make-interval '#())
char-storage-class #\a)))
(test-assert
(array-packed? (make-specialized-array (make-interval '#())
f32-storage-class)))
(test-assert
(array-packed? (make-specialized-array (make-interval '#(1 2 3)
'#(1 2 3))
f32-storage-class)))
;; all these are true, we'll have to see how to screw it up later.
;; (do ((i 0 (+ i 1)))
;; ((= i tests))
;; (let ((array
;; (make-specialized-array (random-interval)
;; u1-storage-class)))
;; (test-assert (array-packed? array))))
(do ((i 0 (+ i 1)))
((= i tests))
(let ((array
(make-specialized-array (random-interval)
u1-storage-class)))
(test-assert (array-packed? array))))
(let ((array
(make-specialized-array (make-interval '#(0 0) '#(2 3)))))