1. Strings


(define string "\\n")                    ; two characters, \ and an n
(define string "\n")                     ; a "newline" character
(define string "Jon \"Maddog\" Orwant")  ; literal double quotes
(define string "Jon 'Maddog' Orwant")    ; literal single quotes

(define a "This is a multiline here document
terminated by a closing double quote")

Accessing Substrings

;; Use substring

(substring str start end)
(substring str start)

;; You can fill portions of a string with another string

(substring-move-right! str start end newstring newstart)
(substring-move-left! str start end newstring newstart)

;; Guile has a separate character type, and you can treat strings as a
;; character array.

(string-ref str pos)
(string-set! str pos char)
(string-fill! str char)
(substring-fill! str start end char)

(define s "This is what you have")
(define first (substring s 0 1))                     ; "T"
(define start (substring s 5 7))                     ; "is"
(define rest  (substring s 13))                      ; "you have"
(define last  (substring s (1- (string-length s))))  ; "e"
(define end   (substring s (- (string-length s) 4))) ; "have"
(define piece (let ((len (string-length s)))
                (substring s (- len 8) (- len 5))))  ; "you"

;;; Or use the string library SRFI-13
(use-modules (srfi srfi-13))

(define s "This is what you have")
(define first (string-take s 1))                     ; "T"
(define start (xsubstring s 5 7))                    ; "is"
(define rest  (xsubstring s 13 -1))                  ; "you have"
(define last  (string-take-right s 1))               ; "e"
(define end   (string-take-right s 4))               ; "have"
(define piece (xsubstring s -8 -5))                  ; "you"

;; Mutation of different sized strings is not allowed.  You have to
;; use set! to change the variable.

(set! s (string-replace s "wasn't" 5 7))
;; This wasn't what you have
(set! s (string-replace s "ondrous" 13 25))
;; This wasn't wondrous
(set! s (string-take-right s (1- (string-length s))))
;; his wasn't wondrous
(set! s (string-take s 9))

Establishing a Default Value

(define a (or b c))
(define a (if (defined? b) b c))
(define a (or (and (defined? b) b) c))

Exchanging Values Without Using Temporary Variables

;; This doesn't really make sense in Scheme... temporary variables are
;; a natural construct and cheap.  If you want to swap variables in a
;; block without introducing any new variable names, you can use let:

(let ((a b) (b a))
  ;; ...

(let ((alpha beta) (beta production) (production alpha))
  ;; ...

Converting Between ASCII Characters and Values

(define num (char->integer char))
(define char (integer->char num))

(use-modules (srfi srfi-13))
(let ((str "sample"))
  (display (string-join
            (map number->string
                 (map char->integer (string->list str))) " "))

(let ((lst '(115 97 109 112 108 101)))
  (display (list->string (map integer->char lst)))

(letrec ((next (lambda (c) (integer->char (1+ (char->integer c))))))
  (let* ((hal "HAL")
         (ibm (list->string (map next (string->list hal)))))
    (display ibm)

Processing a String One Character at a Time

;; Convert the string to a list of characters
(map proc
     (string->list str))

(use-modules (srfi srfi-1))
(format #t "unique chars are: ~A\n"
        (apply string (sort (delete-duplicates
                             (string->list "an apple a day")) char<?)))

(let* ((str "an apple a day")
       (sum (apply + (map char->integer (string->list str)))))
  (format #t "sum is ~A\n" sum))

;;; or use string-fold/string-map/string-for-each from SRFI-13
(use-modules (srfi srfi-13))

(let* ((str "an apple a day")
       (sum (string-fold (lambda (c acc) (+ acc (char->integer c)))
                         0 str)))
  (format #t "sum is ~A\n" sum))

#!/usr/local/bin/guile -s
;; sum - compute 16-bit checksum of all input files
(use-modules (srfi srfi-13))
(define (checksum p)
  (let loop ((line (read-line p 'concat)) (sum 0))
    (if (eof-object? line)
      (format #t "~A ~A\n" sum (port-filename p))
      (let ((line-sum (string-fold (lambda (c acc)
                                     (+ acc (char->integer c)))
                                   0 line)))
        (loop (read-line p 'concat) (modulo (+ sum line-sum)
                                            (1- (expt 2 16))))))))
(let ((args (cdr (command-line))))
  (if (null? args)
    (checksum (current-input-port))
    (for-each (lambda (f) (call-with-input-file f checksum)) args)))

#!/usr/local/bin/guile -s
;; slowcat - emulate a  s l o w  line printer
(use-modules (ice-9 regex) (srfi srfi-2) (srfi srfi-13))
(define args (cdr (command-line)))
(define delay 1)
(and-let* ((p (pair? args))
           (m (string-match "^-([0-9]+)$" (car args))))
  (set! delay (string->number (match:substring m 1)))
  (set! args (cdr args)))
(define (slowcat p)
  (let loop ((line (read-line p 'concat)))
    (cond ((not (eof-object? line))
            (lambda (c) (display c) (usleep (* 5 delay))) line)
           (loop (read-line p 'concat))))))
(if (null? args)
  (slowcat (current-input-port))
  (for-each (lambda (f) (call-with-input-file f slowcat)) args))

Reversing a String by Word or Character

(define revbytes (list->string (reverse (string->list str))))

;;; Or from SRFI-13
(use-modules (srfi srfi-13))
(define revbytes (string-reverse str))
(string-reverse! str) ; modifies in place

(define revwords (string-join (reverse (string-tokenize str)) " "))

(with-input-from-file "/usr/share/dict/words"
  (lambda ()
    (do ((word (read-line) (read-line)))
        ((eof-object? word))
      (if (and (> (string-length word) 5)
               (string=? word (string-reverse word)))
        (write-line word)))))

;; A little too verbose on the command line
;; guile --use-srfi=13 -c
;; '(with-input-from-file "/usr/share/dict/words"
;; (lambda () (do ((word (read-line) (read-line))) ((eof-object? word))
;; (if (and (> (string-length word) 5) (string=? word (string-reverse word)))
;; (write-line word)))))'

Expanding and Compressing Tabs

;; Use regexp-substitute/global
 #f "([^\t]*)(\t+)" str
 (lambda (m)
   (let* ((pre-string (match:substring m 1))
          (pre-len (string-length pre-string))
          (match-len (- (match:end m 2) (match:start m 2))))
       (- (* match-len 8)
          (modulo pre-len 8))

Expanding Variables in User Input

;; just interpolate $abc in strings:
(define (varsubst str)
  (regexp-substitute/global #f "\\$(\\w+)" str
   'pre (lambda (m) (eval (string->symbol (match:substring m 1))

;; interpolate $abc with error messages:
(define (safe-varsubst str)
  (regexp-substitute/global #f "\\$(\\w+)" str
   'pre (lambda (m)
          (catch #t
            (lambda () (eval (string->symbol (match:substring m 1))
            (lambda args
              (format #f "[NO VARIABLE: ~A]" (match:substring m 1)))))

;; interpolate ${(any (scheme expression))} in strings:
(define (interpolate str)
  (regexp-substitute/global #f "\\${([^{}]+)}" str
   'pre (lambda (m) (eval-string (match:substring m 1))) 'post))

Controlling Case

(use-modules (srfi srfi-13))

(string-upcase "bo beep")     ; BO PEEP
(string-downcase "JOHN")      ; john
(string-titlecase "bo")       ; Bo
(string-titlecase "JOHN")     ; John

(string-titlecase "thIS is a loNG liNE")  ; This Is A Long Line

#!/usr/local/bin/guile -s
;; randcap: filter to randomly capitalize 20% of the time
(use-modules (srfi srfi-13))
(seed->random-state (current-time))
(define (randcap p)
  (let loop ((line (read-line p 'concat)))
    (cond ((not (eof-object? line))
           (display (string-map (lambda (c)
                                  (if (= (random 5) 0)
                                    (char-upcase c)
                                    (char-downcase c)))
           (loop (read-line p 'concat))))))
(let ((args (cdr (command-line))))
  (if (null? args)
    (randcap (current-input-port))
    (for-each (lambda (f) (call-with-input-file f randcap)) args)))

Interpolating Functions and Expressions Within Strings

;; You can do this with format.  Lisp/Scheme format is a little
;; different from what you may be used to with C/Perl style printf
;; (actually far more powerful) , but if you keep in mind that we use
;; ~ instead of %, and , instead of . for the prefix characters, you
;; won't have trouble getting used to Guile's format.

(format #f "I have ~A guanacos." n)

Indenting Here Documents

(define var "
        your text
        goes here")

(use-modules (ice-9 regexp))
(set! var (regexp-substitute/global #f "\n +" var 'pre "\n" 'post))

(use-modules (srfi srfi-13))
(set! var (string-join (map string-trim (string-tokenize var #\newline)) "\n"))

(use-modules (ice-9 regexp) (srfi srfi-13) (srfi srfi-14))
(define (dequote str)
  (let* ((str (if (char=? (string-ref str 0) #\newline)
                (substring str 1) str))
         (lines (string-tokenize str #\newline))
         (rx (let loop ((leader (car lines)) (lst (cdr lines)))
               (cond ((string= leader "")
                      (let ((pos (or (string-skip (car lines)
                                                  char-set:whitespace) 0)))
                        (make-regexp (format #f "^[ \\t]{1,~A}" pos)
                     ((null? lst)
                      (make-regexp (string-append "^[ \\t]*"
                                                  (regexp-quote leader))
                      (let ((pos (or (string-prefix-length leader (car lst))
                        (loop (substring leader 0 pos) (cdr lst))))))))
    (regexp-substitute/global #f rx str 'pre 'post)))

Reformatting Paragraphs

(use-modules (srfi srfi-13))

(define text "Folding and splicing is the work of an editor,
not a mere collection of silicon
mobile electrons!")

(define (wrap str max-col)
  (let* ((words (string-tokenize str))
         (all '())
         (first (car words))
         (col (string-length first))
         (line (list first)))
     (lambda (x)
       (let* ((len (string-length x))
              (new-col (+ col len 1)))
         (cond ((> new-col max-col)
                (set! all (cons (string-join (reverse! line) " ") all))
                (set! line (list x))
                (set! col len))
                (set! line (cons x line))
                (set! col new-col)))))
     (cdr words))
    (set! all (cons (string-join (reverse! line) " ") all))
    (string-join (reverse! all) "\n")))

(display (wrap text 20))

Escaping Characters

(define str "Mom said, \"Don't do that.\"")
(set! str (regexp-substitute/global #f "['\"]" str 'pre "\\"
                                    match:substring 'post))
(set! str (regexp-substitute/global #f "[^A-Z]" str 'pre "\\"
                                    match:substring 'post))
(set! str (string-append "this " (regexp-substitute/global
                                  #f "\W" "is a test!" 'pre "\\"
                                  match:substring 'post)))

Trimming Blanks from the Ends of a String

(use-modules (srfi srfi-13))

(define str "  space  ")
(string-trim str)          ; "space  "
(string-trim-right str)    ; "  space"
(string-trim-both str)     ; "space"

Parsing Comma-Separated Data

(use-modules (srfi srfi-2) (srfi srfi-13) (ice-9 format))

(define parse-csv
  (let* ((csv-match (string-join '("\"([^\"\\\\]*(\\\\.[^\"\\\\]*)*)\",?"
         (csv-rx (make-regexp csv-match)))
    (lambda (text)
      (let ((start 0)
            (result '()))
        (let loop ((start 0))
          (and-let* ((m (regexp-exec csv-rx text start)))
            (set! result (cons (or (match:substring m 1)
                                   (match:substring m 3))
            (loop (match:end m))))
        (reverse result)))))

(define line "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall,
             Larry\",\"a \\\"glug\\\" bit,\",5,\"Error, Core Dumped\"")

(do ((i 0 (1+ i))
     (fields (parse-csv line) (cdr fields)))
    ((null? fields))
  (format #t "~D : ~A\n" i (car fields)))

Soundex Matching

(use-modules (srfi srfi-13) (srfi srfi-14))

;; Knuth's soundex algorithm from The Art of Computer Programming, Vol 3
(define soundex
           (nums "000000111122222222334556")
           (skipchars (string->char-set "HW"))
           (trans (lambda (c)
                    (let ((i (string-index chars c)))
                      (if i (string-ref nums i) c)))))
    (lambda (str)
      (let* ((ustr (string-upcase str))
             (f (string-ref ustr 0))
             (skip (trans f)))
        (let* ((mstr (string-map trans (string-delete ustr skipchars 1)))
               (dstr (string-map (lambda (c)
                                   (cond ((eq? c skip) #\0)
                                         (else (set! skip c) c)))
               (zstr (string-delete dstr #\0)))
          (substring (string-append (make-string 1 f) zstr "000") 0 4))))))

(soundex "Knuth")  ; K530
(soundex "Kant")   ; K530
(soundex "Lloyd")  ; L300
(soundex "Ladd")   ; L300

Program: fixstyle

#!/usr/local/bin/guile -s

(use-modules (srfi srfi-13)
             (srfi srfi-14)
             (ice-9 rw)
             (ice-9 regex))

(define data "analysed        => analyzed
built-in        => builtin
chastized       => chastised
commandline     => command-line
de-allocate     => deallocate
dropin          => drop-in
hardcode        => hard-code
meta-data       => metadata
multicharacter  => multi-character
multiway        => multi-way
non-empty       => nonempty
non-profit      => nonprofit
non-trappable   => nontrappable
pre-define      => predefine
preextend       => pre-extend
re-compiling    => recompiling
reenter         => re-enter
turnkey         => turn-key")

(define input (if (null? (cdr (command-line)))
                (open-input-file (cadr (command-line)))))

(let* ((newline-char-set (string->char-set "\n"))
       (assoc-char-set (string->char-set " =>"))
       (dict (map
              (lambda (line)
                (string-tokenize line assoc-char-set))
              (string-tokenize data newline-char-set)))
       (dict-match (string-join (map car dict) "|")))
  (let loop ((line (read-line input)))
    (cond ((not (eof-object? line))
            (current-output-port) dict-match line
            (lambda (x)
              (cadr (assoc (match:substring x 0) dict)))
           (loop (read-line input 'concat))))))

(close-port input)

Program: psgrep