回転行列

(defun (setf matrix-at) (value m i j) ;; row major
  (setf (elt m (+ (* i 4) j)) value))

(defun rotation-matrix!(identity-mat degree x y z &key setter)
  (let ((m identity-mat)
	(setter (if setter setter #'(setf matrix-at)))
	(mag (sqrt (apply #'+ (mapcar #'(lambda (x) (* x x)) (list x y z))))))
    (labels ((set-matrix (value mat row col)
	       (funcall setter value mat row col))
	     (id (m)
	       (loop for i from 0 below 4 do
		    (loop for j from 0 below 4 do
			 (set-matrix (if (= i j) 1 0) m i j)))))
      (if (> mag 0)
	  (let* ((s (sin (/ (* degree pi) 180)))
		 (c (cos (/ (* degree pi) 180)))
		 (x (/ x mag)) (y (/ y mag)) (z (/ z mag))
		 (x*xyz (mapcar #'(lambda (v) (* x v)) (list x y z)))
		 (y*xyz (mapcar #'(lambda (v) (* y v)) (list x y z)))
		 (z*xyz (mapcar #'(lambda (v) (* z v)) (list x y z)))
		 (xs (* x s)) (ys (* y s)) (zs (* z s))
		 (1-cos (- 1 c))
		 (hoge (lambda (x y) (+ (* 1-cos x) y)))
		 (row1 (mapcar hoge x*xyz (list c (- zs) ys)))
		 (row2 (mapcar hoge y*xyz (list zs c (- xs))))
		 (row3 (mapcar hoge z*xyz (list (- ys) xs c))))
	    (id m)
	    (loop for i from 0 below 3 do
		 (progn
		     (set-matrix (elt row1 i) m 0 i)
		     (set-matrix (elt row2 i) m 1 i)
		     (set-matrix (elt row3 i) m 2 i))))
	  (id m))
      m)))

(defun mat*vec4(mat lst)
  (loop for i from 0 below 4 collect
       (apply #'+ 
	      (mapcar #'* lst 
		      (loop for j from 0 below 4 collect
			   (matrix-at mat j i))))))

行列とかいいながら、row majorなリストだったりしてます。
テンプレートパターンというか、壁に対してコードを書くみたいな状態にしたいときに、
安直に書いてsetfを使ってしまうとうまくいかなかったので、ちょっと無理矢理やってみました。
スッキリしなくてモヤっとしております。