CLに中間記法を導入するリードマクロ。http://my.opera.com/zeptometer/blog/2011/03/27/cl

infix.lisp

(defvar operators '((or) (and) (== !=) (< <= > >=) (+ -) (* / %) (^))   "演算子。優先順位の低い順にグループ分け。")
(defvar clfunction '((or or) (and and) (== =) (!= (lambda (x y) (not (= x y)))) (< <) (<= <=) (> >) (>= >=) (+ +) (- -) (* *) (/ /) (% mod) (^ expt)) "演算子と関数の対応表")

(defun single (x)
  (and (consp x) (null (cdr x))))

;(defun operatorp (op)
;  (some (lambda (x) (member op x)) operators))

;(defun infixp (exp)
;  "expが中間記法の時、tを返す"
;  (and (consp exp)
;       (not (operatorp (car exp)))
;       (operatorp (cadr exp))
;       (or (infixp (cddr exp))
;	   (single (cddr exp)))))

(defun op-cl (op)
  "opに対応するCL関数を返す"
  (cadr (assoc op clfunction)))

(defun devide-infix (exp ops)
  "ops中の演算子でexpを分割する。複数出てくる場合は最後のものを。
   三つの値を返す。
   1: 演算子
   2: 演算子より前の式
   3: 演算子より後の式

   Example:
   (devide-infix '(1 + 2 * 3 - 3) '(+ -))
    -> -
       (1 + 2 * 3)
       (3)"
  (labels ((rec (exp ops after)
	     (if (member (car exp) ops)
		 (values (car exp) (reverse (cdr exp)) after)
		 (rec (cdr exp) ops (cons (car exp) after)))))
    (if (some (lambda (x) (member x exp)) ops)
	(rec (reverse exp) ops nil))))

(defun infix-polish (exp)
  "中間記法の式を普通のS式(ポーランド記法)に変換する。"
  (if (single exp)
      (car exp)
      (dolist (ops operators)
	(when (some (lambda (op) (member op exp)) ops)
	  (multiple-value-bind (op bef af) (devide-infix exp ops)
	    (return (list (op-cl op) (infix-polish bef) (infix-polish af))))))))

(defmacro infix (&rest exp)
  "中間記法用マクロ"
  (infix-polish exp))

(set-macro-character #\} (get-macro-character #\)))

(set-macro-character #\{
		     (lambda (stream char)
		       (declare (ignore char))
		       (cons 'infix (read-delimited-list #\} stream t))))

;(defun niji (a b c)
;  {{(- b) + (sqrt {b ^ 2 - 4 * a * c})} / {2 * a}})

;(defun niji* (a b c)
;  {{- b + sqrt {b ^ 2 - 4 * a * c}} / {2 * a}})

;(defun test (n)
;   {n * (1+ n) / 2})

(defun test2 (a d n)
  {n * {2 * a + {n - 1} * d} / 2})