Eliminate unused multi-byte procedures.
authorChris Hanson <org/chris-hanson/cph>
Mon, 10 Apr 2017 04:08:57 +0000 (21:08 -0700)
committerChris Hanson <org/chris-hanson/cph>
Mon, 10 Apr 2017 04:08:57 +0000 (21:08 -0700)
No need to support a bunch of code that may never be used.

src/runtime/bytevector.scm
src/runtime/runtime.pkg

index 3332a62eb1b1a85dffc0fc02ad573ec6306c9d3d..dd34c07193984a09ea1743f273088add978046ee 100644 (file)
@@ -219,84 +219,18 @@ USA.
   (guarantee u16? u16 'bytevector-u16le-set!)
   (bytevector-u8-set! bytevector index (u16le-byte0 u16))
   (bytevector-u8-set! bytevector (fix:+ index 1) (u16le-byte1 u16)))
-\f
-(define-integrable (list->bytevector-u16-maker u16-byte0 u16-byte1)
-  (lambda (u16s)
-    (let ((bv (allocate-bytevector (fix:lsh (length u16s) 1))))
-      (do ((u16s u16s (cdr u16s))
-          (i 0 (fix:+ i 2)))
-         ((not (pair? u16s)))
-       (bytevector-u8-set! bv i (u16-byte0 (car u16s)))
-       (bytevector-u8-set! bv (fix:+ i 1) (u16-byte1 (car u16s))))
-      bv)))
-
-(define list->bytevector-u16be
-  (list->bytevector-u16-maker u16be-byte0 u16be-byte1))
-
-(define list->bytevector-u16le
-  (list->bytevector-u16-maker u16le-byte0 u16le-byte1))
-
-(define (bytevector-u16be . u16s)
-  (list->bytevector-u16be u16s))
-
-(define (bytevector-u16le . u16s)
-  (list->bytevector-u16le u16s))
-
-(define-integrable (bytevector-u16->list-maker bytes->u16 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-          (start (fix:start-index start end caller)))
-      (do ((i (fix:- end 2) (fix:- i 2))
-          (bytes '()
-                 (cons (bytes->u16 (bytevector-u8-ref bv i)
-                                   (bytevector-u8-ref bv (fix:+ i 1)))
-                       bytes)))
-         ((not (fix:>= i start)) bytes)))))
-
-(define bytevector-u16be->list
-  (bytevector-u16->list-maker bytes->u16be 'bytevector-u16be->list))
-
-(define bytevector-u16le->list
-  (bytevector-u16->list-maker bytes->u16le 'bytevector-u16le->list))
-
-(define-integrable (vector->bytevector-u16-maker u16-byte0 u16-byte1 caller)
-  (lambda (v #!optional start end)
-    (let* ((end (fix:end-index end (vector-length v) caller))
-          (start (fix:start-index start end caller))
-          (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
-      (do ((i start (fix:+ i 1))
-          (j 0 (fix:+ j 2)))
-         ((not (fix:< i end)))
-       (bytevector-u8-set! bv j (u16-byte0 (vector-ref v i)))
-       (bytevector-u8-set! bv (fix:+ j 1) (u16-byte1 (vector-ref v i))))
-      bv)))
 
-(define vector->bytevector-u16be
-  (vector->bytevector-u16-maker u16be-byte0 u16be-byte1
-                               'vector->bytevector-u16be))
-
-(define vector->bytevector-u16le
-  (vector->bytevector-u16-maker u16le-byte0 u16le-byte1
-                               'vector->bytevector-u16le))
-
-(define-integrable (bytevector-u16->vector-maker bytes->u16 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-          (start (fix:start-index start end caller))
-          (v (make-vector (fix:lsh (fix:- end start) -1))))
-      (do ((i start (fix:+ i 2))
-          (j 0 (fix:+ j 1)))
-         ((not (fix:< (fix:+ i 1) end)))
-       (vector-set! bv j
-                    (bytes->u16 (bytevector-u8-ref v i)
-                                (bytevector-u8-ref v (fix:+ i 1)))))
-      v)))
-
-(define bytevector-u16be->vector
-  (bytevector-u16->vector-maker bytes->u16be 'bytevector-u16be->vector))
-
-(define bytevector-u16le->vector
-  (bytevector-u16->vector-maker bytes->u16le 'bytevector-u16le->vector))
+;; Can be removed after 9.3 release:
+(define (vector->bytevector-u16be v #!optional start end)
+  (let* ((end (fix:end-index end (vector-length v) 'vector->bytevector-u16))
+        (start (fix:start-index start end 'vector->bytevector-u16))
+        (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
+    (do ((i start (fix:+ i 1))
+        (j 0 (fix:+ j 2)))
+       ((not (fix:< i end)))
+      (bytevector-u8-set! bv j (u16be-byte0 (vector-ref v i)))
+      (bytevector-u8-set! bv (fix:+ j 1) (u16be-byte1 (vector-ref v i))))
+    bv))
 \f
 ;;;; U32 accessors
 
@@ -390,94 +324,6 @@ USA.
   (bytevector-u8-set! bytevector (fix:+ index 2) (u32le-byte2 u32))
   (bytevector-u8-set! bytevector (fix:+ index 3) (u32le-byte3 u32)))
 \f
-(define-integrable (list->bytevector-u32-maker u32-byte0 u32-byte1 u32-byte2
-                                              u32-byte3)
-  (lambda (u32s)
-    (let ((bv (allocate-bytevector (fix:lsh (length u32s) 2))))
-      (do ((u32s u32s (cdr u32s))
-          (i 0 (fix:+ i 4)))
-         ((not (pair? u32s)))
-       (bytevector-u8-set! bv i (u32-byte0 (car u32s)))
-       (bytevector-u8-set! bv (fix:+ i 1) (u32-byte1 (car u32s)))
-       (bytevector-u8-set! bv (fix:+ i 2) (u32-byte2 (car u32s)))
-       (bytevector-u8-set! bv (fix:+ i 3) (u32-byte3 (car u32s))))
-      bv)))
-
-(define list->bytevector-u32be
-  (list->bytevector-u32-maker u32be-byte0 u32be-byte1 u32be-byte2 u32be-byte3))
-
-(define list->bytevector-u32le
-  (list->bytevector-u32-maker u32le-byte0 u32le-byte1 u32le-byte2 u32le-byte3))
-
-(define (bytevector-u32be . u32s)
-  (list->bytevector-u32be u32s))
-
-(define (bytevector-u32le . u32s)
-  (list->bytevector-u32le u32s))
-
-(define-integrable (bytevector-u32->list-maker bytes->u32 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-          (start (fix:start-index start end caller)))
-      (do ((i (fix:- end 4) (fix:- i 4))
-          (bytes '()
-                 (cons (bytes->u32 (bytevector-u8-ref bv i)
-                                   (bytevector-u8-ref bv (fix:+ i 1))
-                                   (bytevector-u8-ref bv (fix:+ i 2))
-                                   (bytevector-u8-ref bv (fix:+ i 3)))
-                       bytes)))
-         ((not (fix:>= i start)) bytes)))))
-
-(define bytevector-u32be->list
-  (bytevector-u32->list-maker bytes->u32be 'bytevector-u32be->list))
-
-(define bytevector-u32le->list
-  (bytevector-u32->list-maker bytes->u32le 'bytevector-u32le->list))
-\f
-(define-integrable (vector->bytevector-u32-maker u32-byte0 u32-byte1 u32-byte2
-                                                u32-byte3 caller)
-  (lambda (v #!optional start end)
-    (let* ((end (fix:end-index end (vector-length v) caller))
-          (start (fix:start-index start end caller))
-          (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
-      (do ((i start (fix:+ i 1))
-          (j 0 (fix:+ j 4)))
-         ((not (fix:< i end)))
-       (bytevector-u8-set! bv j (u32-byte0 (vector-ref v i)))
-       (bytevector-u8-set! bv (fix:+ j 1) (u32-byte1 (vector-ref v i)))
-       (bytevector-u8-set! bv (fix:+ j 2) (u32-byte2 (vector-ref v i)))
-       (bytevector-u8-set! bv (fix:+ j 3) (u32-byte3 (vector-ref v i))))
-      bv)))
-
-(define vector->bytevector-u32be
-  (vector->bytevector-u32-maker u32be-byte0 u32be-byte1 u32be-byte2 u32be-byte3
-                               'vector->bytevector-u32be))
-
-(define vector->bytevector-u32le
-  (vector->bytevector-u32-maker u32le-byte0 u32le-byte1 u32le-byte2 u32le-byte3
-                               'vector->bytevector-u32le))
-
-(define-integrable (bytevector-u32->vector-maker bytes->u32 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-          (start (fix:start-index start end caller))
-          (v (make-vector (fix:lsh (fix:- end start) -2))))
-      (do ((i start (fix:+ i 4))
-          (j 0 (fix:+ j 1)))
-         ((not (fix:< (fix:+ i 3) end)))
-       (vector-set! bv j
-                    (bytes->u32 (bytevector-u8-ref v i)
-                                (bytevector-u8-ref v (fix:+ i 1))
-                                (bytevector-u8-ref v (fix:+ i 2))
-                                (bytevector-u8-ref v (fix:+ i 3)))))
-      v)))
-
-(define bytevector-u32be->vector
-  (bytevector-u32->vector-maker bytes->u32be 'bytevector-u32be->vector))
-
-(define bytevector-u32le->vector
-  (bytevector-u32->vector-maker bytes->u32le 'bytevector-u32le->vector))
-\f
 (define-integrable (string-encoder char-byte-length allocator encode-char!
                                   caller)
   (lambda (string #!optional start end)
index 342b68ed9f507b082e320a39543bbf6bb15415a0..9c0b93aa03144f6f5a4c6bc4a3a96bef0e027063 100644 (file)
@@ -1076,24 +1076,12 @@ USA.
          bytevector-fill!
          bytevector-hash
          bytevector-length
-         bytevector-u16be
-         bytevector-u16be->list
-         bytevector-u16be->vector
          bytevector-u16be-ref
          bytevector-u16be-set!
-         bytevector-u16le
-         bytevector-u16le->list
-         bytevector-u16le->vector
          bytevector-u16le-ref
          bytevector-u16le-set!
-         bytevector-u32be
-         bytevector-u32be->list
-         bytevector-u32be->vector
          bytevector-u32be-ref
          bytevector-u32be-set!
-         bytevector-u32le
-         bytevector-u32le->list
-         bytevector-u32le->vector
          bytevector-u32le-ref
          bytevector-u32le-set!
          bytevector-u8-ref
@@ -1102,10 +1090,6 @@ USA.
          bytevector?
          hexadecimal->bytevector
          list->bytevector
-         list->bytevector-u16be
-         list->bytevector-u16le
-         list->bytevector-u32be
-         list->bytevector-u32le
          make-bytevector
          string->utf16be
          string->utf16le
@@ -1120,15 +1104,13 @@ USA.
          utf32be->string
          utf32le->string
          utf8->string
-         vector->bytevector
-         vector->bytevector-u16be
-         vector->bytevector-u16le
-         vector->bytevector-u32be
-         vector->bytevector-u32le)
+         vector->bytevector)
   (export (runtime predicate-metadata)
          register-mit-bytevector-predicates!)
   (export (runtime symbol)
-         %legacy-string->bytevector))
+         %legacy-string->bytevector)
+  (export (runtime ucd-tables)
+         vector->bytevector-u16be))
 
 (define-package (runtime 1d-property)
   (files "prop1d")