module/ice-9/string-fun.scm

   1 ;;;; string-fun.scm --- string manipulation functions
   2 ;;;;
   3 ;;;;    Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 ;;;;
  19 \f
  20 (define-module (ice-9 string-fun)
  21   :export (split-after-char split-before-char split-discarding-char
  22            split-after-char-last split-before-char-last
  23            split-discarding-char-last split-before-predicate
  24            split-after-predicate split-discarding-predicate
  25            separate-fields-discarding-char separate-fields-after-char
  26            separate-fields-before-char string-prefix-predicate string-prefix=?
  27            sans-surrounding-whitespace sans-trailing-whitespace
  28            sans-leading-whitespace sans-final-newline has-trailing-newline?))
  29
  30 ;;;;
  31 ;;;
  32 ;;; Various string funcitons, particularly those that take
  33 ;;; advantage of the "shared substring" capability.
  34 ;;;
  35 \f
  36 ;;; {String Fun: Dividing Strings Into Fields}
  37 ;;;
  38 ;;; The names of these functions are very regular.
  39 ;;; Here is a grammar of a call to one of these:
  40 ;;;
  41 ;;;   <string-function-invocation>
  42 ;;;   := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>)
  43 ;;;
  44 ;;; <str>    = the string
  45 ;;;
  46 ;;; <ret>    = The continuation.  String functions generally return
  47 ;;;            multiple values by passing them to this procedure.
  48 ;;;
  49 ;;; <action> =    split
  50 ;;;             | separate-fields
  51 ;;;
  52 ;;;             "split" means to divide a string into two parts.
  53 ;;;                     <ret> will be called with two arguments.
  54 ;;;
  55 ;;;             "separate-fields" means to divide a string into as many
  56 ;;;                     parts as possible.  <ret> will be called with
  57 ;;;                     however many fields are found.
  58 ;;;
  59 ;;; <seperator-disposition> =     before
  60 ;;;                             | after
  61 ;;;                             | discarding
  62 ;;;
  63 ;;;             "before" means to leave the seperator attached to
  64 ;;;                     the beginning of the field to its right.
  65 ;;;             "after" means to leave the seperator attached to
  66 ;;;                     the end of the field to its left.
  67 ;;;             "discarding" means to discard seperators.
  68 ;;;
  69 ;;;             Other dispositions might be handy.  For example, "isolate"
  70 ;;;             could mean to treat the separator as a field unto itself.
  71 ;;;
  72 ;;; <seperator-determination> =   char
  73 ;;;                             | predicate
  74 ;;;
  75 ;;;             "char" means to use a particular character as field seperator.
  76 ;;;             "predicate" means to check each character using a particular predicate.
  77 ;;;
  78 ;;;             Other determinations might be handy.  For example, "character-set-member".
  79 ;;;
  80 ;;; <seperator-param> = A parameter that completes the meaning of the determinations.
  81 ;;;                     For example, if the determination is "char", then this parameter
  82 ;;;                     says which character.  If it is "predicate", the parameter is the
  83 ;;;                     predicate.
  84 ;;;
  85 ;;;
  86 ;;; For example:
  87 ;;;
  88 ;;;             (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list)
  89 ;;;             => ("foo" " bar" " baz" " " " bat")
  90 ;;;
  91 ;;;             (split-after-char #\- 'an-example-of-split list)
  92 ;;;             => ("an-" "example-of-split")
  93 ;;;
  94 ;;; As an alternative to using a determination "predicate", or to trying to do anything
  95 ;;; complicated with these functions, consider using regular expressions.
  96 ;;;
  97
  98 (define (split-after-char char str ret)
  99   (let ((end (cond
 100               ((string-index str char) => 1+)
 101               (else (string-length str)))))
 102     (ret (substring str 0 end)
 103          (substring str end))))
 104
 105 (define (split-before-char char str ret)
 106   (let ((end (or (string-index str char)
 107                  (string-length str))))
 108     (ret (substring str 0 end)
 109          (substring str end))))
 110
 111 (define (split-discarding-char char str ret)
 112   (let ((end (string-index str char)))
 113     (if (not end)
 114         (ret str "")
 115         (ret (substring str 0 end)
 116              (substring str (1+ end))))))
 117
 118 (define (split-after-char-last char str ret)
 119   (let ((end (cond
 120               ((string-rindex str char) => 1+)
 121               (else 0))))
 122     (ret (substring str 0 end)
 123          (substring str end))))
 124
 125 (define (split-before-char-last char str ret)
 126   (let ((end (or (string-rindex str char) 0)))
 127     (ret (substring str 0 end)
 128          (substring str end))))
 129
 130 (define (split-discarding-char-last char str ret)
 131   (let ((end (string-rindex str char)))
 132     (if (not end)
 133         (ret str "")
 134         (ret (substring str 0 end)
 135              (substring str (1+ end))))))
 136
 137 (define (split-before-predicate pred str ret)
 138   (let loop ((n 0))
 139     (cond
 140      ((= n (string-length str))         (ret str ""))
 141      ((not (pred (string-ref str n)))   (loop (1+ n)))
 142      (else                              (ret (substring str 0 n)
 143                                              (substring str n))))))
 144 (define (split-after-predicate pred str ret)
 145   (let loop ((n 0))
 146     (cond
 147      ((= n (string-length str))         (ret str ""))
 148      ((not (pred (string-ref str n)))   (loop (1+ n)))
 149      (else                              (ret (substring str 0 (1+ n))
 150                                              (substring str (1+ n)))))))
 151
 152 (define (split-discarding-predicate pred str ret)
 153   (let loop ((n 0))
 154     (cond
 155      ((= n (string-length str))         (ret str ""))
 156      ((not (pred (string-ref str n)))   (loop (1+ n)))
 157      (else                              (ret (substring str 0 n)
 158                                              (substring str (1+ n)))))))
 159
 160 (define (separate-fields-discarding-char ch str ret)
 161   (let loop ((fields '())
 162              (str str))
 163     (cond
 164      ((string-rindex str ch)
 165       => (lambda (w) (loop (cons (substring str (+ 1 w)) fields)
 166                            (substring str 0 w))))
 167      (else (apply ret str fields)))))
 168
 169 (define (separate-fields-after-char ch str ret)
 170   (reverse
 171    (let loop ((fields '())
 172              (str str))
 173      (cond
 174       ((string-index str ch)
 175        => (lambda (w) (loop (cons (substring str 0 (+ 1 w)) fields)
 176                            (substring str (+ 1 w)))))
 177       (else (apply ret str fields))))))
 178
 179 (define (separate-fields-before-char ch str ret)
 180   (let loop ((fields '())
 181              (str str))
 182     (cond
 183      ((string-rindex str ch)
 184       => (lambda (w) (loop (cons (substring str w) fields)
 185                              (substring str 0 w))))
 186      (else (apply ret str fields)))))
 187
 188 \f
 189 ;;; {String Fun: String Prefix Predicates}
 190 ;;;
 191 ;;; Very simple:
 192 ;;;
 193 ;;; (define-public ((string-prefix-predicate pred?) prefix str)
 194 ;;;  (and (<= (string-length prefix) (string-length str))
 195 ;;;       (pred? prefix (substring str 0 (string-length prefix)))))
 196 ;;;
 197 ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
 198 ;;;
 199
 200 (define (string-prefix-predicate pred?)
 201   (lambda (prefix str)
 202     (and (<= (string-length prefix) (string-length str))
 203          (pred? prefix (substring str 0 (string-length prefix))))))
 204
 205 (define string-prefix=? (string-prefix-predicate string=?))
 206
 207 \f
 208 ;;; {String Fun: Strippers}
 209 ;;;
 210 ;;; <stripper> = sans-<removable-part>
 211 ;;;
 212 ;;; <removable-part> =    surrounding-whitespace
 213 ;;;                     | trailing-whitespace
 214 ;;;                     | leading-whitespace
 215 ;;;                     | final-newline
 216 ;;;
 217
 218 (define (sans-surrounding-whitespace s)
 219   (let ((st 0)
 220         (end (string-length s)))
 221     (while (and (< st (string-length s))
 222                 (char-whitespace? (string-ref s st)))
 223            (set! st (1+ st)))
 224     (while (and (< 0 end)
 225                 (char-whitespace? (string-ref s (1- end))))
 226            (set! end (1- end)))
 227     (if (< end st)
 228         ""
 229         (substring s st end))))
 230
 231 (define (sans-trailing-whitespace s)
 232   (let ((st 0)
 233         (end (string-length s)))
 234     (while (and (< 0 end)
 235                 (char-whitespace? (string-ref s (1- end))))
 236            (set! end (1- end)))
 237     (if (< end st)
 238         ""
 239         (substring s st end))))
 240
 241 (define (sans-leading-whitespace s)
 242   (let ((st 0)
 243         (end (string-length s)))
 244     (while (and (< st (string-length s))
 245                 (char-whitespace? (string-ref s st)))
 246            (set! st (1+ st)))
 247     (if (< end st)
 248         ""
 249         (substring s st end))))
 250
 251 (define (sans-final-newline str)
 252   (cond
 253    ((= 0 (string-length str))
 254     str)
 255
 256    ((char=? #\nl (string-ref str (1- (string-length str))))
 257     (substring str 0 (1- (string-length str))))
 258
 259    (else str)))
 260 \f
 261 ;;; {String Fun: has-trailing-newline?}
 262 ;;;
 263
 264 (define (has-trailing-newline? str)
 265   (and (< 0 (string-length str))
 266        (char=? #\nl (string-ref str (1- (string-length str))))))
 267
 268
 269 \f
 270 ;;; {String Fun: with-regexp-parts}
 271
 272 ;;; This relies on the older, hairier regexp interface, which we don't
 273 ;;; particularly want to implement, and it's not used anywhere, so
 274 ;;; we're just going to drop it for now.
 275 ;;; (define-public (with-regexp-parts regexp fields str return fail)
 276 ;;;   (let ((parts (regexec regexp str fields)))
 277 ;;;     (if (number? parts)
 278 ;;;         (fail parts)
 279 ;;;         (apply return parts))))
 280