codepad

Language:

#! /usr/bin/scheme --script

(define l-flag #t)
(define w-flag #t)
(define c-flag #t)

(define (update-flags fs)
  (if (not (member #\l fs)) (set! l-flag #f))
  (if (not (member #\w fs)) (set! w-flag #f))
  (if (not (member #\c fs)) (set! c-flag #f)))

(define (put-dec n width)
  (let* ((n-str (number->string n)))
    (display (make-string (- width (string-length n-str)) #\space))
    (display n-str)))

(define (wc)
  (let loop ((inword #f) (c (read-char)) (ls 0) (ws 0) (cs 0))
    (cond ((eof-object? c) (values ls ws cs))
          ((char=? c #\newline)
            (loop #f (read-char) (add1 ls) ws (add1 cs)))
          ((not (member c '(#\space #\newline #\tab)))
            (if inword
                (loop #t (read-char) ls ws (add1 cs))
                (loop #t (read-char) ls (add1 ws) (add1 cs))))
          (else (loop #f (read-char) ls ws (add1 cs))))))

(define (main args)
  (when (and (pair? args) (char=? (string-ref (car args) 0) #\-))
        (update-flags (cdr (string->list (car args))))
        (set! args (cdr args)))
  (if (null? args)
      (let-values (((ls ws cs) (wc)))
        (when l-flag (display ls) (display " "))
        (when w-flag (display ws) (display " "))
        (when c-flag (display cs) (display " "))
        (newline))
      (let loop ((args args) (l-tot 0) (w-tot 0) (c-tot 0))
        (if (null? args)
            (begin (when l-flag (put-dec l-tot 12))
                   (when w-flag (put-dec w-tot 12))
                   (when c-flag (put-dec c-tot 12)))
            (with-input-from-file (car args)
              (lambda ()
                (let-values (((ls ws cs) (wc)))
                  (when l-flag (put-dec ls 12))
                  (when w-flag (put-dec ws 12))
                  (when c-flag (put-dec cs 12))
                  (display " ") (display (car args)) (newline)
                  (loop (cdr args) (+ l-tot ls) (+ w-tot ws) (+ c-tot cs)))))))))

(main (cdr (command-line)))

Private [?]

Run code