diff options
Diffstat (limited to 'byte.scm')
-rw-r--r-- | byte.scm | 101 |
1 files changed, 66 insertions, 35 deletions
@@ -1,5 +1,5 @@ ;;; "byte.scm" small integers, not necessarily chars. -; Copyright (C) 2001, 2002, 2003, 2006 Aubrey Jaffer +; Copyright (C) 2001, 2002, 2003, 2006, 2008 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,7 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. -(require 'rev4-optional-procedures) ; string-copy +(require 'array) ;;@code{(require 'byte)} ;;@ftindex byte @@ -29,16 +29,17 @@ ;;character sets. These functions abstract the notion of a @dfn{byte}. ;;@cindex byte -;;@body +;;@args bytes k ;;@2 must be a valid index of @1. @0 returns byte @2 of @1 using ;;zero-origin indexing. -(define (byte-ref bytes k) (char->integer (string-ref bytes k))) +(define byte-ref array-ref) ;;@body ;;@2 must be a valid index of @1, and @var{byte} must be a small ;;nonnegative integer. @0 stores @var{byte} in element @2 of @1 and ;;returns an unspecified value. @c <!> -(define (byte-set! bytes k byte) (string-set! bytes k (integer->char byte))) +(define (byte-set! bytes k byte) + (array-set! bytes byte k)) ;;@args k byte ;;@args k @@ -46,27 +47,29 @@ ;;given, then all elements of the byte-array are initialized to @2, ;;otherwise the contents of the byte-array are unspecified. (define (make-bytes len . opt) - (if (null? opt) (make-string len) - (make-string len (integer->char (car opt))))) + (make-array (apply A:fixN8b opt) len)) ;;@args bytes ;;@0 returns length of byte-array @1. -(define bytes-length string-length) +(define (bytes-length bts) + (car (array-dimensions bts))) ;;@args byte @dots{} ;;Returns a newly allocated byte-array composed of the small ;;nonnegative arguments. -(define (bytes . args) (list->bytes args)) - -;;@args bytes -;;@0 returns a newly allocated list of the bytes that make up the -;;given byte-array. -(define (bytes->list bts) (map char->integer (string->list bts))) +(define (bytes . args) + (list->array 1 (A:fixN8b) args)) ;;@args bytes ;;@0 returns a newly allocated byte-array formed from the small ;;nonnegative integers in the list @1. -(define (list->bytes lst) (list->string (map integer->char lst))) +(define (list->bytes lst) + (list->array 1 (A:fixN8b) lst)) + +;;@args bytes +;;@0 returns a newly allocated list of the bytes that make up the +;;given byte-array. +(define bytes->list array->list) ;;@noindent ;;@code{Bytes->list} and @code{list->bytes} are inverses so far as @@ -74,8 +77,35 @@ ;;@findex equal? ;;@args bytes +;;Returns a new string formed from applying @code{integer->char} to +;;each byte in @0. Note that this may signal an error for bytes +;;having values between 128 and 255. +(define (bytes->string bts) + (define len (bytes-length bts)) + (let ((new (make-string len))) + (do ((idx (- len 1) (+ -1 idx))) + ((negative? idx) new) + (string-set! new idx (integer->char (byte-ref bts idx)))))) + +;;@args string +;;Returns a new byte-array formed from applying @code{char->integer} +;;to each character in @0. Note that this may signal an error if an +;;integer is larger than 255. +(define (string->bytes str) + (define len (string-length str)) + (let ((new (make-bytes len))) + (do ((idx (- len 1) (+ -1 idx))) + ((negative? idx) new) + (byte-set! new idx (char->integer (string-ref str idx)))))) + +;;@args bytes ;;Returns a newly allocated copy of the given @1. -(define bytes-copy string-copy) +(define (bytes-copy bts) + (define len (bytes-length bts)) + (let ((new (make-bytes len))) + (do ((idx (- len 1) (+ -1 idx))) + ((negative? idx) new) + (byte-set! new idx (byte-ref bytes idx))))) ;;@args bytes start end ;;@1 must be a bytes, and @2 and @3 @@ -86,7 +116,11 @@ ;;@0 returns a newly allocated bytes formed from the bytes of ;;@1 beginning with index @2 (inclusive) and ending with index ;;@3 (exclusive). -(define subbytes substring) +(define (subbytes bytes start end) + (define new (make-bytes (- end start))) + (do ((idx (- end start 1) (+ -1 idx))) + ((negative? idx) new) + (byte-set! new idx (byte-ref bytes (+ start idx))))) ;;@body ;;Reverses the order of byte-array @1. @@ -119,7 +153,8 @@ ;;be omitted, in which case it defaults to the value returned by ;;@code{current-output-port}. ;;@findex current-output-port -(define (write-byte byt . opt) (apply write-char (integer->char byt) opt)) +(define (write-byte byt . opt) + (apply write-char (integer->char byt) opt)) ;;@args port ;;@args @@ -151,7 +186,7 @@ ;;@code{(abs @var{n})} bytes read from @2. If @1 is positive, then ;;the first byte read is stored at index 0; otherwise the last byte ;;read is stored at index 0. Note that the length of the returned -;;string will be less than @code{(abs @var{n})} if @2 reaches +;;byte-array will be less than @code{(abs @var{n})} if @2 reaches ;;end-of-file. ;; ;;@2 may be omitted, in which case it defaults to the value returned @@ -165,8 +200,8 @@ (if (= cnt len) byts (if (positive? n) - (substring byts 0 cnt) - (substring byts (- len cnt) len))))) + (subbytes byts 0 cnt) + (subbytes byts (- len cnt) len))))) ;;@args bytes n port ;;@args bytes n @@ -188,15 +223,15 @@ ;;relative size of @var{start} and @var{end} determines the order of ;;writing. -;;@args string start end port -;;@args string start end +;;@args bts start end port +;;@args bts start end ;;Fills @1 with up to @code{(abs (- @var{start} @var{end}))} bytes ;;read from @4. The first byte read is stored at index @1. ;;@0 returns the number of bytes read. ;; ;;@4 may be omitted, in which case it defaults to the value returned ;;by @code{current-input-port}. -(define (subbytes-read! string start end . port) +(define (subbytes-read! bts start end . port) (if (>= end start) (do ((idx start (+ 1 idx))) ((>= idx end) idx) @@ -204,7 +239,7 @@ (cond ((eof-object? byt) (set! idx (+ -1 idx)) (set! end idx)) - (else (byte-set! string idx byt))))) + (else (byte-set! bts idx byt))))) (do ((idx (+ -1 start) (+ -1 idx)) (cnt 0 (+ 1 cnt))) ((< idx end) cnt) @@ -212,25 +247,21 @@ (cond ((eof-object? byt) (set! idx start) (set! cnt (+ -1 cnt))) - (else (byte-set! string idx byt))))))) + (else (byte-set! bts idx byt))))))) -;;@args string start end port -;;@args string start end +;;@args bts start end port +;;@args bts start end ;;@0 writes @code{(abs (- @var{start} @var{end}))} bytes to ;;output-port @4. The first byte written is index @2 of @1. @0 ;;returns the number of bytes written. ;; ;;@4 may be omitted, in which case it defaults to the value returned ;;by @code{current-output-port}. -(define (subbytes-write string start end . port) +(define (subbytes-write bts start end . port) (if (>= end start) (do ((idx start (+ 1 idx))) ((>= idx end) (- end start)) - (apply write-byte (byte-ref string idx) port)) + (apply write-byte (byte-ref bts idx) port)) (do ((idx (+ -1 start) (+ -1 idx))) ((< idx end) (- start end)) - (apply write-byte (byte-ref string idx) port)))) - -;;;; Legacy names. -(define substring-read! subbytes-read!) -(define substring-write subbytes-write) + (apply write-byte (byte-ref bts idx) port)))) |