Re: text munging

[Michael Livshin <mlivshin at bigfoot dot com>]

Eric Moore <moore@chem.cmu.edu> writes:

> Well, I dunno how much people are going to like it, but here's a
> scheme hack I threw together to do it :)  Hardly efficient, but kinda
> neat, and not bad for an hours hacking.

here is the result of another hour.

it's slightly documented and allows hairier input.
for instance, you could say:

(define (downcase-match match)
   (string-downcase (match:substring match)))
("baz" 'post "look ma, it's backwards!" 'pre)
("EOL" 'pre)
(define (duplicate-all line)
   (string-append line line))
("[A-Z]+" 'pre downcase-match 'post)
duplicate-all
("--([a-zA-Z]+)--" 'pre 1 'post)

it also allows standard input and as many input files as you want,
like Perl.

usage is:
guile -s perl-np.scm foo.scm file0 ...

enjoy, in case you like this kind of thing ;)

;; -*- scheme -*-
;; perl-np.scm: new! improved! as broken as Perl!

(if (< (length (command-line)) 2)
    (begin
      (display "usage: guile -s perl-np.scm <commands>.scm [file0 ...]\n")
      (exit 2)))

(use-modules (ice-9 streams)
             (ice-9 regex))

;; this would be a useful addition to (ice-9 streams), I wonder
;; why I didn't put it there in the first place...
(define (stream-append . streams)
  (cond
   ((null? streams)
    (list->stream '()))
   (else
    (make-stream
     (lambda (state)
       (let loop ((current (car state))
                  (rest (cdr state)))
         (cond
          ((stream-null? current)
           (or (null? rest)
               (loop (car rest) (cdr rest))))
          (else
           (cons (stream-car current)
                 (cons (stream-cdr current)
                       rest))))))
     streams))))

;; and these too:
(define (stream-delete-if bad? stream)
  (make-stream
   (lambda (stream)
     (let loop ((s stream))
       (or (stream-null? s)
           (let ((scar (stream-car s))
                 (scdr (stream-cdr s)))
             (cond
              ((bad? scar)
               (loop scdr))
              (else
               (cons scar scdr)))))))
   stream))

(define (stream-deleter eh?)
  (lambda (arg stream)
    (stream-delete-if (lambda (x) (eh? arg x)) stream)))

(define stream-delq (stream-deleter eq?))
(define stream-delv (stream-deleter eqv?))
(define stream-delete (stream-deleter equal?))

;; input is taken either from the last argument(s)
;; or from stdin, like in Perl.
(define input
  (cond
   ((> (length (command-line)) 2)
    (apply stream-append
           (map (lambda (fname)
                  (port->stream (open-file fname "r")
                                read-line))
                (cddr (command-line)))))
   (else
    (port->stream (current-input-port)
                  read-line))))

;; the stream of the operations:
(define op-input (port->stream
                  (open-file (cadr (command-line)) "r")
                  read))

(define noop (list))

;; the operation file is a kind of extended Scheme.  if a form is a
;; list beginning with a string, it is assumed to be a regexp
;; substitution.  else, if evaluating the form gives a procedure, the
;; procedure is assumed to take a string and return a string.
;; this is kinda messy, but what the fuck, so is Perl.
(define (grok-operation form)
  (cond
   ((and (pair? form) (string? (car form)))
    (lambda (line)
      (apply regexp-substitute/global
             #f (make-regexp (car form)) line (map eval (cdr form)))))
   (else
    (let ((eval-res (eval form)))
      (cond
       ((procedure? eval-res)
        eval-res)
       (else
        noop))))))

(define transform
  (let ((operations
         (stream-delq noop
                      (stream-map
                       grok-operation
                       op-input))))
    (lambda (line)
      (let loop ((ops operations) (l line))
        (cond
         ((stream-null? ops)
          l)
         (else
          (loop (stream-cdr ops) ((stream-car ops) l))))))))

(stream-for-each
 (lambda (x)
   (display (transform x))
   (newline))
 input)