From 3dbdfc908d7f08a3c979a976f11faf28f5c1e94a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 17 Feb 2017 19:58:14 -0800 Subject: [PATCH] Begin process of replacing string operations with ustring equivalents. --- src/runtime/arith.scm | 4 ++-- src/runtime/chrset.scm | 2 +- src/runtime/dragon4.scm | 2 +- src/runtime/hashtb.scm | 11 ++++----- src/runtime/rgxcmp.scm | 4 ++-- src/runtime/runtime.pkg | 49 +++++++++++++++++++++++++++-------------- src/runtime/ustring.scm | 3 +++ 7 files changed, 46 insertions(+), 29 deletions(-) diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 5603e4933..4f189cec5 100644 --- a/src/runtime/arith.scm +++ b/src/runtime/arith.scm @@ -468,9 +468,9 @@ USA. (cond ((not (int:integer? number)) (error:wrong-type-argument number #f 'NUMBER->STRING)) ((int:negative? number) - (list->string (cons #\- (n>0 (int:negate number))))) + (list->ustring (cons #\- (n>0 (int:negate number))))) (else - (list->string (n>0 number))))) + (list->ustring (n>0 number))))) (declare (integrate-operator rat:rational?)) (define (rat:rational? object) diff --git a/src/runtime/chrset.scm b/src/runtime/chrset.scm index 9b27294bd..fc4293192 100644 --- a/src/runtime/chrset.scm +++ b/src/runtime/chrset.scm @@ -533,7 +533,7 @@ USA. ;; Returns ASCII string: (define (char-set->string char-set) - (list->string (char-set-members char-set))) + (list->ustring (char-set-members char-set))) ;; Returns only ASCII members: (define (char-set-members char-set) diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm index c09572add..b033a894d 100644 --- a/src/runtime/dragon4.scm +++ b/src/runtime/dragon4.scm @@ -80,7 +80,7 @@ not much different to numbers within a few orders of magnitude of 1. (dragon4 f e p radix cutoff-mode cutoff (lambda (u k generate) (let ((digits - (list->string + (list->ustring (let loop ((u u) (k k) (generate generate)) k ;ignore (if (negative? u) diff --git a/src/runtime/hashtb.scm b/src/runtime/hashtb.scm index 0eeebc207..dd3b6642a 100644 --- a/src/runtime/hashtb.scm +++ b/src/runtime/hashtb.scm @@ -1299,13 +1299,10 @@ USA. (make-hash-table-type key-hash key=? (if (and (or (eq? key=? string=?) - (eq? key=? string-ci=?) - (eq? key=? ustring=?)) - (or (eq? key-hash string-hash-mod) - (eq? key-hash string-hash) - (eq? key-hash ustring-hash) - (eq? key-hash hash) - (eq? key-hash string-ci-hash))) + (eq? key=? string-ci=?)) + (or (eq? key-hash string-hash) + (eq? key-hash string-ci-hash) + (eq? key-hash hash))) #f ;No rehash needed after GC #t) ;Rehash needed after GC hash-table-entry-type:strong)) diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm index 30c69a05e..2f3ab92c5 100644 --- a/src/runtime/rgxcmp.scm +++ b/src/runtime/rgxcmp.scm @@ -380,7 +380,7 @@ USA. (if (not (stack-empty? ctx)) (compilation-error ctx "Unmatched \\(")) (make-compiled-regexp - (list->string (map integer->char (cdr (output-head ctx)))) + (list->ustring (map integer->char (cdr (output-head ctx)))) case-fold?)) (begin (compile-pattern-char ctx) @@ -695,7 +695,7 @@ USA. (char->integer char))) (char-set-members (re-compile-char-set - (list->string (map integer->char (reverse! chars))) + (list->ustring (map integer->char (reverse! chars))) #f)))) (loop (cons char chars))))) (output-start! ctx (if invert? re-code:not-char-set re-code:char-set)) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 50c6df73d..2539d8aee 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1050,7 +1050,7 @@ USA. guarantee-substring-end-index guarantee-substring-start-index lisp-string->camel-case - list->string + ;;list->string make-string reverse-string reverse-string! @@ -1058,19 +1058,19 @@ USA. reverse-substring! set-string-length! string - string->list - string->vector + ;;string->list + ;;string->vector string-allocate string-append string-capitalize string-capitalize! string-capitalized? - string-ci-hash - string-ci<=? - string-ci=? - string-ci>? + ;; string-ci-hash + ;; string-ci<=? + ;; string-ci=? + ;; string-ci>? string-compare string-compare-ci string-copy @@ -1085,8 +1085,8 @@ USA. string-find-previous-char-ci string-find-previous-char-in-set string-for-each - string-hash - string-hash-mod + ;; string-hash + ;; string-hash-mod string-head string-head! string-joiner @@ -1122,11 +1122,11 @@ USA. string-upcase string-upcase! string-upper-case? - string<=? - string=? - string>? + ;; string<=? + ;; string=? + ;; string>? string? substring substring->list @@ -1170,6 +1170,22 @@ USA. (files "ustring") (parent (runtime)) (export () + (list->string list->ustring) + (string->list ustring->list) + (string->vector ustring->vector) + (string-ci-hash ustring-ci-hash) + (string-ci<=? ustring-ci<=?) + (string-ci=? ustring-ci>=?) + (string-ci>? ustring-ci>?) + (string-hash ustring-hash) + (string-hash-mod ustring-hash) + (string<=? ustring<=?) + (string=? ustring>=?) + (string>? ustring>?) (usubstring ustring-copy) list->ustring make-ustring @@ -1186,6 +1202,7 @@ USA. ustring-ci=? ustring-ci>=? ustring-ci>? + ustring-ci-hash ustring-copy ustring-copy! ustring-downcase diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm index 677f569b4..493e59c5d 100644 --- a/src/runtime/ustring.scm +++ b/src/runtime/ustring.scm @@ -614,6 +614,9 @@ USA. ((ucode-primitive string-hash) string*) ((ucode-primitive string-hash-mod) string* modulus)))) +(define (ustring-ci-hash string #!optional modulus) + (ustring-hash (ustring-foldcase string) modulus)) + (define (ustring->legacy-string string) (if (legacy-string? string) string -- 2.25.1