Re: Some thoughts about documentation

[Alex Shinn]

>>>>> "Rob" == Rob Browning <address@hidden> writes:

    Rob> "Dale P. Smith" <address@hidden> writes:
    >> I agree.  Most of what I know about Perl, I learned from the
    >> "Common Tasks With Perl" chapter in the old pink camel
    >> book. The "Real Perl Programs" chapter was good too.  Someone
    >> suggested a while ago (a year or two) that we convert all those
    >> to scheme.  I think it would be a great idea.

    Rob> It might also be nice to eventually try and create a
    Rob> "Learning Scheme if you kow Perl" document.  i.e. what's the
    Rob> equivalent to "join"?, "split"?, etc.

In this vein I've thrown together some Perl-ish constructs (below),
including "join", "split", "grep" and "glob".  Suggestions for
improvement are welcome.

What's the best way to put together a cookbook?  Just collect
contributions from people and then organize them based on what we've
got, building some prose explanations around them?  Or come up with an
outline of things we should have examples for then get volunteers to
fill in the holes?

-- 
Alex Shinn <address@hidden>
Lisper, Smalltalker, and all around poor speaker


;; slurp a file's contents into a single string

(define (file-contents file)
  (let ((input (open-input-file file))
        (str (make-string (stat:size (stat file)))))
    (read-string!/partial str input)
    (close-input-port input)
    str ))

(define (file-contents2 file)
  (let ((input (open-input-file file)))
    (let ((str (drain-input input)))
      (close-input-port file)
      str)))

;; slurp a file's contents into an array of strings, one per line

(define (read-lines file)
  (let ((input (open-input-file file)))
    (letrec ((R (lambda ()
                  (let ((line (read-line input)))
                    (if (eof-object? line)
                        '()
                        (cons line (R)) )))))
      (let ((ls (R)))
        (close-input-port input)
        ls ))))

;; join (no mapconcat?)

(define (join str ls)
  (letrec ((J (lambda (ls)
                (cond ((null? ls)
                       "")
                      (else
                       (string-append (car ls) str (J (cdr ls))) )))))
    (J ls) ))

;; split

(define (split s-or-rx str)
  (let ((rx (cond ((regexp? s-or-rx) s-or-rx)
                  ((string? s-or-rx) (make-regexp s-or-rx))))
        (len (string-length str)))
    (letrec ((S (lambda (str pos)
                  (if (> pos len)
                      '()
                      (let ((m (regexp-exec rx str pos)))
                        (if (regexp-match? m)
                            (cons (substring str pos (match:start m))
                                  (S str (match:end m)))
                            (list (substring str pos)) ))))))
      (S str 0) )))

;; trim

(define trim
  (let ((rx (make-regexp "[ \t]*(.*[^ \t])[ \t]*")))
    (lambda (str)
      (let ((m (regexp-exec rx str)))
        (if (regexp-match? m)
            (match:substring m 1)
            str)))))

;; word count

(define (word-count file)
  (let ((input (open-input-file file))
        (c 0) (w 0) (l 0))
    (letrec ((W (lambda ()
                  (let ((line (read-line input 'concat)))
                    (if (eof-object? line)
                        '()
                        (begin (set! l (1+ l))
                               (set! c (+ c (string-length line)))
                               (set! w (+ w (length (split "[ \t]+"
                                                           (trim line)))))
                               (W) ))))))
      (W)
      (close-input-port input)
      (list c w l) )))

;; filter

(define (filter func ls)
  (letrec ((G (lambda (ls)
                (cond ((null? ls)
                       '())
                      ((func (car ls))
                       (cons (car ls) (G (cdr ls))))
                      (else (G (cdr ls))) ))))
    (G ls) ))

;; grep

(define (grep f-or-rx ls)
  (letrec ((G (cond ((procedure? f-or-rx)
                     (lambda (ls)
                       (cond ((null? ls)
                              '())
                             ((f-or-rx (car ls))
                              (cons (car ls) (G (cdr ls))))
                             (else (G (cdr ls))) )))
                    ((regexp? f-or-rx)
                     (lambda (ls)
                       (cond ((null? ls)
                              '())
                             ((regexp-exec f-or-rx (car ls))
                              (cons (car ls) (G (cdr ls))))
                             (else (G (cdr ls))) )))
                    ((string? f-or-rx)
                     (let ((rx (make-regexp f-or-rx)))
                       (lambda (ls)
                         (cond ((null? ls)
                                '())
                               ((regexp-exec rx (car ls))
                                (cons (car ls) (G (cdr ls))))
                               (else (G (cdr ls))) )))))))
    (G ls) ))

;; glob

(define (glob->regexp pat)
  (let ((rx-pat "")
        (trans-string "")
        (length (string-length pat))
        (char #\nul))
    (do ((i 0 (+ i 1)))
        ((>= i length))
      (set! char (string-ref pat i))
      ;; maybe handle extended globbing, like ~, bash's {}, etc.
      (case char
        ((#\*)
         (set! trans-string ".*"))
        ((#\?)
         (set! trans-string "."))
        ((#\.)
         (set! trans-string "\\."))
        (else
         (set! trans-string (regexp-quote (make-string 1 char)))))
      (set! rx-pat (string-append rx-pat trans-string)))
    ;; Anchor to whole string
    (set! rx-pat (string-append "^" rx-pat "$"))
    rx-pat ))

(define (glob-match pat str)
  (string-match (glob->regexp pat) str) )

;; glob, using Ariel's get-dir-files
(define (glob pat dir)
  (grep (glob->regexp pat) (get-dir-files dir)) )