rescind ffi/unsafe/string-list

The `ffi/unsafe/string-list` library is not needed now that `(_list i
_string)` and similar work. This way, existing code that uses `(_list
i _string)`, `(_vector i _string)`, etc., does not needed to be
modified to work with CS.

We don't usually remove libraries, of course, but this one has only
existed for a few days, and it was made to work around a problem that
has been solved in a better way.

Related to #3825

pkgs/racket-doc/scribblings/foreign/derived.scrbl

@@ -8,7 +8,6 @@
 @include-section["vector.scrbl"]
 @include-section["cvector.scrbl"]
 @include-section["cpointer.scrbl"]
-@include-section["string-list.scrbl"]
 @include-section["serialize-cstruct.scrbl"]
 @include-section["define.scrbl"]
 @include-section["alloc.scrbl"]

pkgs/racket-doc/scribblings/foreign/string-list.scrbl

@@ -1,59 +0,0 @@
-#lang scribble/doc
-@(require "utils.rkt" 
-          (only-in scribble/decode make-splice)
-          scribble/racket
-          (for-label ffi/unsafe/string-list))
-
-@title[#:tag "string-list"]{String List Types}
-
-@defmodule[ffi/unsafe/string-list]{The
-@racketmodname[ffi/unsafe/string-list] module provides types for
-converting between string and bytes string lists and foreign arrays of
-strings. This library is particularly useful with @CS[], since
-types like @racket[(_list i _string)] cannot work for passing an
-array of strings to a foreign call.}
-
-@history[#:added "8.1.0.5"]
-
-@deftogether[(
-@defthing[_string-list ctype?]
-@defthing[_string-list/utf-8 ctype?]
-@defthing[_string-list/locale ctype?]
-@defthing[_string-list/latin-1 ctype?]
-@defthing[_string-list/utf-16 ctype?]
-@defthing[_string-list/ucs-4 ctype?]
-@defthing[_bytes-list ctype?]
-@defthing[_bytes-list/nul-terminated ctype?]
-)]{
-
-Types that are similar to @racket[(_list i _string)],
-@racket[(_list i _string/utf-8)],
-@racket[(_list i _string/locale)],
-@racket[(_list i _string/latin-1)],
-@racket[(_list i _string/latin-1)],
-@racket[(_list i _string/utf-16)],
-@racket[(_list i _string/ucs-4)],
-@racket[(_list i _bytes)], and
-@racket[(_list i _bytes/nul-terminated)], but they work as foreign-call
-arguments for @CS[] (as well as @BC[]).
-
-These types convert a lists of strings or bytes to a single block of
-@racket['atomic-interior] memory (see @racket[malloc]) that starts
-with a NULL-terminated array of pointers into itself. Each string or
-bytes string is word-aligned within the atomic block and terminated by
-a suitable sequence of NUL bytes (except for @racket[_bytes-list], which
-does not include a terminator).
-
-The @racket[_string-list] type works only when the
-@racket[default-_string-type] parameter has one of the following
-values:
-@racket[_string/utf-8], @racket[_string*/utf-8],
-@racket[_string/latin-1], @racket[_string*/latin-1],
-@racket[_string/locale], @racket[_string*/locale],
-@racket[_string/utf-16], or
-@racket[_string/ucs-4].
-
-When used as a foreign-call result type and similar positions, these
-types expect the foreign representation to include a NULL terminator
-for the array of pointers as well as a NUL terminator for each string
-or byte string.}

racket/collects/ffi/unsafe/com.rkt

@@ -4,7 +4,6 @@
          ffi/winapi
          ffi/unsafe/atomic
          ffi/unsafe/custodian
-         ffi/unsafe/string-list
          ffi/file
          racket/date
          racket/runtime-path
@@ -334,7 +333,7 @@
    [GetTypeInfo (_hmfun _UINT _LCID (p : (_ptr o _pointer))
                         -> GetTypeInfo (cast p _pointer _ITypeInfo-pointer))
                 #:release-with-function Release]
-   [GetIDsOfNames (_hmfun _REFIID _string-list/utf-16
+   [GetIDsOfNames (_hmfun _REFIID (_ptr i _string/utf-16)
                           (_UINT = 1) _LCID
                           (p : (_ptr o _DISPID))
                           -> GetIDsOfNames
@@ -1938,7 +1937,7 @@
 
 (define (find-memid who obj name)
   (define-values (r memid)
-    (GetIDsOfNames (com-object-get-dispatch obj) IID_NULL (list name) LOCALE_SYSTEM_DEFAULT))
+    (GetIDsOfNames (com-object-get-dispatch obj) IID_NULL name LOCALE_SYSTEM_DEFAULT))
   (cond
    [(zero? r) memid]
    [(= r DISP_E_UNKNOWNNAME) (error who "unknown method name: ~e" name)]

racket/collects/ffi/unsafe/string-list.rkt

@@ -1,130 +0,0 @@
-#lang racket/base
-(require ffi/unsafe)
-
-(provide (protect-out
-          _bytes-list
-          _bytes-list/nul-terminated
-          _string-list
-          _string-list/utf-8
-          _string-list/locale
-          _string-list/latin-1
-          _string-list/utf-16
-          _string-list/ucs-4))
-
-(define (check who l elem elem?)
-  (unless (and (list? l)
-               (andmap elem? l))
-    (raise-argument-error who (format "(listof ~a)" elem) l)))
-
-(define (allocate-bytes-block l terminator-len)
-  (define ptr-bytes (ctype-sizeof _pointer))
-  (define roundup (sub1 ptr-bytes))
-  (define mask (bitwise-not roundup))
-  (define (align n) (bitwise-and (+ n roundup) mask))
-  (define size (for/fold ([size ptr-bytes]) ([bstr (in-list l)])
-                 (+ size ptr-bytes (align (+ (bytes-length bstr) terminator-len)))))
-  (define m (malloc size 'atomic-interior))
-  (memset m 0 size)
-  (for/fold ([offset (* (add1 (length l)) ptr-bytes)]) ([bstr (in-list l)]
-                                                        [i (in-naturals)])
-    (ptr-set! m _pointer i (ptr-add m offset))
-    (memcpy m offset bstr (bytes-length bstr))
-    (+ offset (align (+ (bytes-length bstr) terminator-len))))
-  m)
-
-(define (extract-list p _t)
-  (define len (let loop ([i 0])
-                (if (ptr-ref p _pointer i)
-                    (loop (add1 i))
-                    i)))
-  (cast p _pointer (_list o _t len)))
-
-(define _bytes-list
-  (make-ctype _pointer
-              (lambda (l)
-                (check '_bytes-list l 'bytes bytes?)
-                (allocate-bytes-block l 0))
-              (lambda (p)
-                (extract-list p _bytes))))
-
-(define _bytes-list/nul-terminated
-  (make-ctype _pointer
-              (lambda (l)
-                (check '_bytes-list/nul-terminated l 'bytes bytes?)
-                (allocate-bytes-block l 1))
-              (lambda (p)
-                (extract-list p _bytes))))
-
-(define (make-_string-list who convert _t terminator-len string?)
-  (make-ctype _pointer
-              (lambda (l)
-                (check who l 'string string?)
-                (allocate-bytes-block (map convert l) terminator-len))
-              (lambda (p)
-                (extract-list p (or _t _string)))))
-
-(define (_string? str)
-  (define _t _string)
-  (cond
-    [(or (eq? _t _string*/utf-8)
-         (eq? _t _string*/latin-1)
-         (eq? _t _string*/locale))
-     (or (path? str) (string? str))]
-    [else (string? str)]))
-
-(define (string->bytes str)
-  (define _t _string)
-  (cond
-    [(eq? _t _string/utf-8) (string->bytes/utf-8 str)]
-    [(eq? _t _string*/utf-8) (if (path? str)
-                                 (path->bytes str)
-                                 (string->bytes/utf-8 str))]
-    [(eq? _t _string/latin-1) (bytes->string/latin-1 str)]
-    [(eq? _t _string*/latin-1) (if (path? str)
-                                   (path->bytes str)
-                                   (string->bytes/latin-1 str))]
-    [(eq? _t _string/locale) (string->bytes/locale str)]
-    [(eq? _t _string*/locale) (if (path? str)
-                                  (path->bytes str)
-                                  (string->bytes/locale str))]
-    [(eq? _t _string/utf-16) (string->bytes/utf-16 str)]
-    [(eq? _t _string/ucs-4) (string->bytes/ucs-4 str)]
-    [else (error '_string-list
-                 "unrecognized current _string conversion")]))
-
-(define (string->bytes/utf-16 str)
-  (define len
-    (for/fold ([len 0]) ([c (in-string str)])
-      (+ len
-         (if ((char->integer c) . > . #xFFFF)
-             2
-             1))))
-  (define bstr (make-bytes (* 2 len)))
-  (let loop ([i 0] [j 0])
-    (unless (= i (string-length str))
-      (define v (char->integer (string-ref str i)))
-      (cond
-        [(v . <= . #xFFFF)
-         (ptr-set! bstr _uint16 j v)
-         (loop (add1 i) (+ j 1))]
-        [else
-         (define av (- v #x10000))
-         (define hi (bitwise-ior #xD800 (bitwise-and (arithmetic-shift av -10) #x3FF)))
-         (define lo (bitwise-ior #xDC00 (bitwise-and av #x3FF)))
-         (ptr-set! bstr _uint16 j hi)
-         (ptr-set! bstr _uint16 (+ j 1) lo)
-         (loop (add1 i) (+ j 2))])))
-  bstr)
-
-(define (string->bytes/ucs-4 str)
-  (define bstr (make-bytes (* 4 (string-length str))))
-  (for ([i (in-range (string-length str))])
-    (ptr-set! bstr _uint32 i (char->integer (string-ref str i))))
-  bstr)
-
-(define _string-list (make-_string-list '_string-list string->bytes #f 1 _string?))
-(define _string-list/utf-8 (make-_string-list '_string-list/utf-8 string->bytes/utf-8 _string/utf-8 1 string?))
-(define _string-list/locale (make-_string-list '_string-list/locale string->bytes/locale _string/locale 1 string?))
-(define _string-list/latin-1 (make-_string-list '_string-list/latin-1 string->bytes/latin-1 _string/latin-1 1 string?))
-(define _string-list/utf-16 (make-_string-list '_string-list/utf-16 string->bytes/utf-16 _string/utf-16 2 string?))
-(define _string-list/ucs-4 (make-_string-list '_string-list/ucs-4 string->bytes/ucs-4 _string/ucs-4 4 string?))