From 527552c9c13b5717a907c3afebe773ec6e7dc9cf Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 26 Jan 2017 17:23:49 -0800 Subject: [PATCH] Eliminate large swath of unused exports from (runtime unicode) package. --- src/runtime/parser-buffer.scm | 6 +-- src/runtime/runtime.pkg | 98 +---------------------------------- src/runtime/string.scm | 4 +- src/runtime/unicode.scm | 12 ++--- src/runtime/url.scm | 10 ++-- src/xml/rdf-struct.scm | 4 +- src/xml/xml-struct.scm | 2 +- 7 files changed, 20 insertions(+), 116 deletions(-) diff --git a/src/runtime/parser-buffer.scm b/src/runtime/parser-buffer.scm index def81b702..d7d7d0c2c 100644 --- a/src/runtime/parser-buffer.scm +++ b/src/runtime/parser-buffer.scm @@ -56,7 +56,7 @@ USA. (let ((string (string->wide-string string start end))) (make-parser-buffer string 0 (wide-string-length string) 0 0 #f #t 0)) (begin - (guarantee-wide-string string 'STRING->PARSER-BUFFER) + (guarantee wide-string? string 'STRING->PARSER-BUFFER) (let* ((end (if (or (default-object? end) (not end)) (wide-string-length string) @@ -82,7 +82,7 @@ USA. (zero? (wide-string-length prefix)))) (make-parser-buffer (make-wide-string min-length) 0 0 0 0 port #f 0) (begin - (guarantee-wide-string prefix 'textual-input-port->parser-buffer) + (guarantee wide-string? prefix 'textual-input-port->parser-buffer) (let ((n (wide-string-length prefix))) (make-parser-buffer (%grow-buffer prefix n (max min-length n)) 0 n 0 0 port #f 0))))) @@ -135,7 +135,7 @@ USA. (set-parser-buffer-line! buffer (parser-buffer-pointer-line p))) (define (get-parser-buffer-tail buffer p) - (call-with-parser-buffer-tail buffer p wide-string->utf8-string)) + (call-with-parser-buffer-tail buffer p string->utf8-string)) (define (call-with-parser-buffer-tail buffer p procedure) ;; P must be a buffer pointer previously returned by diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 033c1845c..6d43d5ee5 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -5725,106 +5725,14 @@ USA. (files "unicode") (parent (runtime)) (export () - ;; BEGIN deprecated bindings - error:not-utf16-be-string - error:not-utf16-high-surrogate - error:not-utf16-le-string - error:not-utf16-low-surrogate - error:not-utf16-string - error:not-utf32-be-string - error:not-utf32-le-string - error:not-utf32-string - error:not-utf8-string - error:not-wide-string - guarantee-utf16-be-string - guarantee-utf16-high-surrogate - guarantee-utf16-le-string - guarantee-utf16-low-surrogate - guarantee-utf16-string - guarantee-utf32-be-string - guarantee-utf32-le-string - guarantee-utf32-string - guarantee-utf8-string - guarantee-wide-string - ;; END deprecated bindings - (wide-string->utf16-be-string string->utf16-be-string) - (wide-string->utf16-le-string string->utf16-le-string) - (wide-string->utf16-string string->utf16-string) - (wide-string->utf32-be-string string->utf32-be-string) - (wide-string->utf32-le-string string->utf32-le-string) - (wide-string->utf32-string string->utf32-string) - (wide-string->utf8-string string->utf8-string) - - call-with-utf16-be-input-string - call-with-utf16-be-output-string - call-with-utf16-input-string - call-with-utf16-le-input-string - call-with-utf16-le-output-string - call-with-utf16-output-string - call-with-utf32-be-input-string - call-with-utf32-be-output-string - call-with-utf32-input-string - call-with-utf32-le-input-string - call-with-utf32-le-output-string - call-with-utf32-output-string call-with-utf8-input-string call-with-utf8-output-string - combine-utf16-surrogates for-all-chars-in-string? - for-any-char-in-string? - guarantee-wide-string-index - guarantee-wide-substring make-wide-string - open-utf16-be-input-string - open-utf16-be-output-string - open-utf16-input-string - open-utf16-le-input-string - open-utf16-le-output-string - open-utf16-output-string - open-utf32-be-input-string - open-utf32-be-output-string - open-utf32-input-string - open-utf32-le-input-string - open-utf32-le-output-string - open-utf32-output-string open-utf8-input-string open-utf8-output-string - split-into-utf16-surrogates - string->utf16-be-string - string->utf16-le-string - string->utf16-string - string->utf32-be-string - string->utf32-le-string - string->utf32-string - string->utf8-string string->utf8-string string->wide-string - utf16-be-string->wide-string - utf16-be-string-length - utf16-be-string-valid? - utf16-be-string? - utf16-high-surrogate? - utf16-le-string->wide-string - utf16-le-string-length - utf16-le-string-valid? - utf16-le-string? - utf16-low-surrogate? - utf16-string->wide-string - utf16-string-length - utf16-string-valid? - utf16-string? - utf32-be-string->wide-string - utf32-be-string-length - utf32-be-string-valid? - utf32-be-string? - utf32-le-string->wide-string - utf32-le-string-length - utf32-le-string-valid? - utf32-le-string? - utf32-string->wide-string - utf32-string-length - utf32-string-valid? - utf32-string? utf8-string->string utf8-string->wide-string utf8-string-length @@ -5837,11 +5745,7 @@ USA. wide-string-ref wide-string-set! wide-string? - wide-substring) - (export (runtime generic-i/o-port) - wide-string-contents) - (export (runtime input-port) - wide-string-contents)) + wide-substring)) (define-package (runtime uri) (files "url") diff --git a/src/runtime/string.scm b/src/runtime/string.scm index 5d4b0e16e..4d08ef16c 100644 --- a/src/runtime/string.scm +++ b/src/runtime/string.scm @@ -279,9 +279,9 @@ USA. (define (->utf8-string object) (cond ((string? object) (string->utf8-string object)) ((symbol? object) (symbol-name object)) - ((wide-string? object) (wide-string->utf8-string object)) + ((wide-string? object) (string->utf8-string object)) ((unicode-char? object) - (wide-string->utf8-string (wide-string object))) + (string->utf8-string (wide-string object))) (else (%->string object 'UTF8-STRING)))) (define (%->string object caller) diff --git a/src/runtime/unicode.scm b/src/runtime/unicode.scm index ee9e63cc6..f89480a46 100644 --- a/src/runtime/unicode.scm +++ b/src/runtime/unicode.scm @@ -183,14 +183,14 @@ USA. (%make-wide-string (list->vector chars))) (define (wide-string-length string) - (guarantee-wide-string string 'WIDE-STRING-LENGTH) + (guarantee wide-string? string 'WIDE-STRING-LENGTH) (%wide-string-length string)) (define-integrable (%wide-string-length string) (vector-length (wide-string-contents string))) (define (wide-string-ref string index) - (guarantee-wide-string string 'WIDE-STRING-REF) + (guarantee wide-string? string 'WIDE-STRING-REF) (guarantee-wide-string-index index string 'WIDE-STRING-REF) (%wide-string-ref string index)) @@ -198,7 +198,7 @@ USA. (vector-ref (wide-string-contents string) index)) (define (wide-string-set! string index char) - (guarantee-wide-string string 'WIDE-STRING-SET!) + (guarantee wide-string? string 'WIDE-STRING-SET!) (guarantee-wide-string-index index string 'WIDE-STRING-SET!) (guarantee-unicode-char char 'WIDE-STRING-SET!) (%wide-string-set! string index char)) @@ -240,7 +240,7 @@ USA. (guarantee-wide-substring/fail string start end caller))) (define (guarantee-wide-substring/fail string start end caller) - (guarantee-wide-string string caller) + (guarantee wide-string? string caller) (guarantee-limited-index end (%wide-string-length string) caller) (guarantee-limited-index start end caller)) @@ -543,8 +543,8 @@ USA. (fix:or (fix:lsh b1 8) b0)) (define (combine-utf16-surrogates h l) - (guarantee-utf16-high-surrogate h 'combine-utf16-surrogates) - (guarantee-utf16-low-surrogate l 'combine-utf16-surrogates) + (guarantee utf16-high-surrogate? h 'combine-utf16-surrogates) + (guarantee utf16-low-surrogate? l 'combine-utf16-surrogates) (fix:+ (fix:+ (fix:lsh (fix:and h #x3FF) 10) (fix:and l #x3FF)) #x10000)) diff --git a/src/runtime/url.scm b/src/runtime/url.scm index 4430bc40a..3295d4ad9 100644 --- a/src/runtime/url.scm +++ b/src/runtime/url.scm @@ -46,8 +46,8 @@ USA. (if scheme (guarantee-uri-scheme scheme 'MAKE-URI)) (if authority (guarantee-uri-authority authority 'MAKE-URI)) (guarantee-uri-path path 'MAKE-URI) - (if query (guarantee-utf8-string query 'MAKE-URI)) - (if fragment (guarantee-utf8-string fragment 'MAKE-URI)) + (if query (guarantee utf8-string? query 'MAKE-URI)) + (if fragment (guarantee utf8-string? fragment 'MAKE-URI)) (if (and authority (pair? path) (path-relative? path)) (error:bad-range-argument path 'MAKE-URI)) (let* ((path (remove-dot-segments path)) @@ -184,9 +184,9 @@ USA. '())))) (define (uri-prefix prefix) - (guarantee-utf8-string prefix 'URI-PREFIX) + (guarantee utf8-string? prefix 'URI-PREFIX) (lambda (suffix) - (guarantee-utf8-string suffix 'URI-PREFIX) + (guarantee utf8-string? suffix 'URI-PREFIX) (string->absolute-uri (string-append prefix suffix)))) (define (remove-dot-segments path) @@ -318,7 +318,7 @@ USA. ((symbol? object) (do-string (symbol-name object))) ((wide-string? object) - (let ((string (wide-string->utf8-string object))) + (let ((string (string->utf8-string object))) (or (hash-table/get interned-uris string #f) (do-parse object)))) (else diff --git a/src/xml/rdf-struct.scm b/src/xml/rdf-struct.scm index 159e30630..f44fb9bc5 100644 --- a/src/xml/rdf-struct.scm +++ b/src/xml/rdf-struct.scm @@ -202,7 +202,7 @@ USA. (define-guarantee rdf-literal "RDF literal") (define (make-rdf-literal text type) - (guarantee-utf8-string text 'MAKE-RDF-LITERAL) + (guarantee utf8-string? text 'MAKE-RDF-LITERAL) (let ((type (if (or (not type) (language? type)) @@ -322,7 +322,7 @@ USA. (define (make-rdf-qname prefix local) (guarantee-rdf-prefix prefix 'MAKE-RDF-QNAME) - (guarantee-utf8-string local 'MAKE-RDF-QNAME) + (guarantee utf8-string? local 'MAKE-RDF-QNAME) (if (not (*match-utf8-string match:name local)) (error:bad-range-argument local 'MAKE-RDF-QNAME)) (symbol prefix local)) diff --git a/src/xml/xml-struct.scm b/src/xml/xml-struct.scm index 0513c1695..b5d88ceea 100644 --- a/src/xml/xml-struct.scm +++ b/src/xml/xml-struct.scm @@ -182,7 +182,7 @@ USA. (lambda (port) (write-char object port)))) ((wide-string? object) - (wide-string->utf8-string object)) + (string->utf8-string object)) ((string? object) (cond ((not (utf8-string-valid? object)) (error:wrong-type-datum object "valid UTF-8 XML char data")) -- 2.25.1