summaryrefslogtreecommitdiffstats
path: root/byte.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:40 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:40 -0800
commit4684239efa63dc1b2c1cbe37ef7d3062029f5532 (patch)
tree606a687e9279e9bf6048925878968df9875a4973 /byte.scm
parent64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (diff)
downloadslib-4684239efa63dc1b2c1cbe37ef7d3062029f5532.tar.gz
slib-4684239efa63dc1b2c1cbe37ef7d3062029f5532.zip
Import Upstream version 3b1upstream/3b1
Diffstat (limited to 'byte.scm')
-rw-r--r--byte.scm101
1 files changed, 66 insertions, 35 deletions
diff --git a/byte.scm b/byte.scm
index c611cf0..6fdde3d 100644
--- a/byte.scm
+++ b/byte.scm
@@ -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))))