From 5ee005743824576af3342677fd6db5737c85aa78 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 22 Feb 2017 02:00:32 -0800 Subject: [PATCH] Move string-match into ustring. --- src/runtime/runtime.pkg | 12 ++---- src/runtime/string.scm | 84 ----------------------------------------- src/runtime/ustring.scm | 34 +++++++++++++++++ 3 files changed, 38 insertions(+), 92 deletions(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 017096073..547d9dfd8 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1038,10 +1038,6 @@ USA. guarantee-substring-start-index reverse-string reverse-substring - string-match-backward - string-match-backward-ci - string-match-forward - string-match-forward-ci string-pad-left string-pad-right string-search-all @@ -1050,10 +1046,6 @@ USA. string-trim string-trim-left string-trim-right - substring-match-backward - substring-match-backward-ci - substring-match-forward - substring-match-forward-ci substring-search-all substring-search-backward substring-search-forward @@ -1134,6 +1126,10 @@ USA. string-length string-lower-case? string-map + string-match-backward + string-match-backward-ci + string-match-forward + string-match-forward-ci string-null? string-prefix-ci? string-prefix? diff --git a/src/runtime/string.scm b/src/runtime/string.scm index 416f638c6..b2a6bac1a 100644 --- a/src/runtime/string.scm +++ b/src/runtime/string.scm @@ -89,90 +89,6 @@ USA. (string-set! result j (string-ref string i))) result))) -(define (string-match-forward string1 string2) - (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD) - (%substring-match-forward string1 0 (string-length string1) - string2 0 (string-length string2))) - -(define (substring-match-forward string1 start1 end1 string2 start2 end2) - (guarantee-2-substrings string1 start1 end1 - string2 start2 end2 - 'SUBSTRING-MATCH-FORWARD) - (%substring-match-forward string1 start1 end1 string2 start2 end2)) - -(define (%substring-match-forward string1 start1 end1 string2 start2 end2) - (let ((end (fix:+ start1 (fix:min (fix:- end1 start1) (fix:- end2 start2))))) - (let loop ((i1 start1) (i2 start2)) - (if (or (fix:= i1 end) - (not (char=? (string-ref string1 i1) - (string-ref string2 i2)))) - (fix:- i1 start1) - (loop (fix:+ i1 1) (fix:+ i2 1)))))) - -(define (string-match-forward-ci string1 string2) - (guarantee-2-strings string1 string2 'STRING-MATCH-FORWARD-CI) - (%substring-match-forward-ci string1 0 (string-length string1) - string2 0 (string-length string2))) - -(define (substring-match-forward-ci string1 start1 end1 string2 start2 end2) - (guarantee-2-substrings string1 start1 end1 - string2 start2 end2 - 'SUBSTRING-MATCH-FORWARD-CI) - (%substring-match-forward-ci string1 start1 end1 string2 start2 end2)) - -(define (%substring-match-forward-ci string1 start1 end1 string2 start2 end2) - (let ((end (fix:+ start1 (fix:min (fix:- end1 start1) (fix:- end2 start2))))) - (let loop ((i1 start1) (i2 start2)) - (if (or (fix:= i1 end) - (not (char-ci=? (string-ref string1 i1) - (string-ref string2 i2)))) - (fix:- i1 start1) - (loop (fix:+ i1 1) (fix:+ i2 1)))))) - -(define (string-match-backward string1 string2) - (guarantee-2-strings string1 string2 'STRING-MATCH-BACKWARD) - (%substring-match-backward string1 0 (string-length string1) - string2 0 (string-length string2))) - -(define (substring-match-backward string1 start1 end1 string2 start2 end2) - (guarantee-2-substrings string1 start1 end1 - string2 start2 end2 - 'SUBSTRING-MATCH-BACKWARD) - (%substring-match-backward string1 start1 end1 string2 start2 end2)) - -(define (%substring-match-backward string1 start1 end1 string2 start2 end2) - (let ((start (fix:- end1 (fix:min (fix:- end1 start1) (fix:- end2 start2))))) - (if (fix:= end1 start) - 0 - (let loop ((i1 (fix:- end1 1)) (i2 (fix:- end2 1))) - (if (char=? (string-ref string1 i1) (string-ref string2 i2)) - (if (fix:= i1 start) - (fix:- end1 i1) - (loop (fix:- i1 1) (fix:- i2 1))) - (fix:- end1 (fix:+ i1 1))))))) - -(define (string-match-backward-ci string1 string2) - (guarantee-2-strings string1 string2 'STRING-MATCH-BACKWARD-CI) - (%substring-match-backward-ci string1 0 (string-length string1) - string2 0 (string-length string2))) - -(define (substring-match-backward-ci string1 start1 end1 string2 start2 end2) - (guarantee-2-substrings string1 start1 end1 - string2 start2 end2 - 'SUBSTRING-MATCH-BACKWARD-CI) - (%substring-match-backward-ci string1 start1 end1 string2 start2 end2)) - -(define (%substring-match-backward-ci string1 start1 end1 string2 start2 end2) - (let ((start (fix:- end1 (fix:min (fix:- end1 start1) (fix:- end2 start2))))) - (if (fix:= end1 start) - 0 - (let loop ((i1 (fix:- end1 1)) (i2 (fix:- end2 1))) - (if (char-ci=? (string-ref string1 i1) (string-ref string2 i2)) - (if (fix:= i1 start) - (fix:- end1 i1) - (loop (fix:- i1 1) (fix:- i2 1))) - (fix:- end1 (fix:+ i1 1))))))) - ;;;; Trim (define (string-trim-left string #!optional char-set) diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm index 9ec0aef21..1f34cc266 100644 --- a/src/runtime/ustring.scm +++ b/src/runtime/ustring.scm @@ -364,6 +364,38 @@ USA. (define string-ci>? (string-comparison-maker %string-ci>?)) (define string-ci>=? (string-comparison-maker %string-ci>=?)) +;;;; Match + +(define (string-match-forward string1 string2) + (let ((end1 (string-length string1)) + (end2 (string-length string2))) + (let ((end (fix:min end1 end2))) + (let loop ((i 0)) + (if (and (fix:< i end) + (char=? (string-ref string1 i) + (string-ref string2 i))) + (loop (fix:+ i 1)) + i))))) + +(define (string-match-forward-ci string1 string2) + (string-match-forward (string-foldcase string1) + (string-foldcase string2))) + +(define (string-match-backward string1 string2) + (let ((s1 (fix:- (string-length string1) 1))) + (let loop ((i s1) (j (fix:- (string-length string2) 1))) + (if (and (fix:>= i 0) + (fix:>= j 0) + (char=? (string-ref string1 i) + (string-ref string2 j))) + (loop (fix:- i 1) + (fix:- j 1)) + (fix:- s1 i))))) + +(define (string-match-backward-ci string1 string2) + (string-match-backward (string-foldcase string1) + (string-foldcase string2))) + (define-integrable (prefix-maker c= caller) (lambda (prefix string #!optional start end) (let* ((end (fix:end-index end (string-length string) caller)) @@ -394,6 +426,8 @@ USA. ;;; Incorrect implementation: should do string-foldcase on both args. (define string-prefix-ci? (prefix-maker char-ci=? 'string-prefix-ci?)) (define string-suffix-ci? (suffix-maker char-ci=? 'string-suffix-ci?)) + +;;;; Case (define (string-downcase string) (case-transform char-downcase-full string)) -- 2.25.1