aboutsummaryrefslogtreecommitdiffstats
path: root/strings.csc
blob: 963565c1546586dd5d0b3da509597e415b933bd6 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(define-library (csc strings)
  (export
    str-find
    str-not-found-error?
    str-prefix?
    str-quote)
  (import (scheme base)
          (scheme case-lambda)
          (only (scheme write) write))
  (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 (str-quote s)
      (let ((out (open-output-string)))
        (write s out)
        (get-output-string out)))


    (define-record-type <str-not-found-error>
      (make-str-not-found-error)
      str-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)))))))