* Added utf8->string and string->utf8
This commit is contained in:
Abdulaziz Ghuloum
parent
63975eba38
commit
5f19e802f6
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
|
@ -1,10 +1,12 @@
|
|||
|
||||
(library (ikarus date-string)
|
||||
(export date-string)
|
||||
(import (except (ikarus) date-string))
|
||||
(import
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus) date-string))
|
||||
(define date-string
|
||||
(lambda ()
|
||||
(let ([s (make-bytevector 10)])
|
||||
(foreign-call "ikrt_bvftime" s
|
||||
(string->utf8-bytevector "%F"))
|
||||
(utf8-bytevector->string s)))))
|
||||
(string->utf8 "%F"))
|
||||
(utf8->string s)))))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
(export assemble-sources code-entry-adjustment)
|
||||
(import
|
||||
(ikarus)
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus code-objects) procedure-annotation)
|
||||
(ikarus system $pairs))
|
||||
|
||||
|
|
@ -903,7 +904,7 @@
|
|||
(let f ([ls mem])
|
||||
(cond
|
||||
[(null? ls)
|
||||
(let ([bv (string->utf8-bytevector x)])
|
||||
(let ([bv (string->utf8 x)])
|
||||
(set! mem (cons (cons x bv) mem))
|
||||
bv)]
|
||||
[(string=? x (caar ls)) (cdar ls)]
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
(ikarus system $strings)
|
||||
(ikarus system $bytevectors)
|
||||
(ikarus system $chars)
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus)
|
||||
open-input-file current-input-port console-input-port
|
||||
with-input-from-file call-with-input-file
|
||||
|
|
@ -165,7 +166,7 @@
|
|||
(lambda (filename)
|
||||
(close-ports)
|
||||
(let ([fd/error (foreign-call "ikrt_open_input_file"
|
||||
(string->utf8-bytevector filename))])
|
||||
(string->utf8 filename))])
|
||||
(if (fixnum? fd/error)
|
||||
(let ([port (make-input-port
|
||||
(make-input-file-handler fd/error filename)
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
(ikarus system $chars)
|
||||
(ikarus system $bytevectors)
|
||||
(ikarus system $fx)
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus)
|
||||
standard-output-port standard-error-port
|
||||
console-output-port current-output-port
|
||||
|
|
@ -132,7 +133,7 @@
|
|||
(close-ports)
|
||||
(let ([fd/error
|
||||
(foreign-call "ikrt_open_output_file"
|
||||
(string->utf8-bytevector filename)
|
||||
(string->utf8 filename)
|
||||
(option-id options))])
|
||||
(if (fixnum? fd/error)
|
||||
(let ([port
|
||||
|
|
|
|||
|
|
@ -138,7 +138,7 @@
|
|||
(set! open? #f)]
|
||||
[(port-name p) 'string-port]
|
||||
[(get-output-string p)
|
||||
(utf8-bytevector->string
|
||||
(utf8->string
|
||||
(concat
|
||||
($port-buffer p)
|
||||
($port-index p)
|
||||
|
|
|
|||
|
|
@ -1177,7 +1177,7 @@
|
|||
|
||||
(define bignum->string
|
||||
(lambda (x)
|
||||
(utf8-bytevector->string
|
||||
(utf8->string
|
||||
(foreign-call "ikrt_bignum_to_bytevector" x))))
|
||||
|
||||
(define ratnum->string
|
||||
|
|
@ -2278,6 +2278,7 @@
|
|||
(library (ikarus flonum-conversion)
|
||||
(export string->flonum flonum->string)
|
||||
(import
|
||||
(rnrs bytevectors)
|
||||
(ikarus system $bytevectors)
|
||||
(ikarus system $flonums)
|
||||
(except (ikarus) flonum->string string->flonum ))
|
||||
|
|
@ -2422,7 +2423,7 @@
|
|||
(cond
|
||||
[(string? x)
|
||||
(foreign-call "ikrt_bytevector_to_flonum"
|
||||
(string->utf8-bytevector x))]
|
||||
(string->utf8 x))]
|
||||
[else
|
||||
(error 'string->flonum "~s is not a string" x)])) )
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
(export posix-fork fork waitpid system file-exists? delete-file
|
||||
env environ)
|
||||
(import
|
||||
(rnrs bytevectors)
|
||||
(except (ikarus)
|
||||
posix-fork fork waitpid system file-exists? delete-file
|
||||
env environ))
|
||||
|
|
@ -31,7 +32,7 @@
|
|||
(unless (string? x)
|
||||
(error 'system "~s is not a string" x))
|
||||
(let ([rv (foreign-call "ik_system"
|
||||
(string->utf8-bytevector x))])
|
||||
(string->utf8 x))])
|
||||
(if (fx= rv -1)
|
||||
(error 'system "failed")
|
||||
rv))))
|
||||
|
|
@ -41,7 +42,7 @@
|
|||
(unless (string? x)
|
||||
(error 'file-exists? "filename ~s is not a string" x))
|
||||
(let ([v (foreign-call "ikrt_file_exists"
|
||||
(string->utf8-bytevector x))])
|
||||
(string->utf8 x))])
|
||||
(cond
|
||||
[(boolean? v) v]
|
||||
[else
|
||||
|
|
@ -61,7 +62,7 @@
|
|||
(unless (string? x)
|
||||
(error 'delete-file "filename ~s is not a string" x))
|
||||
(let ([v (foreign-call "ikrt_delete_file"
|
||||
(string->utf8-bytevector x))])
|
||||
(string->utf8 x))])
|
||||
(case v
|
||||
[(0) (void)]
|
||||
[else
|
||||
|
|
|
|||
|
|
@ -439,7 +439,7 @@
|
|||
(define uuid
|
||||
(lambda ()
|
||||
(let ([s ($make-bytevector 16)])
|
||||
(utf8-bytevector->string
|
||||
(utf8->string
|
||||
(or (foreign-call "ik_uuid" s)
|
||||
(error 'uuid "failed!"))))))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
|
||||
(library (ikarus transcoders)
|
||||
(export string->utf8-bytevector
|
||||
utf8-bytevector->string)
|
||||
(import (except (ikarus) string->utf8-bytevector utf8-bytevector->string)
|
||||
(export string->utf8 utf8->string)
|
||||
(import (except (ikarus) string->utf8 utf8->string)
|
||||
(ikarus system $strings)
|
||||
(ikarus system $bytevectors)
|
||||
(ikarus system $fx)
|
||||
|
|
@ -22,7 +21,7 @@
|
|||
;;; replace: places a U+FFFD in place of the malformed bytes
|
||||
;;; raise: raises an error
|
||||
|
||||
(define string->utf8-bytevector
|
||||
(define string->utf8
|
||||
(lambda (str)
|
||||
(define (utf8-string-size str)
|
||||
(let f ([str str] [i 0] [j ($string-length str)] [n 0])
|
||||
|
|
@ -74,14 +73,16 @@
|
|||
($fxlogor #b10000000 ($fxlogand b #b111111)))
|
||||
(f bv str ($fxadd1 i) ($fx+ j 4) n)])))])))
|
||||
(unless (string? str)
|
||||
(error 'string->utf8-bytevector "~s is not a string" str))
|
||||
(error 'string->utf8 "~s is not a string" str))
|
||||
(fill-utf8-bytevector
|
||||
($make-bytevector (utf8-string-size str))
|
||||
str)))
|
||||
|
||||
(define utf8-bytevector->string
|
||||
(define (utf8->string x) (decode-utf8-bytevector x 'replace))
|
||||
|
||||
(define decode-utf8-bytevector
|
||||
(let ()
|
||||
(define who 'utf8-bytevector->string)
|
||||
(define who 'decode-utf8-bytevector)
|
||||
(define (count bv mode)
|
||||
(let f ([x bv] [i 0] [j ($bytevector-length bv)] [n 0] [mode mode])
|
||||
(cond
|
||||
|
|
@ -241,7 +242,7 @@
|
|||
[(bv) (convert bv 'raise)]
|
||||
[(bv handling-mode)
|
||||
(unless (memq handling-mode '(ignore replace raise))
|
||||
(error 'utf8-bytevector->string
|
||||
(error 'decode-utf8-bytevector
|
||||
"~s is not a valid handling mode"
|
||||
handling-mode))
|
||||
(convert bv handling-mode)])))
|
||||
|
|
|
|||
|
|
@ -214,9 +214,6 @@
|
|||
[weak-pair? i]
|
||||
[uuid i]
|
||||
[date-string i]
|
||||
[string->utf8-bytevector i]
|
||||
[utf8-bytevector->string i]
|
||||
[$two-bignums i]
|
||||
[andmap i]
|
||||
[ormap i]
|
||||
[fx< i]
|
||||
|
|
@ -843,10 +840,10 @@
|
|||
[sint-list->bytevector i r bv]
|
||||
[string->utf16 r bv]
|
||||
[string->utf32 r bv]
|
||||
[string->utf8 r bv]
|
||||
[string->utf8 i r bv]
|
||||
[u8-list->bytevector i r bv]
|
||||
[uint-list->bytevector i r bv]
|
||||
[utf8->string r bv]
|
||||
[utf8->string i r bv]
|
||||
[utf16->string r bv]
|
||||
[utf32->string r bv]
|
||||
[condition? r co]
|
||||
|
|
|
|||
|
|
@ -407,10 +407,10 @@
|
|||
[sint-list->bytevector C bv]
|
||||
[string->utf16 S bv]
|
||||
[string->utf32 S bv]
|
||||
[string->utf8 S bv]
|
||||
[string->utf8 C bv]
|
||||
[u8-list->bytevector C bv]
|
||||
[uint-list->bytevector C bv]
|
||||
[utf8->string S bv]
|
||||
[utf8->string C bv]
|
||||
[utf16->string S bv]
|
||||
[utf32->string S bv]
|
||||
;;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue