Common Lispで中置記法
水曜日, 3 月 10th, 2010
lispでは前置記法が用いられますが, 数学的なプログラムの実装はなかなか難しいという問題があります.
Common Lispにはリードマクロがあるので, 中置記法を実現することができます.
本記事の内容はnurarihyonというパッケージで提供しているものです.
というわけで実装へ
今回は#%(…)というリードマクロを考えます. ここで…の部分に中置記法が可能なようにします.
ここで以下のような仕様にします
- <-, =で代入可能なようにする
- @で配列の要素にアクセスする
- 複数の引数をとる場合は$でその区切りを指定する
では以下実装.
(defun read-infix-sexp (stream n char) (declare (ignore n char)) (let ((sexp (read stream))) (infix->prefix sexp))) (defun infix->prefix/split$ (arg &optional (buf nil) (result nil)) "this function separete arg by the symbol `$'" ;; first, just separate arg by $. ;; (1 $ 2 $ 3) -> ((1) (2) (3)) ;; (1 + 2 $ 3) -> ((1 + 2) (3)) ;; (1 + 2 $ 3) -> (+ 2 $ 3) (1) () ;; -> (2 $ 3) (1 +) () ;; -> ($ 3) (1 + 2) () ;; -> (3) () ((1 + 2)) ;; -> () (3) ((1 + 2)) ;; -> ((1 + 2) (3)) (cond ((null arg) (append result (list buf))) ((and (symbolp (car arg)) (eq (chimi:symbol->keyword (car arg)) :$)) (infix->prefix/split$ (cdr arg) nil (append result (list buf)))) (t (infix->prefix/split$ (cdr arg) (append buf (list (car arg))) result)))) (defun infix->prefix/function-call (a b c) "For example, a := sin b := (1) c := another s-expression..." ;; its deficult to estimate the number of arguments of b. ;; so we utilize another syntax `$' for separate arguments. (let ((function-sexp (cons a (mapcar #'infix->prefix (infix->prefix/split$ b))))) (if c ;; if there is c, we need to resolve c to operator and its args. (destructuring-bind (operator & args) c (list operator function-sexp (infix->prefix args))) function-sexp))) (defun %infix->prefix (sexp) (destructuring-bind (a &optional b &rest c) sexp ;(a b . c) (cond ((and (not (null b)) (listp b)) ;when b is list ;; here, we check sexp like (sin(x) ...) (infix->prefix/function-call a b c)) ((and a b c) (let ((bsym (chimi:symbol->keyword b))) (case bsym (:@ ;; @ works as aref a @ (1 2) -> (aref a 1 2) ;; a @ 1 -> (aref a 1) ;; here we need to think aboud (cdr c) too... (destructuring-bind (index &rest args) c (let ((this-section (if (listp index) (append (list 'aref a) index) (append (list 'aref a) (list index))))) (if args (destructuring-bind (operator &rest op-args) args (list (infix->prefix operator) ;no need? this-section (infix->prefix op-args))) this-section)))) (t (list (infix->prefix b) (infix->prefix a) (infix->prefix c)))))) ((and b (null c)) ; no c, it means function appling like sin(x) (list (infix->prefix a) (infix->prefix b))) ((and (null b) (null c)) (infix->prefix a))))) ;only a (defun infix->prefix (sexp) "This function converts an infix s-expression to a prefix s-expression." (cond ((and (symbolp sexp) (or (eq (chimi:symbol->keyword sexp) :<-) (eq (chimi:symbol->keyword sexp) :=))) 'setf) ;setf alias ((listp sexp) (%infix->prefix sexp)) ;we need to convert (t sexp))) ;may be literal
ここで, chimi:keyword->symbolは以下のような実装です
(defun symbol->keyword (sym) "convert a symbol to keyword. ;;; (symbol->keyword 'hoge) -> :hoge" (declare (type symbol sym)) (intern (string sym) :keyword))
これを使うと中置記法ができます.
(set-dispatch-macro-character #\# #\% 'read-infix-sexp) (defvar a 0) #%(a <- 1 + 2 + atan(1.0 $ 1.0)) ;; expand to (SETF A (+ 1 (+ 2 (ATAN 1.0 1.0)))) a = 3.7853982 (defvar b (make-array 3 :initial-element 3)) #%(b @ (0) + 100.0) ;; => 103.0 expanded as (+ (AREF B 0) 100.0)
以外とみにくいですねw
