Artifact
3543121e338032d3eaf6ab33d4bcee0483349a0f:
- File
srfi/s13/strings.sls
— part of check-in
[80c8c83034]
at
2016-07-07 18:11:39
on branch trunk
— initial import
(user:
ovenpasta@pizzahack.eu
size: 2999)
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 ;; Copyright (c)
0010: 20 32 30 30 39 20 44 65 72 69 63 6b 20 45 64 64 2009 Derick Edd
0020: 69 6e 67 74 6f 6e 2e 20 20 41 6c 6c 20 72 69 67 ington. All rig
0030: 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b hts reserved..;;
0040: 20 4c 69 63 65 6e 73 65 64 20 75 6e 64 65 72 20 Licensed under
0050: 61 6e 20 4d 49 54 2d 73 74 79 6c 65 20 6c 69 63 an MIT-style lic
0060: 65 6e 73 65 2e 20 20 4d 79 20 6c 69 63 65 6e 73 ense. My licens
0070: 65 20 69 73 20 69 6e 20 74 68 65 20 66 69 6c 65 e is in the file
0080: 0a 3b 3b 20 6e 61 6d 65 64 20 4c 49 43 45 4e 53 .;; named LICENS
0090: 45 20 66 72 6f 6d 20 74 68 65 20 6f 72 69 67 69 E from the origi
00a0: 6e 61 6c 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 74 nal collection t
00b0: 68 69 73 20 66 69 6c 65 20 69 73 20 64 69 73 74 his file is dist
00c0: 72 69 62 75 74 65 64 0a 3b 3b 20 77 69 74 68 2e ributed.;; with.
00d0: 20 20 49 66 20 74 68 69 73 20 66 69 6c 65 20 69 If this file i
00e0: 73 20 72 65 64 69 73 74 72 69 62 75 74 65 64 20 s redistributed
00f0: 77 69 74 68 20 73 6f 6d 65 20 6f 74 68 65 72 20 with some other
0100: 63 6f 6c 6c 65 63 74 69 6f 6e 2c 20 6d 79 0a 3b collection, my.;
0110: 3b 20 6c 69 63 65 6e 73 65 20 6d 75 73 74 20 61 ; license must a
0120: 6c 73 6f 20 62 65 20 69 6e 63 6c 75 64 65 64 2e lso be included.
0130: 0a 0a 23 21 72 36 72 73 0a 28 6c 69 62 72 61 72 ..#!r6rs.(librar
0140: 79 20 28 73 72 66 69 20 73 31 33 20 73 74 72 69 y (srfi s13 stri
0150: 6e 67 73 29 0a 20 20 28 65 78 70 6f 72 74 0a 20 ngs). (export.
0160: 20 20 20 73 74 72 69 6e 67 2d 6d 61 70 20 73 74 string-map st
0170: 72 69 6e 67 2d 6d 61 70 21 0a 20 20 20 20 73 74 ring-map!. st
0180: 72 69 6e 67 2d 66 6f 6c 64 20 20 20 20 20 20 20 ring-fold
0190: 73 74 72 69 6e 67 2d 75 6e 66 6f 6c 64 0a 20 20 string-unfold.
01a0: 20 20 73 74 72 69 6e 67 2d 66 6f 6c 64 2d 72 69 string-fold-ri
01b0: 67 68 74 20 73 74 72 69 6e 67 2d 75 6e 66 6f 6c ght string-unfol
01c0: 64 2d 72 69 67 68 74 20 0a 20 20 20 20 73 74 72 d-right . str
01d0: 69 6e 67 2d 74 61 62 75 6c 61 74 65 20 73 74 72 ing-tabulate str
01e0: 69 6e 67 2d 66 6f 72 2d 65 61 63 68 20 73 74 72 ing-for-each str
01f0: 69 6e 67 2d 66 6f 72 2d 65 61 63 68 2d 69 6e 64 ing-for-each-ind
0200: 65 78 0a 20 20 20 20 73 74 72 69 6e 67 2d 65 76 ex. string-ev
0210: 65 72 79 20 73 74 72 69 6e 67 2d 61 6e 79 0a 20 ery string-any.
0220: 20 20 20 73 74 72 69 6e 67 2d 68 61 73 68 20 73 string-hash s
0230: 74 72 69 6e 67 2d 68 61 73 68 2d 63 69 0a 20 20 tring-hash-ci.
0240: 20 20 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 string-compare
0250: 20 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 2d string-compare-
0260: 63 69 0a 20 20 20 20 73 74 72 69 6e 67 3d 20 20 ci. string=
0270: 20 20 73 74 72 69 6e 67 3c 20 20 20 20 73 74 72 string< str
0280: 69 6e 67 3e 20 20 20 20 73 74 72 69 6e 67 3c 3d ing> string<=
0290: 20 20 20 20 73 74 72 69 6e 67 3e 3d 20 20 20 20 string>=
02a0: 73 74 72 69 6e 67 3c 3e 0a 20 20 20 20 73 74 72 string<>. str
02b0: 69 6e 67 2d 63 69 3d 20 73 74 72 69 6e 67 2d 63 ing-ci= string-c
02c0: 69 3c 20 73 74 72 69 6e 67 2d 63 69 3e 20 73 74 i< string-ci> st
02d0: 72 69 6e 67 2d 63 69 3c 3d 20 73 74 72 69 6e 67 ring-ci<= string
02e0: 2d 63 69 3e 3d 20 73 74 72 69 6e 67 2d 63 69 3c -ci>= string-ci<
02f0: 3e 20 0a 20 20 20 20 73 74 72 69 6e 67 2d 64 6f > . string-do
0300: 77 6e 63 61 73 65 20 20 73 74 72 69 6e 67 2d 75 wncase string-u
0310: 70 63 61 73 65 20 20 73 74 72 69 6e 67 2d 74 69 pcase string-ti
0320: 74 6c 65 63 61 73 65 20 20 0a 20 20 20 20 73 74 tlecase . st
0330: 72 69 6e 67 2d 64 6f 77 6e 63 61 73 65 21 20 73 ring-downcase! s
0340: 74 72 69 6e 67 2d 75 70 63 61 73 65 21 20 73 74 tring-upcase! st
0350: 72 69 6e 67 2d 74 69 74 6c 65 63 61 73 65 21 20 ring-titlecase!
0360: 0a 20 20 20 20 73 74 72 69 6e 67 2d 74 61 6b 65 . string-take
0370: 20 73 74 72 69 6e 67 2d 74 61 6b 65 2d 72 69 67 string-take-rig
0380: 68 74 0a 20 20 20 20 73 74 72 69 6e 67 2d 64 72 ht. string-dr
0390: 6f 70 20 73 74 72 69 6e 67 2d 64 72 6f 70 2d 72 op string-drop-r
03a0: 69 67 68 74 0a 20 20 20 20 73 74 72 69 6e 67 2d ight. string-
03b0: 70 61 64 20 73 74 72 69 6e 67 2d 70 61 64 2d 72 pad string-pad-r
03c0: 69 67 68 74 0a 20 20 20 20 73 74 72 69 6e 67 2d ight. string-
03d0: 74 72 69 6d 20 73 74 72 69 6e 67 2d 74 72 69 6d trim string-trim
03e0: 2d 72 69 67 68 74 20 73 74 72 69 6e 67 2d 74 72 -right string-tr
03f0: 69 6d 2d 62 6f 74 68 0a 20 20 20 20 73 74 72 69 im-both. stri
0400: 6e 67 2d 66 69 6c 74 65 72 20 73 74 72 69 6e 67 ng-filter string
0410: 2d 64 65 6c 65 74 65 0a 20 20 20 20 73 74 72 69 -delete. stri
0420: 6e 67 2d 69 6e 64 65 78 20 73 74 72 69 6e 67 2d ng-index string-
0430: 69 6e 64 65 78 2d 72 69 67 68 74 20 0a 20 20 20 index-right .
0440: 20 73 74 72 69 6e 67 2d 73 6b 69 70 20 20 73 74 string-skip st
0450: 72 69 6e 67 2d 73 6b 69 70 2d 72 69 67 68 74 0a ring-skip-right.
0460: 20 20 20 20 73 74 72 69 6e 67 2d 63 6f 75 6e 74 string-count
0470: 0a 20 20 20 20 73 74 72 69 6e 67 2d 70 72 65 66 . string-pref
0480: 69 78 2d 6c 65 6e 67 74 68 20 73 74 72 69 6e 67 ix-length string
0490: 2d 70 72 65 66 69 78 2d 6c 65 6e 67 74 68 2d 63 -prefix-length-c
04a0: 69 0a 20 20 20 20 73 74 72 69 6e 67 2d 73 75 66 i. string-suf
04b0: 66 69 78 2d 6c 65 6e 67 74 68 20 73 74 72 69 6e fix-length strin
04c0: 67 2d 73 75 66 66 69 78 2d 6c 65 6e 67 74 68 2d g-suffix-length-
04d0: 63 69 0a 20 20 20 20 73 74 72 69 6e 67 2d 70 72 ci. string-pr
04e0: 65 66 69 78 3f 20 73 74 72 69 6e 67 2d 70 72 65 efix? string-pre
04f0: 66 69 78 2d 63 69 3f 0a 20 20 20 20 73 74 72 69 fix-ci?. stri
0500: 6e 67 2d 73 75 66 66 69 78 3f 20 73 74 72 69 6e ng-suffix? strin
0510: 67 2d 73 75 66 66 69 78 2d 63 69 3f 0a 20 20 20 g-suffix-ci?.
0520: 20 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 string-contains
0530: 20 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 string-contains
0540: 2d 63 69 0a 20 20 20 20 73 74 72 69 6e 67 2d 63 -ci. string-c
0550: 6f 70 79 21 20 73 75 62 73 74 72 69 6e 67 2f 73 opy! substring/s
0560: 68 61 72 65 64 0a 20 20 20 20 73 74 72 69 6e 67 hared. string
0570: 2d 72 65 76 65 72 73 65 20 73 74 72 69 6e 67 2d -reverse string-
0580: 72 65 76 65 72 73 65 21 20 72 65 76 65 72 73 65 reverse! reverse
0590: 2d 6c 69 73 74 2d 3e 73 74 72 69 6e 67 0a 20 20 -list->string.
05a0: 20 20 73 74 72 69 6e 67 2d 63 6f 6e 63 61 74 65 string-concate
05b0: 6e 61 74 65 20 73 74 72 69 6e 67 2d 63 6f 6e 63 nate string-conc
05c0: 61 74 65 6e 61 74 65 2f 73 68 61 72 65 64 20 73 atenate/shared s
05d0: 74 72 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 tring-concatenat
05e0: 65 2d 72 65 76 65 72 73 65 0a 20 20 20 20 73 74 e-reverse. st
05f0: 72 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 ring-concatenate
0600: 2d 72 65 76 65 72 73 65 2f 73 68 61 72 65 64 0a -reverse/shared.
0610: 20 20 20 20 73 74 72 69 6e 67 2d 61 70 70 65 6e string-appen
0620: 64 2f 73 68 61 72 65 64 0a 20 20 20 20 78 73 75 d/shared. xsu
0630: 62 73 74 72 69 6e 67 20 73 74 72 69 6e 67 2d 78 bstring string-x
0640: 63 6f 70 79 21 0a 20 20 20 20 73 74 72 69 6e 67 copy!. string
0650: 2d 6e 75 6c 6c 3f 0a 20 20 20 20 73 74 72 69 6e -null?. strin
0660: 67 2d 6a 6f 69 6e 0a 20 20 20 20 73 74 72 69 6e g-join. strin
0670: 67 2d 74 6f 6b 65 6e 69 7a 65 0a 20 20 20 20 73 g-tokenize. s
0680: 74 72 69 6e 67 2d 72 65 70 6c 61 63 65 0a 20 20 tring-replace.
0690: 20 20 3b 20 52 35 52 53 20 65 78 74 65 6e 64 65 ; R5RS extende
06a0: 64 3a 0a 20 20 20 20 73 74 72 69 6e 67 2d 3e 6c d:. string->l
06b0: 69 73 74 20 73 74 72 69 6e 67 2d 63 6f 70 79 20 ist string-copy
06c0: 73 74 72 69 6e 67 2d 66 69 6c 6c 21 20 0a 20 20 string-fill! .
06d0: 20 20 3b 20 52 35 52 53 20 72 65 2d 65 78 70 6f ; R5RS re-expo
06e0: 72 74 73 3a 0a 20 20 20 20 73 74 72 69 6e 67 3f rts:. string?
06f0: 20 6d 61 6b 65 2d 73 74 72 69 6e 67 20 73 74 72 make-string str
0700: 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 69 6e ing-length strin
0710: 67 2d 72 65 66 20 73 74 72 69 6e 67 2d 73 65 74 g-ref string-set
0720: 21 20 0a 20 20 20 20 73 74 72 69 6e 67 20 73 74 ! . string st
0730: 72 69 6e 67 2d 61 70 70 65 6e 64 20 6c 69 73 74 ring-append list
0740: 2d 3e 73 74 72 69 6e 67 0a 20 20 20 20 3b 20 4c ->string. ; L
0750: 6f 77 2d 6c 65 76 65 6c 20 72 6f 75 74 69 6e 65 ow-level routine
0760: 73 3a 0a 20 20 20 20 23 3b 28 6d 61 6b 65 2d 6b s:. #;(make-k
0770: 6d 70 2d 72 65 73 74 61 72 74 2d 76 65 63 74 6f mp-restart-vecto
0780: 72 20 73 74 72 69 6e 67 2d 6b 6d 70 2d 70 61 72 r string-kmp-par
0790: 74 69 61 6c 2d 73 65 61 72 63 68 20 6b 6d 70 2d tial-search kmp-
07a0: 73 74 65 70 0a 20 20 20 20 73 74 72 69 6e 67 2d step. string-
07b0: 70 61 72 73 65 2d 73 74 61 72 74 2b 65 6e 64 0a parse-start+end.
07c0: 20 20 20 20 73 74 72 69 6e 67 2d 70 61 72 73 65 string-parse
07d0: 2d 66 69 6e 61 6c 2d 73 74 61 72 74 2b 65 6e 64 -final-start+end
07e0: 0a 20 20 20 20 6c 65 74 2d 73 74 72 69 6e 67 2d . let-string-
07f0: 73 74 61 72 74 2b 65 6e 64 0a 20 20 20 20 63 68 start+end. ch
0800: 65 63 6b 2d 73 75 62 73 74 72 69 6e 67 2d 73 70 eck-substring-sp
0810: 65 63 0a 20 20 20 20 73 75 62 73 74 72 69 6e 67 ec. substring
0820: 2d 73 70 65 63 2d 6f 6b 3f 29 0a 20 20 20 20 29 -spec-ok?). )
0830: 0a 20 20 28 69 6d 70 6f 72 74 0a 20 20 20 20 28 . (import. (
0840: 65 78 63 65 70 74 20 28 72 6e 72 73 29 20 73 74 except (rnrs) st
0850: 72 69 6e 67 2d 63 6f 70 79 20 73 74 72 69 6e 67 ring-copy string
0860: 2d 66 6f 72 2d 65 61 63 68 20 73 74 72 69 6e 67 -for-each string
0870: 2d 3e 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 ->list.
0880: 20 20 20 20 20 20 20 20 20 20 73 74 72 69 6e 67 string
0890: 2d 75 70 63 61 73 65 20 73 74 72 69 6e 67 2d 64 -upcase string-d
08a0: 6f 77 6e 63 61 73 65 20 73 74 72 69 6e 67 2d 74 owncase string-t
08b0: 69 74 6c 65 63 61 73 65 20 73 74 72 69 6e 67 2d itlecase string-
08c0: 68 61 73 68 29 0a 20 20 20 20 28 65 78 63 65 70 hash). (excep
08d0: 74 20 28 72 6e 72 73 20 6d 75 74 61 62 6c 65 2d t (rnrs mutable-
08e0: 73 74 72 69 6e 67 73 29 20 73 74 72 69 6e 67 2d strings) string-
08f0: 66 69 6c 6c 21 29 0a 20 20 20 20 28 72 6e 72 73 fill!). (rnrs
0900: 20 72 35 72 73 29 0a 20 20 20 20 28 73 72 66 69 r5rs). (srfi
0910: 20 73 32 33 20 65 72 72 6f 72 20 74 72 69 63 6b s23 error trick
0920: 73 29 0a 20 20 20 20 28 73 72 66 69 20 73 38 20 s). (srfi s8
0930: 72 65 63 65 69 76 65 29 0a 20 20 20 20 28 73 72 receive). (sr
0940: 66 69 20 73 31 34 20 63 68 61 72 2d 73 65 74 73 fi s14 char-sets
0950: 29 0a 20 20 20 20 28 73 72 66 69 20 70 72 69 76 ). (srfi priv
0960: 61 74 65 20 6c 65 74 2d 6f 70 74 29 0a 20 20 20 ate let-opt).
0970: 20 28 73 72 66 69 20 70 72 69 76 61 74 65 20 69 (srfi private i
0980: 6e 63 6c 75 64 65 29 29 0a 20 20 0a 20 20 0a 20 nclude)). . .
0990: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 (define-syntax
09a0: 63 68 65 63 6b 2d 61 72 67 0a 20 20 20 20 28 6c check-arg. (l
09b0: 61 6d 62 64 61 20 28 73 74 78 29 0a 20 20 20 20 ambda (stx).
09c0: 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 73 (syntax-case s
09d0: 74 78 20 28 29 0a 20 20 20 20 20 20 20 20 5b 28 tx (). [(
09e0: 5f 20 70 72 65 64 20 76 61 6c 20 63 61 6c 6c 65 _ pred val calle
09f0: 72 29 0a 20 20 20 20 20 20 20 20 20 28 61 6e 64 r). (and
0a00: 20 28 69 64 65 6e 74 69 66 69 65 72 3f 20 23 27 (identifier? #'
0a10: 76 61 6c 29 20 28 69 64 65 6e 74 69 66 69 65 72 val) (identifier
0a20: 3f 20 23 27 63 61 6c 6c 65 72 29 29 0a 20 20 20 ? #'caller)).
0a30: 20 20 20 20 20 20 23 27 28 75 6e 6c 65 73 73 20 #'(unless
0a40: 28 70 72 65 64 20 76 61 6c 29 0a 20 20 20 20 20 (pred val).
0a50: 20 20 20 20 20 20 20 20 28 61 73 73 65 72 74 69 (asserti
0a60: 6f 6e 2d 76 69 6f 6c 61 74 69 6f 6e 20 27 63 61 on-violation 'ca
0a70: 6c 6c 65 72 20 22 63 68 65 63 6b 2d 61 72 67 20 ller "check-arg
0a80: 66 61 69 6c 65 64 22 20 76 61 6c 29 29 5d 29 29 failed" val))]))
0a90: 29 0a 20 20 0a 20 20 28 64 65 66 69 6e 65 20 28 ). . (define (
0aa0: 63 68 61 72 2d 63 61 73 65 64 3f 20 63 29 0a 20 char-cased? c).
0ab0: 20 20 20 28 63 68 61 72 2d 75 70 70 65 72 2d 63 (char-upper-c
0ac0: 61 73 65 3f 20 28 63 68 61 72 2d 75 70 63 61 73 ase? (char-upcas
0ad0: 65 20 63 29 29 29 0a 20 20 0a 20 20 3b 3b 20 28 e c))). . ;; (
0ae0: 53 52 46 49 2d 32 33 2d 65 72 72 6f 72 2d 3e 52 SRFI-23-error->R
0af0: 36 52 53 20 22 28 6c 69 62 72 61 72 79 20 28 73 6RS "(library (s
0b00: 72 66 69 20 73 31 33 20 73 74 72 69 6e 67 73 29 rfi s13 strings)
0b10: 29 22 0a 20 20 3b 3b 20 20 28 69 6e 63 6c 75 64 )". ;; (includ
0b20: 65 2f 72 65 73 6f 6c 76 65 20 28 22 73 72 66 69 e/resolve ("srfi
0b30: 22 20 22 25 33 61 31 33 22 29 20 22 73 72 66 69 " "%3a13") "srfi
0b40: 2d 31 33 2e 73 63 6d 22 29 29 0a 0a 20 20 28 53 -13.scm")).. (S
0b50: 52 46 49 2d 32 33 2d 65 72 72 6f 72 2d 3e 52 36 RFI-23-error->R6
0b60: 52 53 20 22 28 6c 69 62 72 61 72 79 20 28 73 72 RS "(library (sr
0b70: 66 69 20 73 31 33 20 73 74 72 69 6e 67 73 29 29 fi s13 strings))
0b80: 22 0a 20 20 20 28 69 6e 63 6c 75 64 65 2f 72 65 ". (include/re
0b90: 73 6f 6c 76 65 20 28 22 73 72 66 69 22 20 22 73 solve ("srfi" "s
0ba0: 31 33 22 29 20 22 73 72 66 69 2d 31 33 2e 73 63 13") "srfi-13.sc
0bb0: 6d 22 29 29 0a 29 0a m")).).