Finish ducking.
This commit is contained in:
parent
1b18c99d3c
commit
c42582a799
4 changed files with 107 additions and 31 deletions
|
|
@ -24,8 +24,11 @@
|
|||
|
||||
(declare (unit util-utf8))
|
||||
|
||||
(module
|
||||
(import duck)
|
||||
|
||||
(module*
|
||||
util-utf8
|
||||
#:doc ("High-performance UTF-8 support.")
|
||||
(
|
||||
utf8-char->string
|
||||
|
||||
|
|
@ -52,10 +55,11 @@
|
|||
(import scheme
|
||||
(chicken base)
|
||||
(chicken bitwise)
|
||||
testing)
|
||||
testing
|
||||
racket-kwargs)
|
||||
|
||||
;; Encodes given character as UTF-8
|
||||
(define (utf8-char->string ch)
|
||||
(define/doc (utf8-char->string ch)
|
||||
("Encodes given character as UTF-8.")
|
||||
(let ((n (char->integer ch)))
|
||||
(cond ((>= n #x10000)
|
||||
(let ((r (make-string 4))
|
||||
|
|
@ -87,10 +91,9 @@
|
|||
(else
|
||||
(make-string 1 ch)))))
|
||||
|
||||
;; UTF-8 version of make-string
|
||||
(define (make-utf8-string n . chs)
|
||||
(let* ((ch (if (null? chs) #\space (car chs)))
|
||||
(s (utf8-char->string ch))
|
||||
(define*/doc (make-utf8-string n (ch #\space))
|
||||
("UTF-8 version of make-string.")
|
||||
(let* ((s (utf8-char->string ch))
|
||||
(sl (string-length s))
|
||||
(rl (* n sl))
|
||||
(r (make-string rl)))
|
||||
|
|
@ -103,19 +106,19 @@
|
|||
(loop (add1 ri)
|
||||
(if (= nsi sl) 0 nsi)))))))
|
||||
|
||||
;; UTF-8 character append
|
||||
(define (string-append-utf8-char s ch)
|
||||
(define/doc (string-append-utf8-char s ch)
|
||||
("UTF-8 character append.")
|
||||
(string-append s (utf8-char->string ch)))
|
||||
|
||||
;; Converts a UTF-8 string into two lists: list of UTF-8 characters
|
||||
;; of the string and a list of remaining bytes (as integers).
|
||||
(define (utf8-string->lists str)
|
||||
(define/doc (utf8-string->lists str)
|
||||
("Converts a UTF-8 string into two lists: list of UTF-8 characters
|
||||
of the string and a list of remaining bytes (as integers).")
|
||||
(utf8-bytes->lists
|
||||
(map char->integer
|
||||
(string->list str))))
|
||||
|
||||
;; The same as above but accepts a list of bytes (as integers)
|
||||
(define (utf8-bytes->lists chars)
|
||||
(define/doc (utf8-bytes->lists chars)
|
||||
("The same as above but accepts a list of bytes (as integers).")
|
||||
(let loop ((bytes chars)
|
||||
(rpending '())
|
||||
(pending 0)
|
||||
|
|
@ -175,11 +178,10 @@
|
|||
(sub1 char-bytes)
|
||||
res))))))))))
|
||||
|
||||
;; Returns the position right after the character at specified
|
||||
;; position.
|
||||
(define (utf8-string-next-char str . sis)
|
||||
(let ((len (string-length str))
|
||||
(si0 (if (null? sis) 0 (car sis))))
|
||||
(define*/doc (utf8-string-next-char str (si0 0))
|
||||
("Returns the position right after the character at specified
|
||||
position.")
|
||||
(let ((len (string-length str)))
|
||||
(let loop ((si si0)
|
||||
(pc 0))
|
||||
(if (or (= si len)
|
||||
|
|
@ -200,8 +202,8 @@
|
|||
(sub1 pc)
|
||||
0))))))))
|
||||
|
||||
;; Calculates the length of given UTF-8 string
|
||||
(define (utf8-string-length s)
|
||||
(define/doc (utf8-string-length s)
|
||||
("Calculates the length of given UTF-8 string.")
|
||||
(let ((l (string-length s)))
|
||||
(let loop ((si 0)
|
||||
(ci 0)
|
||||
|
|
@ -226,8 +228,8 @@
|
|||
(sub1 pc)
|
||||
0))))))))
|
||||
|
||||
;; Converts utf8 string to list of unicode characters
|
||||
(define (utf8-string->list s)
|
||||
(define/doc (utf8-string->list s)
|
||||
("Converts utf8 string to list of unicode characters.")
|
||||
(let-values (((lst _) (utf8-string->lists s)))
|
||||
lst))
|
||||
|
||||
|
|
@ -265,8 +267,8 @@
|
|||
(else
|
||||
(cons ch lst)))))
|
||||
|
||||
;; Converts list of unicode characters into utf8 string
|
||||
(define (list->utf8-string lst)
|
||||
(define/doc (list->utf8-string lst)
|
||||
("Converts list of unicode characters into utf8 string.")
|
||||
(let loop ((lst lst)
|
||||
(res '()))
|
||||
(if (null? lst)
|
||||
|
|
@ -274,8 +276,8 @@
|
|||
(loop (cdr lst)
|
||||
(prepend-unicode-char-to-utf8-list (car lst) res)))))
|
||||
|
||||
;; Returns true, if given string contains UTF-8 characters
|
||||
(define (string-utf8? s)
|
||||
(define/doc (string-utf8? s)
|
||||
("Returns true, if given string contains UTF-8 characters.")
|
||||
(let ((asciilen (string-length s))
|
||||
(utf8len (utf8-string-length s)))
|
||||
(not (= asciilen utf8len))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue