aboutsummaryrefslogtreecommitdiffstats
path: root/csc/strings.csc
blob: 255a2fdc552e0118426b6db31cbc2a34ca439c4e (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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(define-library (csc strings)
  (export
    contains?
    has-prefix?
    index
    join
    split
    str-quote)
  (import (scheme base)
          (only (scheme case-lambda) case-lambda)
          (only (scheme write) write)
          (only (csc list) intercalate)
          (only (csc loop)
            loop
            return))
  (begin


    (define (has-prefix? str prefix)
      (and (<= (string-length prefix) (string-length str))
           (string=? prefix (substring str 0 (string-length prefix)))))


    (define (str-quote s)
      (let ((out (open-output-string)))
        (write s out)
        (get-output-string out)))


    (define (index s substr)
      (loop for i from 0
            for s = s then (string-copy s 1)
            until (string=? "" s)
            if (has-prefix? s substr)
              return i
            finally (return -1)))


    (define (contains? s substr)
      (if (string=? "" substr)
        #t
        (not (negative? (index s substr)))))


    (define (join sep strings)
      (apply string-append (intercalate sep strings)))


    (define split
      (case-lambda
        ((s sep n)
          (if (= 0 n)
            '()
            (loop for n = n then (- n 1)
                  for s = s then (string-copy s (+ i (string-length sep)))
                  for i = (let ((i (index s sep)))
                            (if (or (negative? i)
                                    (= 1 n))
                              (string-length s)
                              i))
                  collect (substring s 0 i)
                  while (< i (string-length s)))))
        ((s sep)
          (split s sep -1))))))