Packrat Parsing: 遅延版
前回の実装ではメモ化をハッシュテーブルを用いて実装していたが、それを論文*1に合わせて遅延実行を利用するものに修正。
こっちの方が(あらかじめ入力テキストの各位置に対して、遅延されたパーサ関数実行を用意しておく必要があるが)メモ化によって既に計算済みの値のチェックが、eq関数の呼び出し一つで行えるので効率が良い。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; 遅延評価用のマクロと関数の定義 ;; 式の実行を遅延 (let ((undef (gensym))) (defmacro delay (exp) `(let ((#1=#:result ',undef)) (lambda () (if (eq #1# ',undef) ; #:resultの値が初期値と等しいかをチェック (setf #1# ,exp) ; 等しいならexpを実行して、#:resultに結果を保存 #1#))))) ; #:resultに以前の実行結果が格納されているなら、それを返す ;; 遅延された式の評価 (defun force (exp) (if (functionp exp) (funcall exp) exp))
;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; パーサ定義補助関数等 ;;; 以下三つは前回と同じ ;; 範囲外アクセス時に#\Nullを返すchar関数 (defun char* (s i) (or (ignore-errors (char s i)) #\Null)) ;; 式(リスト)が'(return ...)形式かどうかを判定する (defun return-exp-p (exp) (and (listp exp) (eq (car exp) 'return))) (deftype return-exp () '(satisfies return-exp-p)) ;; 与えられた引数を文字列として連結し、シンボルに変換して返す (defun symb (&rest args) (intern (with-output-to-string (out) (dolist (a args) (princ a out))))) ;; パーサ定義補助用マクロ ;; 基本的な構造は前回と同じ ;; 異なる点: ;; - 入力が文字列の変わりにderivs構造体(入力テキストの各文字をノードとする連結リストの一種) ;; - 他のパース結果の参照は、パーサ関数を直接呼び出す代わりに、derivs構造体のフィールドに格納されている遅延されたパース処理を評価することで行う (defmacro with-parser ((input) &body tokens) (labels ((recur (tokens) (destructuring-bind (token . rest) tokens (etypecase token (string `(and (char= ,(char token 0) (derivs-char ,input)) (let ((,input (derivs-next ,input))) ,(recur rest)))) (return-exp `(list t ,(second token) ,input)) (list (destructuring-bind (var <- parser) token (declare (ignore <-)) `(destructuring-bind (#1=#:succeed? ,var ,input) (force (,(symb 'derivs- parser) ,input)) (and #1# ,(recur rest))))))))) (recur tokens)))
;; derivs構造体 ※ 'derivs'は論文によれば'derivations'の略 (defstruct derivs char ; 入力テキストの現在位置の文字 next ; 次の位置(derivs構造体)へのリンク additive ; 現在位置に対するadditive関数の遅延された実行 multitive ; 現在位置に対するmultitive関数の遅延された実行 primary ; 現在位置に対するprimary関数の遅延された実行 decimal) ; 現在位置に対するdecimal関数の遅延された実行
;;;;;;;;;;; ;;;; パーサ (defun parse (s) (force (derivs-additive (parse-impl s)))) (defun parse-impl (s) (let ((d (make-derivs :char (char* s 0)))) ; 現在位置の文字を設定してderivsインスタンスを生成 (with-slots (additive multitive primary decimal char next) d (setf additive (delay (additive d)) ; (additive d)を遅延 multitive (delay (multitive d)) ; (multitive d)を遅延 primary (delay (primary d)) ; (primary d)を遅延 decimal (delay (decimal d))) ; (decimal d)を遅延 (when (plusp (length s)) ; 入力テキストの次の位置も同様に処理する (setf next (parse-impl (subseq s 1))))) d)) ;; parse-implは入力文字列を、derivsインスタンスの連結リストに変換する (parse-impl "lisp") --> #S(DERIVS :ADDITIVE #<CLOSURE (LAMBDA #) {B056165}> :MULTITIVE #<CLOSURE (LAMBDA #) {B05617D}> :PRIMARY #<CLOSURE (LAMBDA #) :DECIMAL #<CLOSURE (LAMBDA #) {B0561AD}>{B056195}> :CHAR #\l ; "l" :NEXT #S(DERIVS :ADDITIVE #<CLOSURE # {B056205}> :MULTITIVE #<CLOSURE # {B05621D}> :PRIMARY #<CLOSURE # {B056235}> :DECIMAL #<CLOSURE # {B05624D}> :CHAR #\i ; "i" :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\s ; "s" :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\p ; "p" :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\Nul ; 終端文字 :NEXT NIL))))) ;; 以下、additive/multititve/primary、の定義は引数名を変更した以外は、前回と同様 (defun additive (drv) (labels ((alt1 () (with-parser (drv) (v1 <- multitive) "+" (v2 <- additive) (return (+ v1 v2)))) (alt2 () (with-parser (drv) (v1 <- multitive) "-" (v2 <- additive) (return (- v1 v2)))) (alt3 () (multitive drv))) (or (alt1) (alt2) (alt3)))) (defun multitive (drv) (labels ((alt1 () (with-parser (drv) (v1 <- primary) "*" (v2 <- multitive) (return (* v1 v2)))) (alt2 () (with-parser (drv) (v1 <- primary) "/" (v2 <- multitive) (return (/ v1 v2)))) (alt3 () (primary drv))) (or (alt1) (alt2) (alt3)))) (defun primary (drv) (labels ((alt1 () (with-parser (drv) "(" (v <- additive) ")" (return v))) (alt2 () (decimal drv))) (or (alt1) (alt2)))) (defun decimal (drv) (with-slots (char next) drv (or (and (char<= #\0 char #\9) (list t (- (char-code char) (char-code #\0)) next)) (list nil nil drv))))
実行例
(parse "1+2") --> (T 3 #S(DERIVS :ADDITIVE #<CLOSURE # {B066885}> :MULTITIVE #<CLOSURE # {B06689D}> :PRIMARY #<CLOSURE # {B0668B5}> :DECIMAL #<CLOSURE # {B0668CD}> :CHAR #\Nul :NEXT NIL)) (parse "4*2-((3+1)-(9/3))*2") --> (T 6 #S(DERIVS :ADDITIVE #<CLOSURE # {B06AC2D}> :MULTITIVE #<CLOSURE # {B06AC45}> :PRIMARY #<CLOSURE # {B06AC5D}> :DECIMAL #<CLOSURE # {B06AC75}> :CHAR #\Nul :NEXT NIL)) ;; 不正な入力文字列: 二文字目以降のパースに失敗 (parse "4**2-3/5") --: (T 4 #S(DERIVS :ADDITIVE #<CLOSURE # {B06CB0D}> :MULTITIVE #<CLOSURE # {B06CB25}> :PRIMARY #<CLOSURE # {B06CB3D}> :DECIMAL #<CLOSURE # {B06CB55}> :CHAR #\* :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\* :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\2 :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\- :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\3 :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\/ :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\5 :NEXT #S(DERIVS :ADDITIVE # :MULTITIVE # :PRIMARY # :DECIMAL # :CHAR #\Nul :NEXT NIL)))))))))
