diff options
| -rw-r--r-- | format.csc | 22 | ||||
| -rw-r--r-- | strings-test.csc | 26 | ||||
| -rw-r--r-- | strings.csc | 44 |
3 files changed, 45 insertions, 47 deletions
@@ -6,9 +6,9 @@ (import (scheme base) (only (scheme write) display) (only (csc strings) - str-find - str-not-found-error? - str-prefix?)) + find + not-found-error? + prefix?)) (begin @@ -16,24 +16,24 @@ (let loop ((start 0) (args format-args)) (cond ((>= start (string-length format-string))) - ((str-prefix? "{{" format-string start) + ((prefix? "{{" format-string start) (write-string "{" port) (loop (+ 2 start) args)) - ((str-prefix? "}}" format-string start) + ((prefix? "}}" format-string start) (write-string "}" port) (loop (+ 2 start) args)) - ((str-prefix? "{}" format-string start) + ((prefix? "{}" format-string start) (display (car args) port) (loop (+ 2 start) (cdr args))) - ((str-prefix? "{" format-string start) + ((prefix? "{" format-string start) (raise (error "invalid format string" format-string))) (else (let* ((open-brace-pos (guard (e - ((str-not-found-error? e) (string-length format-string))) - (str-find "{" format-string start))) + ((not-found-error? e) (string-length format-string))) + (find "{" format-string start))) (close-brace-pos (guard (e - ((str-not-found-error? e) (string-length format-string))) - (str-find "}" format-string start))) + ((not-found-error? e) (string-length format-string))) + (find "}" format-string start))) (format-pos (min open-brace-pos close-brace-pos))) (write-string format-string port start format-pos) (loop format-pos args)))))) diff --git a/strings-test.csc b/strings-test.csc index 4d7a751..3fededb 100644 --- a/strings-test.csc +++ b/strings-test.csc @@ -6,16 +6,16 @@ (csc strings)) -(test str-prefix?-good - (assert-equal #t (str-prefix? "asdf" "asdfjkl;"))) +(test prefix?-good + (assert-equal #t (prefix? "asdf" "asdfjkl;"))) -(test str-prefix?-bad - (assert-equal #f (str-prefix? "asdf" "asdbjkl;"))) +(test prefix?-bad + (assert-equal #f (prefix? "asdf" "asdbjkl;"))) -(test str-prefix?-too-long - (assert-equal #f (str-prefix? "asdf" "as"))) +(test prefix?-too-long + (assert-equal #f (prefix? "asdf" "as"))) (test str-quote-simple @@ -26,12 +26,12 @@ (assert-equal "\"this string \\\" has a quote\"" (str-quote "this string \" has a quote"))) -(test str-find-ok - (assert-equal 8 (str-find "abc" "dabsadfdabcdfdfd"))) +(test find-ok + (assert-equal 8 (find "abc" "dabsadfdabcdfdfd"))) -(test str-find-one-letter - (assert-equal 8 (str-find "a" "sdfdfdfsasdfe"))) +(test find-one-letter + (assert-equal 8 (find "a" "sdfdfdfsasdfe"))) (test test-str-find-notfound @@ -39,6 +39,6 @@ (str "def") (got-exception '())) (guard (e - ((str-not-found-error? e) (set! got-exception e))) - (str-find match str)) - (assert (str-not-found-error? got-exception)))) + ((not-found-error? e) (set! got-exception e))) + (find match str)) + (assert (not-found-error? got-exception)))) diff --git a/strings.csc b/strings.csc index 963565c..0828363 100644 --- a/strings.csc +++ b/strings.csc @@ -1,8 +1,8 @@ (define-library (csc strings) (export - str-find - str-not-found-error? - str-prefix? + find + not-found-error? + prefix? str-quote) (import (scheme base) (scheme case-lambda) @@ -10,13 +10,12 @@ (begin - (define str-prefix? - (let ((str-prefix?' (lambda (prefix str start) - (and (<= (string-length prefix) (- (string-length str) start)) - (string=? prefix (substring str start (+ start (string-length prefix)))))))) - (case-lambda - ((prefix str) (str-prefix?' prefix str 0)) - ((prefix str start) (str-prefix?' prefix str start))))) + (define prefix? + (case-lambda + ((prefix str) (prefix? prefix str 0)) + ((prefix str start) + (and (<= (string-length prefix) (- (string-length str) start)) + (string=? prefix (substring str start (+ start (string-length prefix)))))))) (define (str-quote s) @@ -25,18 +24,17 @@ (get-output-string out))) - (define-record-type <str-not-found-error> - (make-str-not-found-error) - str-not-found-error?) + (define-record-type <not-found-error> + (make-not-found-error) + not-found-error?) - (define str-find - (let ((str-find' (lambda (match str start end) - (let loop ((i start)) - (cond ((>= i end) (raise (make-str-not-found-error))) - ((str-prefix? match str i) i) - (else (loop (+ 1 i)))))))) - (case-lambda - ((match str) (str-find' match str 0 (string-length str))) - ((match str start) (str-find' match str start (string-length str))) - ((match str start end) (str-find' match str start end))))))) + (define find + (case-lambda + ((match str) (find match str 0 (string-length str))) + ((match str start) (find match str start (string-length str))) + ((match str start end) + (let loop ((i start)) + (cond ((>= i end) (raise (make-not-found-error))) + ((prefix? match str i) i) + (else (loop (+ 1 i)))))))))) |