よろずや

Lisp でスクリプティング

lisp でシェルスクリプト

lisp でシェルスクリプト

CMUCL shell scripts で,見かけた runlisp スクリプトに触発されて Lisp で shell script を書いてみようと思いつく.

#!/usr/bin/env runlisp について

まずは #! で実行できるように runlisp コマンドを作ろう.サーチパスのどっかに入れておけばおけ.

#!/bin/sh

PREFIX=$HOME/local
COREFILE=user.core
LISP=$PREFIX/bin/lisp
CORE=$PREFIX/lib/cmucl/lib/$COREFILE

if [ -x $LISP ] && [ -e $CORE ]; then
        $LISP -core $CORE -quiet -noinit -batch \
              -eval '(set-dispatch-macro-character #\# #\!\
                       (lambda (stream bang number)\
                         (declare (ignore bang number))\
                           (read-line stream) t))'\
              -load $1 -eval '(quit)'\
              -args "$@"
else
        echo "$0: could not find a Lisp I know how to call."
fi

runlisp

スペースの都合でおり返しているが,本当は $LISP 以下は長い一行.

これができたら,あとは

#!/usr/bin/evn runlisp
(write-line "Hello, World!!")

hello.lisp

としてスクリプトが完成する.

% cat >hello.lisp
#!/usr/bin/evn runlisp
(write-line "Hello, World!!")
% chmod +x hello.lisp
% ./hello.lisp
Hello, World!!
% 

実行画面

ディレクトリ内のファイル一覧を表示するには

#!/usr/bin/evn runlisp
(dolist (file (directory "./"))
  (format t "~a~%" file))

ls.lisp

とすればよい.

シェルスクリプト用マクロ & 関数

runlisp によってシェルからの実行が可能になった.しかし,このままでは引数(sh でいう $0 〜 $9, $* とか)が使えない.また,ちょっとファイル全体を処理したくても

(with-open-file (s filename)
  (do ((l (read-line s nil 'eof) (read-line s nil 'eof)))
      ((eq l 'eof))
    ...))

ファイル処理のイディオム(?)

等で面倒である.

そこで,引数 arg0 〜 arg9, arg* とファイルの全ての行を走査するマクロ with-all-lines を定義する.

(defpackage :clscript (:use :common-lisp :ext :clawk) (:nicknames :script))
(in-package :clscript)

(defvar *arguments*
  (car
   (mapcar #'cmd-switch-words
	   (remove-if
	    (complement #'(lambda (sw) (equal (cmd-switch-name sw) "args")))
	    *command-line-switches*))))

(defvar arg* (cdr *arguments*))
(defvar arg0 (nth 0 *arguments*))
(defvar arg1 (nth 1 *arguments*))
(defvar arg2 (nth 2 *arguments*))
(defvar arg3 (nth 3 *arguments*))
(defvar arg4 (nth 4 *arguments*))
(defvar arg5 (nth 5 *arguments*))
(defvar arg6 (nth 6 *arguments*))
(defvar arg7 (nth 7 *arguments*))
(defvar arg8 (nth 8 *arguments*))
(defvar arg9 (nth 9 *arguments*))

(defun get-option (key)
  (remove-if
   (complement #'(lambda (sw) (equal (cmd-switch-name sw) key)))
   *command-line-switches*))

(defmacro with-all-lines ((var stream-or-file) &body body)
   (let ((stream (gensym)))
    `(if (streamp ,stream-or-file)
      (with-all-lines-of-stream (,var ,stream-or-file) ,@body)
      (with-open-file (,stream ,stream-or-file)
	(with-all-lines-of-stream (,var ,stream) ,@body)))))

(defmacro with-all-lines-of-stream ((var stream) &body body)
  (let ((eof (gensym)))
    `(do ((,var (read-line ,stream nil ',eof) (read-line ,stream nil ',eof)))
         ((eq ,var ',eof))
      ,@body)))

shell.lisp

今後はイメージにこの shell.lisp がロードされているものとする.イメージを準備するのが面倒な人はスク リプト中で load してもよい.

不経済 echo

Common Lisp による echo コマンド.これだけのプログラムのために起動するには CMU Common Lisp はもったいなさすぎるので不経済 echo である.手元の環境では lisp プロセスは 20 MB ほどメモリを消費している(メモリ内には x86 ネイティブ コンパイラ,Common Lisp,CLOS, CLOCC, CL-PDF, LML, Grey Stream, lexer, regex, cl-awk, UFFI, asdf 等の機能が含まれているからしょーがないかもしれない) おり,今迄に見たなかでも屈指の不経済っぷりである事は間違いない.

#!/usr/bin/env runlisp

(in-package :clscript)

(dolist (i arg*) (format t "~a " i)))
(format t "~%")

不経済 cat

Common Lisp による cat コマンド

#!/usr/bin/env runlisp

(in-package :clscript)

(dolist (file arg*)
  (with-all-lines file
    #'(lambda (line) (write-line line))))

不経済行番号表示

#!/usr/bin/env runlisp

(load "clscript")
(in-package :clscript)

(dolist (file arg*)
  (let ((n 0))
    (with-all-lines (line file)
      (incf n)
      (format t "~4d: ~a~%" n line))))

不経済 grep

#!/usr/bin/env runlisp

(in-package :clscript)
(use-package :regex)

(defun grep (str file &key (filename nil) (lines nil))
  (let ((regexp (compile-str str))
	(n      0))
    (with-all-lines (line file)
      (incf n)
      (when (scan-str regexp line)
	(when filename (format t "~a:" file))
	(when lines    (format t "~d: " n))
	(write-line line)))))

(when (< (length arg*) 2)
  (write-line "too few arguemnts..."))

(dolist (file (cdr arg*))
  (grep (car arg*) file :filename t :lines t))