From ecc87c5341839caaa847cdee1f330b1e41de7971 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 22 Feb 2017 01:48:40 -0800 Subject: [PATCH] Move string-compare into ustring and merge with order predicates. --- src/runtime/runtime.pkg | 4 +-- src/runtime/string.scm | 50 ---------------------------- src/runtime/ustring.scm | 72 +++++++++++++++++++++++++---------------- 3 files changed, 46 insertions(+), 80 deletions(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index becea1c84..017096073 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1038,8 +1038,6 @@ USA. guarantee-substring-start-index reverse-string reverse-substring - string-compare - string-compare-ci string-match-backward string-match-backward-ci string-match-forward @@ -1116,6 +1114,8 @@ USA. string-ci=? string-ci>=? string-ci>? + string-compare + string-compare-ci string-copy string-copy! string-count diff --git a/src/runtime/string.scm b/src/runtime/string.scm index 80f230186..416f638c6 100644 --- a/src/runtime/string.scm +++ b/src/runtime/string.scm @@ -89,56 +89,6 @@ USA. (string-set! result j (string-ref string i))) result))) -;;;; Compare - -(define (string-compare string1 string2 if= if< if>) - (guarantee-2-strings string1 string2 'STRING-COMPARE) - (%string-compare string1 string2 if= if< if>)) - -(define (%string-compare string1 string2 if= if< if>) - (let ((length1 (string-length string1)) - (length2 (string-length string2))) - (let ((end (fix:min length1 length2))) - (let loop ((index 0)) - (cond ((fix:= index end) - (if (fix:= index length1) - (if (fix:= index length2) - (if=) - (if<)) - (if>))) - ((char=? (string-ref string1 index) - (string-ref string2 index)) - (loop (fix:+ index 1))) - ((char))))))) - -(define (string-compare-ci string1 string2 if= if< if>) - (guarantee-2-strings string1 string2 'STRING-COMPARE-CI) - (%string-compare-ci string1 string2 if= if< if>)) - -(define (%string-compare-ci string1 string2 if= if< if>) - (let ((length1 (string-length string1)) - (length2 (string-length string2))) - (let ((end (fix:min length1 length2))) - (let loop ((index 0)) - (cond ((fix:= index end) - (if (fix:= index length1) - (if (fix:= index length2) - (if=) - (if<)) - (if>))) - ((char-ci=? (string-ref string1 index) - (string-ref string2 index)) - (loop (fix:+ index 1))) - ((char-ci))))))) - (define (string-match-forward string1 string2) (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD) (%substring-match-forward string1 0 (string-length string1) diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm index c3663c4f9..9ec0aef21 100644 --- a/src/runtime/ustring.scm +++ b/src/runtime/ustring.scm @@ -296,37 +296,53 @@ USA. (define (string-tail string start) (string-copy string start)) +;;;; Compare + ;; Non-Unicode implementation, acceptable to R7RS. -(define-integrable (%string-comparison-maker c= c< f<) +(define-integrable (string-compare string1 string2 if= if< if>) + (let ((end1 (string-length string1)) + (end2 (string-length string2))) + (let ((end (fix:min end1 end2))) + (let loop ((i 0)) + (if (fix:< i end) + (let ((c1 (string-ref string1 i)) + (c2 (string-ref string2 i))) + (cond ((char)) + (else (loop (fix:+ i 1))))) + (cond ((fix:< end1 end2) (if<)) + ((fix:< end2 end1) (if>)) + (else (if=)))))))) + +(define-integrable (string-compare-ci string1 string2 if= if< if>) + (string-compare (string-foldcase string1) + (string-foldcase string2) + if= + if< + if>)) + +(define-integrable (true) #t) +(define-integrable (false) #f) + +(define-integrable (%string-comparison-maker if= if< if>) (lambda (string1 string2) - (let ((end1 (string-length string1)) - (end2 (string-length string2))) - (let ((end (fix:min end1 end2))) - (let loop ((i 0)) - (if (fix:< i end) - (let ((c1 (string-ref string1 i)) - (c2 (string-ref string2 i))) - (if (c= c1 c2) - (loop (fix:+ i 1)) - (c< c1 c2))) - (f< end1 end2))))))) - -(define %string? (%string-comparison-maker char=? char>? fix:>)) -(define %string>=? (%string-comparison-maker char=? char>=? fix:<=)) - -(define-integrable (%string-ci-comparison-maker string-compare) + (string-compare string1 string2 if= if< if>))) + +(define %string=? (%string-comparison-maker true false false)) +(define %string? (%string-comparison-maker false false true)) +(define %string>=? (%string-comparison-maker true false true)) + +(define-integrable (%string-ci-comparison-maker if= if< if>) (lambda (string1 string2) - (string-compare (string-foldcase string1) - (string-foldcase string2)))) - -(define %string-ci? (%string-ci-comparison-maker %string>?)) -(define %string-ci>=? (%string-ci-comparison-maker %string>=?)) + (string-compare-ci string1 string2 if= if< if>))) + +(define %string-ci=? (%string-ci-comparison-maker true false false)) +(define %string-ci? (%string-ci-comparison-maker false false true)) +(define %string-ci>=? (%string-ci-comparison-maker true false true)) (define-integrable (string-comparison-maker %compare) (lambda (string1 string2 . strings) -- 2.25.1