2009年11月4日水曜日

続cl-yacc

どうしようか迷ったけど、いいや貼り付けてしまえ。

とりあえず、文法をうまくかけるかどうか、ということが問題。

自分の脳みそではあんまり考えられないけど、何かの文法をパクっても、どうせ途中でオレオレルールになるだろうから、試行錯誤しながら書いてみる。

(defun test-parse (file)
(with-open-file (s file :direction :input)
(yacc:parse-with-lexer
(list-lexer-c
(read-c-like s))
*c-like*)))

(eval-when (compile load eval)
(defun i2p (a b c)
"Infix to Prefix"
(list b a c))
(defun k-2-3 (a b c)
(declare (ignore a c))
b))

(defun read-c-like (stream)
(let ((*readtable* (copy-readtable *readtable*)))
(loop :for ch across ";,(){}"
:do
(set-macro-character
ch
#'(lambda (stream ch)
(declare (ignore stream))
(intern (string ch) :keyword))))

(loop :for ch across "%/*"
:do
(set-macro-character
ch
#'(lambda (stream ch)
(declare (ignore stream))
(intern (string ch)))))

(set-macro-character
#\=
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
:==)
:=)))
(set-macro-character
#\<
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
'<=)
'<)))
(set-macro-character
#\>
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
'>=)
'>)))
(set-macro-character
#\+
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\+ (peek-char nil stream))
(progn (read-char stream)
:++)
'+)))
(set-macro-character
#\-
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\- (peek-char nil stream))
(progn (read-char stream)
:--)
'-)))
(loop
:while (listen stream)
:collect
;;シンボル中のアンダースコアを読み込んだ後にハイフンに直す
(let ((obj (read stream)))
(if (symbolp obj)
(let ((name (symbol-name obj)))
(intern
(map 'string
#'(lambda (ch)
(if (char= ch #\_)
#\-
ch))
name)
(symbol-package obj)))
obj)))))

