タブ形式から lisp へ - 新千葉ガーベージ・コレクション

いくつかの言語ではタブによるインデントの違いからブロックを類推する言語がある。なんとなく、Lisp の括弧をなくそうとする涙ぐましい努力のような気もする。とはいえ、可読性を考えると有益な手段であるともいえる。
結局、Lisp にしてしまえばいいので、その為のコンバータを作ってみる。
まずはタブを含むテキストを読んで、その構造をリスプにするコンバータを作ってみる。
その前に、簡単なライブラリを作る。

(defun read-list (file-name)
  (let (rv)
    (with-open-file (f file-name :direction :input)
      (loop for line = (read-line f nil f)
            until (eq line f)
            do (push line rv)))
    (nreverse rv)))

(defun count-tab (str &optional (pos 0) (rv 0))
  (if (null str) rv
    (if (= (length str) 0) 0
      (if (char= (char str pos) #\Tab)
        (count-tab str (+ pos 1) (+ rv 1))
        rv))))

;defmacro
(defun pre-body-post-to-asm (pre-n body post-n rv)
  (if pre-n (push (list 'push pre-n) rv))
  (if post-n (push (list 'pop post-n) rv))
  (if body (push (list 'string body) rv))
  rv)

なんか毎回似たようなものを作っている気がするが、気にしない。pre-body-post-to-asm は defmacro にしたほうがよい。

(defun tab-to-depth (list &optional (depth 0) (rv (pre-body-post-to-asm 1 nil nil nil)))
  (if (null list)
    (progn
      (setf rv
      (pre-body-post-to-asm nil nil (+ depth 1) rv))
      (nreverse rv))
    (let ((target (car list))
          (remain (cdr list)))
      (let* ((tab-n (count-tab target))
             (str (subseq target tab-n))
             pre-n body post-n)
        (cond ((= (length target) 0)
               (setf tab-n depth))
              ((= depth tab-n)
               (setf body str))
              ((< depth tab-n)
               (setf pre-n (- tab-n depth)
                     body str))
              (t ;(> depth tab-n)
                (setf body str
                      post-n (- depth tab-n))))
        (setf rv
        (pre-body-post-to-asm pre-n body post-n rv))

この tab-to-depth に string のリストをあたえると、結果として、

((push 1) (string "a") (pop 1))

みたいな列が出来上がる。あとはこれを一個一個、再度解釈していけばよい。

(defun asm-to-string (lst)
  (apply #'string-concat
         (mapcar #'(lambda (x)
                     (let ((op (car x))
                           (imm (cadr x)))
                       (cond ((eq op 'push)
                              (make-sequence 'string imm :initial-element #\( ))
                             ((eq op 'pop)
                              (make-sequence 'string imm :initial-element #\) ))
                             ((eq op 'string)
                              (format nil "~s" imm))))) lst)))

これはダサいが、asm-to-string でカッコつきの string に変換する。
あとはこれを read でよめば、Lisp の S 式になる。

(defun string-to-s (str)
  (with-input-from-string (in str) (read in)))

実行霊

if [ a = b ] ; then
        echo hello world
        echo a = b
        echo good bye
else
        echo hello world(else)
        echo a != b
        echo good bye(else)

これを

(setf test-str (read-list "test/test.txt"))

("if [ a = b ] ; then" "        echo hello world" "     echo a = b"
 "      echo good bye" "else" " echo hello world(else)" "       echo a != b" "      echo good bye(else)" "")

この時点では Tab が入っている。さらに

(setf test-asm (tab-to-depth test-str))

((PUSH 1) (STRING "if [ a = b ] ; then") (PUSH 1) (STRING "echo hello world")
 (STRING "echo a = b") (STRING "echo good bye") (POP 1) (STRING "else")
 (PUSH 1) (STRING "echo hello world(else)") (STRING "echo a != b")
 (STRING "echo good bye(else)") (POP 2))

これでアセンブラぽくなった。さらに（これはださいが、、、）

(setf test-result-str (asm-to-string test-asm))

"(\"if [ a = b ] ; then\"(\"echo hello world\"\"echo a = b\"\"echo good bye\")\"else\"(\"echo hello world(else)\"\"echo a != b\"\"echo good bye(else)\"))"

でストリング化された。本当はここでちゃんと解釈して Lisp を吐き出した方がよい。

(setf test-list (string-to-s test-result-str))

( "if [ a = b ] ; then"
  ( "echo hello world"
    "echo a = b"
    "echo good bye" )
  "else"
  ("echo hello world(else)"
   "echo a != b"
   "echo good bye(else)" ))

なんかこの時点ではあまり意味がないなぁ。せっかく作ったけど。