A "perl -ne" like REPL for guile scheme to work with shell scripts

guile-script.scm

#!/usr/bin/guile \
-e main -s
!#

;; A "perl -ne" like REPL for guile scheme to work with shell scripts.
;; 
;; Usage: <THIS_FILE> [OPTIONS] PROC-STRING [FILE]...
;; 
;; PROC-STRING
;;   A s-expression string representing a lambda taking 1 or 2 arguments,
;;   such as `(lambda (l) (display l))`. When 1-arity lambda is provided,
;;   the only argument is feed line-by-line of the inputs. When 2-arity
;;   lambda is provided, the extra second argument collects the expression
;;   from last execution, similar to the `fold` procedure. The `--init-value`
;;   option can be used to give the initial value of the first iteration.
;;   If that option is not given, the initial value is `#f`.
;; 
;;   If a 2-arity lambda is given, an <eof-object> will be fed as the line
;;   data for the last iteration to mark the end of execution. You could use
;;   the pattern `(lambda (l q) (if (eof-object? l) ...))` to cope with this
;;   behavior.
;; 
;; FILE
;;   The REPL reads from FILE arguments as if they are one document. If no
;;   FILE is given, it reads from standard input.
;; 
;; OPTIONS
;;   -h|--help: print help.
;;   --init-value: initial value for 2-arity lambdas.
;; 
;; EXAMPLES
;;   A simple line reader which adds 1 to every line:
;;     (lambda (l) (+ 1 (string->number l)))
;; 
;;   Summing the second column of a CSV file (but it will print every line!):
;;     (let ((sum 0))
;;       (lambda (l)
;;         (let ((num (string->number (cadr (string-split l #\,)))))
;;           (set! sum (+ num sum))
;;           (display sum)
;;           (newline))))
;; 
;;   Summing the second column of a CSV file using 2-arity lambda:
;;     (lambda (l q)
;;       (if (eof-object? l)
;;           (begin (display q) (newline))
;;           (let ((num (string->number (cadr (string-split l #\,)))))
;;             (if q (+ num q) num))))
;; 
;;   Summing the second column of a CSV file using 2-arity lambda with
;;   `--init-value "()"`:
;;     (lambda (l q)
;;       (if (eof-object? l)
;;           (format #t "~a~%"
;;                   (apply + (map (compose string->number cadr) q)))
;;           (cons (string-split l #\,) q)))
;;

(import (ice-9 rdelim)
        (ice-9 match)
        (srfi srfi-11)
        (rnrs io ports)
        (system vm program))

(define (repl-gen repl-str init-value)
  (define repl-obj (with-input-from-string repl-str (lambda () (read))))
  (define repl (eval repl-obj (interaction-environment)))
  (define arity (length (program-lambda-list repl)))
  (list repl arity init-value))

(define (feed repl-obj input-ports)
  (match repl-obj
    ((repl 1 init-value)
     (let A ((remain-ports input-ports))
       (if (not (null? remain-ports))
           (let ((current-port (car remain-ports)))
             (let B ((line (read-line current-port)))
               (if (eof-object? line)
                   (A (cdr remain-ports))
                   (begin
                     (repl line)
                     (B (read-line current-port)))))))))
    ((repl 2 init-value)
     (let A ((remain-ports input-ports)
             (accumA init-value))
       (if (null? remain-ports)
           (repl (eof-object) accumA)
           (let ((current-port (car remain-ports)))
             (let B ((line (read-line current-port))
                     (accumB accumA))
               (if (eof-object? line)
                   (A (cdr remain-ports) accumB)
                   (B (read-line current-port)
                      (repl line accumB))))))))))

(define (print-usage exec-name)
  (format #t "Usage: ~a [-h|--help] [--init-value VAL] PROC-STRING [FILE]...~%"
          exec-name))

(define (main args)
  (let ((exec-name (car args)))
    (let B ((args2 (cdr args))
            (init-value #f))
      (match args2
        (() (print-usage exec-name))
        (("-h" . _) (print-usage exec-name))
        (("--help" . _) (print-usage exec-name))
        (("--init-value" iv . args-rest)
         (B args-rest (with-input-from-string iv (lambda () (read)))))
        ((expr-str . filenames)
         (let ((repl-obj (repl-gen expr-str init-value)))
           (if (null? filenames)
               (feed repl-obj (list (current-input-port)))
               (let A ((files filenames) (ports '()))
                 (if (null? files)
                     (feed repl-obj (reverse ports))
                     (call-with-input-file (car files)
                       (lambda (port) (A (cdr files)
                                         (cons port ports)))))))))))))