(defun list-lexer-c (list)
#'(lambda ()
(let ((val (pop list)))
(if (null val)
(values nil nil)
(let ((terminal
(cond
((member val '(+ - * / %
:= :== < > <= >=
:++ :--)) val)
((eq :|(| val) :lparen)
((eq :|)| val) :rparen)
((eq :|{| val) :bstart)
((eq :|}| val) :bend)
((eq :|;| val) :eend)
((eq :|,| val) :sep)
((integerp val) :num)
((stringp val) :string)
((eq 'for val) :for)
((eq 'if val) :if)
((eq 'else val) :else)
((eq 'return val) :return)
((member val '(string int void)) :type)
((symbolp val) :name)
(t (error "Unexpected value ~A" val)))))
(values terminal val))))))

(yacc::define-parser *c-like*
(:start-symbol PROGRAM)
(:terminals
(:type :name :num :string
+ :++ - :-- * / % := :== < <= > >=
:for :if :else
:return
:struct
:bstart :bend ;block {}
:sep ; separator ,
:eend ; ;
:lparen :rparen))
(:precedence ;演算子優先順位
((:left * / %)
(:left + -)
(:left :== <= >= < >)))

(PROGRAM
(DEFS #'(lambda (defs) `(progn ,@defs))))
(DEFS
(DEF DEFS #'cons)
(DEF #'list))
(DEF
DEFVAR
DEFUN)
(DEFVAR
;;=> type name;
(:type :name :eend
#'(lambda (type name $3) `(defparameter ,name)))
;;=> type name = expression;
(:type :name := EXPRESSION :eend
#'(lambda (type name $3 expression $4)
`(defparameter ,name ,expression))))
(DEFUN
;;=> int hoge(args){bodies}
(:type :name :lparen DEFUN-ARGS :rparen :bstart BODIES :bend
#'(lambda (type name $3 args $5 $6 bodies $8)
`(defun ,name ,args
(block nil ,@bodies))))
(:type :name :lparen :rparen :bstart BODIES :bend
#'(lambda (type name $3 $4 $5 bodies $6)
`(defun ,name () (block nil ,@bodies)))))
(DEFUN-ARGS
;;=> int n , int m
(:type :name :sep DEFUN-ARGS
#'(lambda (type name $3 args)
(cons name args)))
(:type :name #'(lambda (type name) (list name))))
(FUNCALL
(:name :lparen ARGS :rparen
#'(lambda (name $2 args $4)
`(,name ,@args)))
(:name :lparen :rparen
#'(lambda (name $2 $3)
`(,name))))
(ARGS
(ARG #'list)
(ARG :sep ARGS #'(lambda (arg $2 args) (cons arg args))))
(ARG
EXPRESSION
FUNCALL
LITERALL)
(LITERALL
:name
:num
:string)
(EXPRESSIONS
(EXPRESSION #'list)
(EXPRESSION :sep EXPRESSIONS
#'(lambda (exp $2 exprs)
(cons exp exprs))))
(EXPRESSION
(expression + expression #'i2p)
(expression - expression #'i2p)
(expression * expression #'i2p)
(expression / expression #'i2p)
(expression % expression
#'(lambda (exp1 $2 exp2)
`(mod ,exp1 ,exp2)))
(expression :== expression
#'(lambda ($1 $2 $3) `(equal ,$1 ,$3)))
(expression < expression #'i2p)
(expression <= expression #'i2p)
(expression > expression #'i2p)
(expression >= expression #'i2p)
exp-term)
(exp-term
LITERALL
(:- exp-term)
SUBST
FUNCALL
(|(| expression |)| #'k-2-3))
;;代入
(SUBST
(:name := EXPRESSION
#'(lambda (name $2 expr)
`(setf ,name ,expr)))
;;後置インクリメント
(:name :++
#'(lambda (name $2)
`(prog1 ,name
(incf ,name))))
;;前置インクリメント
(:++ :name
#'(lambda ($1 name)
`(incf ,name)))
(:name :--
#'(lambda (name $2)
`(prog1 ,name
(decf ,name))))
(:-- :name
#'(lambda ($1 name)
`(decf ,name))))
;;関数やブロック内の変数宣言はletに展開する
(LET-FORM
(:type :name := EXPRESSION :eend BODIES
#'(lambda (type name $3 expr $5 bodies)
`(let ((,name ,expr)) ,@bodies)))
(:type :name :eend BODIES
#'(lambda (type name $3 bodies)
`(let (,name) ,@bodies))))
(IF-FORM
(:if :lparen expression :rparen :bstart bodies :bend
#'(lambda ($1 $2 $3 $4 $5 $6 $7)
`(when ,$3 ,@$6)))
(:if :lparen expression :rparen :bstart bodies :bend :else :bstart bodies :bend
#'(lambda ($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11)
`(if ,$3 (progn ,@$6) (progn ,@$10))))
(:if :lparen expression :rparen :bstart bodies :bend :else body
#'(lambda ($1 $2 $3 $4 $5 $6 $7 $8 $9)
`(if ,$3 (progn ,@$6) ,$9))))
(FOR-FORM
(:for :lparen :type :name :=
EXPRESSION :eend EXPRESSION :eend EXPRESSIONS :rparen :bstart BODIES :bend
#'(lambda ($1 $2 type name $5 expr1 $7 expr2 $9 exprs
$11 $12 bodies $14)
`(loop :with ,name = ,expr1
:while ,expr2
:do ,@bodies ,@exprs)))
(:for :lparen :name :=
EXPRESSION :eend EXPRESSION :eend EXPRESSIONS :rparen
:bstart BODIES :bend
#'(lambda ($1 $2 name $4 expr1 $6 expr2 $8 exprs $10 $11 bodies $13)
`(progn
(setf ,name ,expr1)
`(loop
:while ,expr2
:do ,@bodies ,@exprs))))
(:for :lparen :eend EXPRESSION :eend EXPRESSIONS :rparen
:bstart BODIES :bend
#'(lambda ($1 $2 $3 expr2 $5 exprs $7 $8 bodies $10)
`(loop :while ,expr2
:do ,@bodies ,@exprs))))
(BODIES
(BODY BODIES #'cons)
(BODY #'list))
(BODY
RETURN-FORM
LET-FORM
(:name := EXPRESSION :eend #'(lambda (name $2 expr $4) `(setf ,name ,expr)))
FOR-FORM
IF-FORM
(EXPRESSION :eend #'(lambda (expr $2) expr)))
(RETURN-FORM
(:return :eend #'(lambda ($1 $2) `(return)))
(:return EXPRESSION :eend #'(lambda ($1 expr $3) `(return ,expr))))
)

read-c-likeで読み込んだリストを引数にしてlist-lexer-cを呼び出し、さらにその返り値をyacc:parse-with-lexerにパーサの定義とともに渡す。

とりあえず、FizzBuzzを書くいてみると、こうなる。

void fizzbuzz(int n)
{
for(int a=1;a<=n;a++)
{
if(a%15==0)
{
format(t,"FizzBuzz");
}
else if(a%5==0)
{
format(t,"Buzz");
}
else if(a%3==0)
{
format(t,"Fizz");
}
else
{
format(t,"~D",a);
}
terpri();
}
}

if~else ifとネストできるが、{}は必須。パースした結果は以下のとおり。

(PROGN
(DEFUN FIZZBUZZ (N)
(BLOCK NIL
(LOOP :WITH A = 1
:WHILE (<= A N)
:DO (IF (EQUAL (MOD A 15) 0) (PROGN (FORMAT T "FizzBuzz"))
(IF (EQUAL (MOD A 5) 0) (PROGN (FORMAT T "Buzz"))
(IF (EQUAL (MOD A 3) 0) (PROGN (FORMAT T "Fizz"))
(PROGN (FORMAT T "~D" A)))))
(TERPRI)
(PROG1 A
(INCF A))))))

スキルが無かろうと、ひたすら適当な文法をつづれば、一応動く。素晴らしい。

0 件のコメント:

コメントを投稿