conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* write now writes characters (including unicode chars) properly.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-19 15:18:08 -04:00
parent 1abce54167
commit f33fce8b04
3 changed files with 36 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

15
src/ikarus.chars.ss
View File

@ -14,12 +14,15 @@
(define integer->char
(lambda (n)
(unless (fixnum? n)
(error 'integer->char "~s is not a fixnum" n))
(unless (and ($fx>= n 0)
($fx<= n 255))
(error 'integer->char "~s is out of range[0..255]" n))
($fixnum->char n)))
(cond
[(not (fixnum? n)) (error 'integer->char "invalid argument ~s" n)]
[($fx< n 0) (error 'integer->char "~s is negative" n)]
[($fx<= n #xD7FF) ($fixnum->char n)]
[($fx< n #xE000)
(error 'integer->char "~s does not have a unicode representation" n)]
[($fx<= n #x10FFFF) ($fixnum->char n)]
[else (error 'integer->char
"~s does not have a unicode representation" n)])))
(define char->integer
(lambda (x)

32
src/ikarus.writer.ss
View File

@ -13,10 +13,32 @@
(except (ikarus) write display format printf print-error
error-handler error))
;;; (define char-table ; first nonprintable chars
;;; '#("nul" "soh" "stx" "etx" "eot" "enq" "ack" "bel" "bs" "tab" "newline"
;;; "vt" "ff" "return" "so" "si" "dle" "dc1" "dc2" "dc3" "dc4" "nak"
;;; "syn" "etb" "can" "em" "sub" "esc" "fs" "gs" "rs" "us" "space"))
(define char-table ; first nonprintable chars
'#("nul" "soh" "stx" "etx" "eot" "enq" "ack" "bel" "bs" "tab" "newline"
"vt" "ff" "return" "so" "si" "dle" "dc1" "dc2" "dc3" "dc4" "nak"
"syn" "etb" "can" "em" "sub" "esc" "fs" "gs" "rs" "us" "space"))
'#("nul" "x1" "x2" "x3" "x4" "x5" "x6" "alarm"
"backspace" "tab" "linefeed" "vtab" "page" "return" "xE" "xF"
"x10" "x11" "x12" "x13" "x14" "x15" "x16" "x17"
"x18" "x19" "x1A" "esc" "x1C" "x1D" "x1E" "x1F"
"space"))
(define write-positive-hex-fx
(lambda (n p)
(unless ($fx= n 0)
(write-positive-hex-fx ($fxsra n 4) p)
(let ([n ($fxlogand n #xF)])
(cond
[($fx<= n 9)
(write-char ($fixnum->char
($fx+ ($char->fixnum #\0) n))
p)]
[else
(write-char ($fixnum->char
($fx+ ($char->fixnum #\A) ($fx- n 10)))
p)])))))
(define write-character
(lambda (x p m)
@ -32,11 +54,11 @@
(write-char x p)]
[(fx= i 127)
(write-char #\\ p)
(write-char* "del" p)]
(write-char* "delete" p)]
[else
(write-char #\\ p)
(write-char #\x p)
(write-fixnum i p)]))
(write-positive-hex-fx i p)]))
(write-char x p))))
(define write-list