23分クッキング: awk のようなものを作る

#!/usr/local/bin/ros でそのまま通るはずと思っていたんですがそう簡単にはいかないようで。snさん今度使い方教えてください。

使用例:

example.lisp

;; cat data | /usr/local/bin/sbcl --load example.lisp -
;; /usr/local/bin/sbcl --load example.lisp data

(ql:quickload :awklike)
(use-package :awklike)

(awk BEGIN
  (print (cdr sb-ext:*posix-argv*))
  (print "hello!"))

(awk |-data|
  (print $2))

(main (cdr sb-ext:*posix-argv*))
(exit)

data

2010-data 100
2011-data 110
2012-data 120
2013-data 130
2014-data 140

output

("-") 
"hello!" 
"100" 
"110" 
"120" 
"130" 
"140"

実装:

#|
  This file is a part of awklike project.
  Copyright (c) 2015 Masataro Asai ([e-mail])
|#

(in-package :cl-user)
(defpackage awklike
  (:use :cl :optima :optima.ppcre :alexandria :iterate :cl-ppcre :lisp-namespace)
  (:export
   #:$0
   #:awk
   #:main
   #:BEGIN
   #:END
   #:UNBOUND-MATCHER
   #:SYMBOL-MATCHER
   #:MATCHER-BOUNDP
   #:matcher))
(in-package :awklike)

;; blah blah blah.

(define-namespace matcher (function (string list) t))

(eval-when (:compile-toplevel :load-toplevel :execute)
  ;; CLHS says CALL-ARGUMENTS-LIMIT is larger than 50
  (defvar *max-column* 50)
  (defmacro define-$-macros ()
    `(progn
       ,@(iter (for i from 1 below *max-column*)
               (for sym = (symbolicate "$" (princ-to-string i)))
               (appending
                `((define-symbol-macro ,sym
                      (nth ,(1- i) awk-arguments))
                  (export ',sym))))))
  (defmacro awk (key &body body)
    `(setf
      (symbol-matcher ',key)
      ,(match (symbol-name key)
         ((or "BEGIN" "END")
          `(lambda ($0)
             (declare (ignorable $0))
             (let ((awk-arguments (split "\\s+" $0)))
               (declare (ignorable awk-arguments))
               ,@body)))
         (regex
          `(lambda ($0)
             (declare (ignorable $0))
             (when (scan ,(format nil ".*~a.*" regex) $0)
               (let ((awk-arguments (split "\\s+" $0)))
                 (declare (ignorable awk-arguments))
                 ,@body))))))))

(define-$-macros)

(awk BEGIN)
(awk END)

(defun main (&optional (in-files '("-")))
  (iter (for in in in-files)
        (match in
          ("-"
           (read-loop *standard-input*))
          ((string)
           (with-open-file (s in)
             (read-loop s))))))

(defun read-loop (s)
  (funcall (symbol-matcher 'begin) nil)
  (iter (for line = (read-line s nil nil))
        (while line)
        (search-match line))
  (funcall (symbol-matcher 'end) nil))

(defun search-match (line)
  (iter (for (key fn) in-hashtable *matcher-table*)
        (unless (or (eq key 'begin) (eq key 'end))
          (funcall fn line))))