Ruby 方面でみかけたネタに触発されました．Lisp はプログラマブルな言語な のでリーダーもプログラマブルです．そこでリーダーをいじって let や defun などの構文を括弧じゃなくて end にでもしてみましょうか．
100 行程度を目標にトライしました．使ったライブラリは CL-Yacc のみです． できあがったのがこちら．
#@suck-lisp
defun fib (n)
if (< n 0)
(error "oops")
elif (= n 0)
0
elif (= n 1)
1
else
let
x <- (fib (- n 1))
y <- (fib (- n 2))
in
(+ x y)
end
end
end
defun f (lst)
(print-lst lst)
end
defun print-lst (lst)
when lst
let
x <- (car lst)
xs <- (cdr lst)
in
(print x)
(print-lst xs)
end
end
end
defun walk (dir)
let
files <- nil
dirs <- (cl-fad:list-directory dir)
in
(dolist (d dirs)
if (cl-fad:directory-exists-p d)
(setf files (append files (walk d)))
else
(push d files)
end)
files
end
end
defun print-file-list ()
(loop for e in (walk "./") do (format t "~A~&" e))
end
これは Common Lisp です．括弧が足りなくない？とお疑いの人のために read で読み込んでみます．
CL-USER> (read-from-string "#@suck-lisp
defun fib (n)
if (< n 0)
(error \"oops\")
elif (= n 0)
0
elif (= n 1)
1
else
let
x <- (fib (- n 1))
y <- (fib (- n 2))
in
(+ x y)
end
end
end")
(progn
(defun fib (n)
(if (< n 0) (progn (error "oops"))
(if (= n 0) (progn 0)
(if (= n 1) (progn 1)
(progn (let ((x (fib (- n 1))) (y (fib (- n 2)))) (+ x y))))))))
276
CL-USER>
いかにも機械変換な汚ないコードですが，ちゃんと S 式として読み取られてい ます．
まぁ，これは小規模な例ですが実際には S 式を生のまま見せずにユーザーフレ ンドリな形式を用意するのは良くある例です．そこで，今回は上記のミニ言語 をネタに CL-Yacc 入門です．
CL-Yacc は Lisp 用のパーサジェネレータです．他にも Zebu, Meta, LALR な どいくつかあります．
一般にコンパイラが行う作業は 字句解析 -> 構文解析 -> 意味解析 -> コード 生成 ですが，別にコンパイラを目標にしなくても，それぞれの段階だけでも十 分に有用です．たとえば，字句解析 -> 意味解析のレベルだけでも下記のよう な用途が考えられます．
Lisp では「字句解析 -> 構文解析」を行う **read 関数** が標準で備わって います．S 式で全てが済めばこれで十分なケースも多いのですが，残念ながら 世の中には S 式を嫌う人が多いようです．なんといっても，実際世の中に S 式ではないデータが溢れている現状では理想だけでは生きていけません．
この二つをつかいますが，まず目標を決めましょう．defun や if，let といっ た構文を非 S 式的表現であらわすようにします．つまり `(defun )` では なく `defun end` に，`(if )` ではなく `if end` に，`(let )` ではなく `let end` に変更します．
;; defun 構文
(defun 関数名 (引数 ...)
処理)
↓
defun 関数名 (引数 ...)
処理
end
;; if 構文
(if 条件
真の場合の処理
偽の場合の処理)
↓
if 条件
真の場合の処理
else
偽の場合の処理
end
;; let 構文
(let ((変数 値)
(変数 値)
(変数 値))
式)
↓
let
変数 <- 値
変数 <- 値
in
式
end
こんな感じ．
字句解析
ではサンプルを元に字句解析器を考えましょう．基本的に使える 式やシンボルは Lisp と完全互換にするため（read で読みとって手抜きするた め），各トークンの区切りは空白が必要という事にします．
いま考えた構文より，少なくとも終端記号として defun, if, let, は必要であ る事がわかります．それ以外はシンボルも文字も数値も atom としてしまいま しょう．また付随する構文要素 else や <- も用意します．
また，リスト中で構文をつかうために '(1 2 3) のようなリストにたいして read を呼ばずに lparen atom atom atom rparen のように S 式解析を自 前でおこないます．
;; サンプル
defun fib (n)
if (< n 2)
n
else
let
n1 <- (fib (- n 1))
n2 <- (fib (- n 2))
in
(+ n1 n2)
end
end
end
lexer は，これを次のように字句解析しなければなりません．
defun : (:defun 'defun) fib : (:atom 'fib) ( : (:lparen '|(|) n : (:atom 'n) ) : (:rparen '|)|) if : (:if 'if) ( : (:lparen '|(|) < : (:atom '<) n : (:atom 'n) 2 : (:atom 2) ) : (:atom '|)|) n : (:atom 'n) else : (:else 'else) let : (:let 'let) n1 : (:atom 'n1) <- : (:<- '<-) ( : (:lparen '|)|) fib : (:fib 'fib) ( : (:rparen '|)|) - : (:atom '-) n : (:atom 'n) 1 : (:atom 1) ) : (:rparen '|)|) ) : (:rparen '|)|) n2 : (:atom 'n2) <- : (:<- '<-) ( : (:lparen '|(|) fib : (:atom 'fib) ( : (:lparen '|(|) - : (:atom '-) n : (:atom 'n) 2 : (:atom 2) ) : (:rparen '|)|) ) : (:rparen '|)|) in : (:in 'in) ( : (:lparen '|(|) + : (:atom '+) n1 : (:atom 'n1) n2 : (:atom 'n2) ) : (:rparen '|)|) end : (:end 'end) end : (:end 'end) end : (:end 'end)
面倒なので，() 以外は Lisp 標準の read に頼ります．
(defun lexer (stream)
(let ((c (peek-char t stream nil :eof))) ;; 一文字先読み
(case c
(:eof (values nil nil))
(#\( (values :lparen (read-char stream)))
(#\) (values :rparen (read-char stream)))
(t
(let ((e (read stream)))
(typecase e
(symbol
(cond ((string-equal (symbol-name e) "defun")
(values :let e))
((string-equal (symbol-name e) "if")
(values :if e))
((string-equal (symbol-name e) "else")
(values :if e))
((or (string-equal (symbol-name e) "let")
(string-equal (symbol-name e) "let*"))
(values :let e))
((string-equal (symbol-name e) "<-")
(values :<- e))
((string-equal (symbol-name e) "in")
(values :in e))
((string-equal (symbol-name e) "end")
(values :end e))
(t
(values :atom e))))
(t
(values :atom e))))))))
つくったら早速 REPL で試してみましょう．
CL-USER> (defparameter *sample* " ;; サンプル
defun fib (n)
if (< n 2)
n
else
let
n1 <- (fib (- n 1))
n2 <- (fib (- n 2))
in
(+ n1 n2)
end
end
end
")
*sample*
CL-USER> (with-input-from-string (s *sample*)
(loop
(multiple-value-bind (tok val)
(lexer s)
(format t "(~S ~S)~&" tok val)
(unless tok (return)))))
(:def defun)
(:atom fib)
(:lparen #\()
(:atom n)
(:rparen #\))
(:if if)
(:lparen #\()
(:atom <)
(:atom n)
(:atom 2)
(:rparen #\))
(:atom n)
(:else else)
(:let let)
(:atom n1)
(:<- <-)
(:lparen #\()
(:atom fib)
(:lparen #\()
(:atom -)
(:atom n)
(:atom 1)
(:rparen #\))
(:rparen #\))
(:atom n2)
(:<- <-)
(:lparen #\()
(:atom fib)
(:lparen #\()
(:atom -)
(:atom n)
(:atom 2)
(:rparen #\))
(:rparen #\))
(:in in)
(:lparen #\()
(:atom +)
(:atom n1)
(:atom n2)
(:rparen #\))
(:end end)
(:end end)
(:end end)
(nil nil)
nil
CL-USER>
このとおり字句解析できました．次はこれを構文解析しましょう．
CL-Yacc の構文定義には define-parser を使います．
(define-parser *parser-1* (:start-symbol program) (:terminals (:def :if :else :let :<- :in :end :lparen :rparen :atom)) ...
まず最初の状態として，このパーサーで解析するのはプログラムですから program とします．そして lexer て定義した終端記号をずらずらと並べます． ここまでできたら，いよいよ本題の構文を定義します．
;; プログラムは複数の式から構成されます． ;; プログラム -> 式* (program exprs) ;; 複数の式 (= 式*) は一つ以上の式から構成されます (exprs (exprs expr) (expr))
では式を定義しましょう．とうぜん式は S 式だと考えてください．S 式は アトムもしくはリストです．
;; 式はリストかアトム (expr list :atom)
そしてリストは括弧で囲まれた式から構成されます．
;; リストは ( ) もしくは ( 式* ) (list (:lparen :rparen) (:lparen exprs :rparen)
もし貴方が病的に括弧を嫌いでなければ，ほぼこれで構文定義終了なんです が…．次にルールにアクションを定義してやります．アクションは，ルールの 値をすべて引数にとる関数を指定します．面倒なので無名関数で済ませます． 引数名は通常の関数と同様，意味のある名前をつけてもいいんですが，yacc に 習って順番に $1 $2 のように位置を表わす名前をつかいます．
(list (:lparen :rparen #'(lambda ($1 $2) nil)) (:lparen exprs :rparen #'(lambda ($1 $2 $3) $2)))
解説しますと，:lparen の値は #\(, :rparen の値は #\) として帰ってきます が，たとえば () は nil になってほしいわけです．これが '(#\( #\)) だった ら鬱になりますよね？そこでアクション部で nil を返すように定義しています． 同様に要素を持つ場合も #\( #\) を無視して式を表わすリストを返すようにア クションを定義しています．
まぁ，実際に動かしてもらったほうが理解がはやいと思うのでまず S 式をパー スするパーサーを定義します．
(define-parser *parser-0*
(:start-symbol program)
(:terminals (:def :if :else :let :<- :in :end :lparen :rparen :atom))
(program exprs)
(exprs
(expr exprs #'(lambda ($1 $2) (cons $1 $2)))
(expr #'(lambda ($1) (list $1))))
(expr
list
:atom)
(list
(:lparen :rparen #'(lambda ($1 $2) ()))
(:lparen exprs :rparen #'(lambda ($1 $2 $3) (list $2)))))
まだ defun や if や let を入力するとエラーになりますが，これを動作させ てみましょう．
CL-USER> (with-input-from-string (s "(20 (20)) (foo bar)")
(parse-with-lexer
#'(lambda () (multiple-value-bind (x y) (lexer s) (format t "~A,~A~&" x y) (values x y)))
*parser-0*))
lparen,(
atom,20
lparen,(
atom,20
rparen,)
rparen,)
lparen,(
atom,foo
atom,bar
rparen,)
nil,nil
((20 (20)) (foo bar))
CL-USER>
ちゃんと入れ子になったリストも解析できました!!この段階でいろいろ入力して試しておきましょう．
では，最初に考えた構文を CL-Yacc 形式で見直してみましょう．字句解析は済んでいるとします．
;; defun 構文 (defun 関数名 (引数 ...) 処理) ↓ defun 関数名 (引数 ...) 処理 end
[CL-Yacc] (:defun :atom :list exprs :end)
簡単ですねー．
;; if 構文 (if 条件 真の場合の処理 偽の場合の処理) ↓ if 条件 真の場合の処理 else 偽の場合の処理 end [CL-Yacc] (:if expr exprs :end) ;; else 節無しの場合 (:if expr exprs :else exprs :end) ;; else 節ありの場合
else の有無で二つのルールになります．なんかあまりにシンプルでおもしろく なさそうなので，次の let は妙な代入を導入して一捻りしてあります．
;; let 構文
(let ((変数 値)
(変数 値)
(変数 値))
式)
↓
let
変数 <- 値
変数 <- 値
in
式
end
[CL-Yacc]
(:let var-form :in exprs :end)
;; var-form は (atom :<- expr) のリストとする
どうでしょうか．あとは式の定義を拡張しておきましょう．
(expr list :atom) ↓ (expr def-form ;; defun 構文 if-form ;; if 構文 let-form ;; let 構文 list :atom)
これで expr が入る場所にはどこにでも構文が使えるようになりました．
(define-parser *parser-1*
(:start-symbol program)
(:terminals (:def :if :else :let :<- :in :end :lparen :rparen :atom))
(program (exprs #'(lambda ($1) (cons 'progn $1))))
(exprs
(expr exprs #'(lambda ($1 $2) (cons $1 $2)))
(expr #'(lambda ($1) (list $1))))
(expr
def-form
if-form
let-form
list
:atom)
(list
(:lparen :rparen
#'(lambda ($1 $2) '()))
(:lparen exprs :rparen
#'(lambda ($1 $2 $3) $2)))
(def-form
(:def :atom list exprs :end
#'(lambda ($1 $2 $3 $4 $5) `(,$1 ,$2 ,$3 ,@$4))))
(if-form
(:if expr exprs :end
#'(lambda ($1 $2 $3 $4) `(,$1 ,$2 (progn ,@$3))))
(:if expr exprs :else exprs :end
#'(lambda ($1 $2 $3 $4 $5 $6) `(,$1 ,$2 (progn ,@$3) (progn ,@$5)))))
(let-form
(:let var-form :in exprs :end
#'(lambda ($1 $2 $3 $4 $5) `(,$1 ,$2 ,@$4))))
(var-form
(var var-form #'(lambda ($1 $2) (cons $1 $2)))
(var #'(lambda ($1) (list $1))))
(var
(:atom :<- expr #'(lambda ($1 $2 $3) `(,$1 ,$3)))))
CL-USER> (defparameter *sample* " ;; サンプル
defun fib (n)
if (< n 2)
n
else
let
n1 <- (fib (- n 1))
n2 <- (fib (- n 2))
in
(+ n1 n2)
end
end
end
")
CL-USER> (with-input-from-string (s *sample*)
(parse-with-lexer
#'(lambda () (multiple-value-bind (x y) (lexer s) (format t "~A,~A~&" x y) (values x y)))
*parser-1*))
def,defun
atom,fib
lparen,(
atom,n
rparen,)
if,if
lparen,(
atom,<
atom,n
atom,2
rparen,)
atom,n
else,else
let,let
atom,n1
<-,<-
lparen,(
atom,fib
lparen,(
atom,-
atom,n
atom,1
rparen,)
rparen,)
atom,n2
<-,<-
lparen,(
atom,fib
lparen,(
atom,-
atom,n
atom,2
rparen,)
rparen,)
in,in
lparen,(
atom,+
atom,n1
atom,n2
rparen,)
end,end
end,end
end,end
nil,nil
(progn
(defun fib (n)
(if (< n 2) (progn n)
(progn (let ((n1 (fib (- n 1))) (n2 (fib (- n 2)))) (+ n1 n2))))))
CL-USER>
できました．
この非 S 式構文パーサーですが，このままではストリームを解析 する機能しかありません．通常の Lisp のように書くにはどうしたら良いでしょうか？ 普通に考えれば，このパーサーをつかってソースを読み込んで解釈する関数を作る事になるでしょう．
(defun load-with-new-syntax (file)
(with-open-file (s file :direction :input)
(eval
(parse-with-lexer #'(lambda () (lexer s)) *parser-1*))))
Lisp でも同様の事はできますが，ここでもう一つの Lisp のマイナー機能リー ダーマクロに目を向けましょう．Lisp 経験の浅い人には聞き慣れない用語かも しれませんが，実は普段使っているベクタ表記 `#()` や虚数を表わす `#C(0 1)` ，複数行コメントの `#| |#` などもリーダーマクロです．これ は，リード時（Lisp の字句解析時）に展開されるマクロであるため，リーダー マクロと呼ばれています．
では，早速リーダーマクロを作成しましょう．作りたいのは次のようなリーダー マクロです．
#@new-syntax ;; これ以降の行は全て新しい構文で解釈される
defun fib (n)
if (<= n 1)
n
else
let
n1 <- (fib (- n 1))
n2 <- (fib (- n 2))
in
(+ n1 n2)
end
end
end
(defun new-syntax-reader (stream) (read-line stream nil :eof) (yacc::parse-with-lexer #'(lambda () (lexer stream)) *parser-1*)) (defun sharp-at-reader (stream c1 c2) (new-syntax-reader stream)) (set-dispatch-macro-character #\# #\@ #'sharp-at-reader)
これだけです．これだと `#@` の行は読み飛ばされるようになっていますので 何を書いても構文が切り替わってしまいますが，ドーンといきましょう．
さて，上記のパーサーとリーダーマクロ `#@` をコンパイルしてロードした後 に，さっそく新しい構文の lisp ファイルを用意します．
;; newsyntax.lisp
#@new-syntax ;; これ以降の行は全て新しい構文で解釈される
;; 別に Lisper でもこう書きますよ :-)
defun fib (n)
if (<= n 1)
n
else
let
n1 <- (fib (- n 1))
n2 <- (fib (- n 2))
in
(+ n1 n2)
end
end
end
;; 別にこれでもいい ;-) ですが，やるなら Python ライクな構文にするでしょう．
defun fib2 (n)
if (<= n 1)
n
else
let
n1 <- (fib2 (- n 1))
n2 <- (fib2 (- n 2))
in
(+ n1 n2) end end end
CL-USER> (load "newsyntax.lisp") T CL-USER> (fib 20) 6765
これで完成です．いかがですか？ Lisp の持つ構文抽象はプログラマブルなリー ダーと組み合わせで，このように括弧を減らす事すら可能です． CMU の AI Repository などを探索すると既に数十年前に C ライクな構文の実装が存在し ていた事がわかります（Dylan ではなく，Lisp そのものです．しかし，誰も使 わなかったため廃れていったようです）．
しかし，見た目がどうあろうと，これも Lisp です!!
一つのエントリとしては長くなってきたので，後で CL-Yacc ページにでもまと め直します．
(defpackage :suck-syntax (:use #:cl #:yacc))
(in-package :suck-syntax)
(define-parser *suck-parser*
(:start-symbol program)
(:terminals (:def :when :if :else :elif :let :in :<- :end :atom :lparen :rparen))
(program (defs #'(lambda ($1) (cons 'progn $1))))
(defs
(def defs #'(lambda ($1 $2) (cons $1 $2)))
(def #'(lambda ($1) (list $1))))
(def
(:def :atom list exprs :end
#'(lambda ($0 $1 $2 $3 $4) `(,$0 ,$1 ,$2 ,@$3)))
expr)
(list
(:lparen :rparen #'(lambda ($1 $2) '()))
(:lparen exprs :rparen #'(lambda ($1 $2 $3) $2)))
(let-form
(:let vars :in exprs :end
#'(lambda ($1 $2 $3 $4 $5)`(,$1 ,$2 ,@$4))))
(if-form
(:if expr exprs :end
#'(lambda ($1 $2 $3 $4)
`(,$1 ,$2 (progn ,@$3))))
(:if expr exprs :else exprs :end
#'(lambda ($1 $2 $3 $4 $5 $6) `(,$1 ,$2 (progn ,@$3) (progn ,@$5))))
(:if expr exprs :elif elif-form
#'(lambda ($1 $2 $3 $4 $5)
`(,$1 ,$2 (progn ,@$3) ,$5))))
(elif-form
(expr exprs :elif elif-form
#'(lambda ($1 $2 $3 $4) `(if ,$1 (progn ,@$2) ,$4)))
(expr exprs :else exprs :end
#'(lambda ($1 $2 $3 $4 $5) `(if ,$1 (progn ,@$2) (progn ,@$4))))
(expr exprs :end
#'(lambda ($1 $2 $3) `(if ,$1 (progn ,@$2)))))
(when-form
(:when expr exprs :end
#'(lambda ($1 $2 $3 $4)
`(,$1 ,$2 ,@$3))))
(expr let-form when-form if-form list :atom :in)
(exprs
(expr exprs #'(lambda ($1 $2) (cons $1 $2)))
(expr #'(lambda ($1) (list $1))))
(vars
(var vars #'(lambda ($1 $2) (cons $1 $2)))
(var #'(lambda ($1) (list $1))))
(var
(:atom :<- expr #'(lambda ($1 $2 $3) `(,$1 ,$3)))))
(defun lexer (s)
(let ((c (peek-char t s nil :eof)))
(case c
(:eof (values nil nil))
(#\( (values :lparen (read-char s)))
(#\) (values :rparen (read-char s)))
(t (let ((e (read s)))
(typecase e
(symbol
(cond ((or (string-equal (symbol-name e) "let")
(string-equal (symbol-name e) "let*"))
(values :let e))
((or (string-equal (symbol-name e) "defun")
(string-equal (symbol-name e) "defmacro")
(string-equal (symbol-name e) "define-compiler-macro")
(string-equal (symbol-name e) "defmethod"))
(values :def e))
((or (string-equal (symbol-name e) "when")
(string-equal (symbol-name e) "unless"))
(values :when e))
((string-equal (symbol-name e) "if")
(values :if e))
((string-equal (symbol-name e) "else")
(values :else e))
((string-equal (symbol-name e) "elif")
(values :elif e))
((string-equal (symbol-name e) "<-")
(values :<- e))
((string-equal (symbol-name e) "in")
(values :in e))
((string-equal (symbol-name e) "end")
(values :end e))
(t (values :atom e))))
(t (values :atom e))))))))
(defun suck-syntax-reader (stream)
(read-line stream nil :eof)
(yacc::parse-with-lexer #'(lambda () (lexer stream)) *suck-parser*))
(defun sharp-at-reader (stream c1 c2)
(declare (ignorable c1 c2))
(suck-syntax-reader stream))
(set-dispatch-macro-character #\# #\@ #'sharp-at-reader)
posted: 2006/03/30 23:58 | permanent link to this entry | Tags: