12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970 |
- (define ascii-limit 128)
- (define ascii-chars
- (let* ((ascii-chars (make-vector ascii-limit #f))
- (unusual (lambda (s)
- (if (or (not (= (string-length s) 1))
- (let ((c (string-ref s 0)))
- (or (char=? c #\space)
- (char=? c #\newline))))
- (error "unusual whitespace character lost" s)
- s)))
- (init (lambda (i s)
- (do ((i i (+ i 1))
- (j 0 (+ j 1)))
- ((= j (string-length s)))
- (vector-set! ascii-chars i (string-ref s j))))))
- (init 9 (unusual " "))
- (init 12 (unusual ""))
- (init 13 (unusual "
"))
- (init 10 (string #\newline))
- (init 32 " !\"#$%&'()*+,-./0123456789:;<=>?")
- (init 64 "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_")
- (init 96 "`abcdefghijklmnopqrstuvwxyz{|}~")
- ascii-chars))
- (define (ascii->char n)
- (or (vector-ref ascii-chars n)
- (error "not a standard character's ASCII code" n)))
- (define native-chars
- (let ((end (vector-length ascii-chars)))
- (let loop ((i 0)
- (least #f)
- (greatest #f))
- (cond ((= i end)
- (let ((v (make-vector (+ (- greatest least) 1) #f)))
- (do ((i 0 (+ i 1)))
- ((= i end) (cons least v))
- (let ((c (vector-ref ascii-chars i)))
- (if c
- (vector-set! v (- (char->integer c) least) i))))))
- (else
- (let ((c (vector-ref ascii-chars i)))
- (if c
- (let ((n (char->integer c)))
- (loop (+ i 1)
- (if least (min least n) n)
- (if greatest (max greatest n) n)))
- (loop (+ i 1) least greatest))))))))
- (define (char->ascii char)
- (or (vector-ref (cdr native-chars)
- (- (char->integer char) (car native-chars)))
- (error "not a standard character" char)))
- (define ascii-whitespaces '(32 10 9 12 13))
|