CommonLispでなんちゃって中置記法

前回のg1さんの記事に引き続き、
Lispリーダマクロアドベントカレンダー第二回です。

リーダマクロで何ができるのか

今回はリーダマクロで何が出来るのか, という例を示してみたいと思います。

リーダマクロは、簡単に言うと、リーダの振る舞いに手を加えてシンタックスシュガーを
変更してしまうことが可能な機能です。

というわけで今回はLisp(Common Lisp)で中置記法を実現させてみたいと思います。

Lispのシンタックスシュガー

Lispの特徴的なシンタックスシュガーは簡単に言うと、

(function arg0 arg1 arg2 ...)

のように、カッコの先頭が関数、その後ろが引数というものです。前置記法ですね。
したがって加算は

(+ 1 2)
;; => 3

のように書きます。

Lispで中置記法

一方よくあるプログラミング言語では、

int a = 1 + 2; /* a => 3*/

ですね。

ですが、リーダマクロを使えば以下のように記述することができます。

#%(1 + 2) 
;; => 3

実装

実装はかなり適当です。

やっていることは単純で、(1 + 2)を(+ 1 2)に読み替えるような
リーダマクロになってます。$を予約後に使ってしまってるのでそこがダメダメです。

あとは関数っぽいものはそれっぽく展開してます. たとえばsin(1)は(sin 1)に。

この実装を利用するとこんなかんじになります。#%()の中で中置記法で書けるようになります。

#%(1 + 2)
;; => 3
#%(1.5 + 2.5)
;; => 4.0
#%(1.0 + sin(0.5))
;; => 1.4794255
#%(a = 1 + 2)
;; a => 3

以下実装

infix.lisp

(defun read-infix-sexp (stream n char)
  "this is a function to register as a read macro function for #%."
  (declare (ignore n char))
  (let ((sexp (read stream)))
    (infix->prefix sexp)))

(defun infix->prefix/split$ (arg &optional (buf nil) (result nil))
  "this function separetes arg by the symbol $."
  ;; first, just separates arg by $.
  ;; (1 $ 2 $ 3) -> ((3) (2) (1))
  ;; (1 + 2 $ 3) -> ((3) (1 + 2))
  ;; (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 (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)
  "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 &rest args) c
          (list operator function-sexp (infix->prefix args)))
      function-sexp)))

(defun %infix->prefix (sexp)
  "internal function of infix->prefix. this function will call infix->prefix
recursively to convert a infix s-expression into a prefix s-expression."
  (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)
           (list (infix->prefix b)
                 (infix->prefix a) (infix->prefix c)))
          ;; TODO: required?
          ((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.

 example::

  (1 + 2) => (+ 1 2)"
  (cond
   ((and (symbolp sexp)
         (or (eq (symbol->keyword sexp) :<-)
             (eq (symbol->keyword sexp) :=)))
    'setf)                              ;setf alias
   ((listp sexp) (%infix->prefix sexp)) ;we need to convert
   (t sexp)))                           ;may be literal

(defun symbol->keyword (sym)
  "convert a symbol to a keyword.

 example::

  (sybol-keyword 'hoge) => :hoge"
  (intern (string sym) :keyword))

(set-dispatch-macro-character #\# #\% 'read-infix-sexp)

最後に

この実装では演算子の結合順序がないので、カッコだらけになります笑。
Lispがカッコだらけだと言われるのは、演算子の結合の強度が無いからですね。