codejamの過去問でcommon lispの練習

codejamの季節が近づいてきたのでcommon lispの練習をしました
問題は2013のqualification round

まずA
入力をアトムへ置き換えて横向きのリストで格納して、さらに縦向きのリストと斜めのリストを作ってX,Oどちらかが勝っている状態があるか検索
とりあえず横向きで検索、見つからなかったら縦向きで検索、さらに見つからなかったら斜めで検索
X,Oどちらの勝利状態も見つからない場合引き分けかどうか判定
マクロの練習として、縦向きのリストの作成をマクロで展開してみました
例えば将棋やオセロなんかのプログラムだとリストを走査する際にループじゃなくていちいち展開しているっぽいなと思ったので、一度マクロで試してみたかったので無理やりマクロ使いましたが結果はいいのか悪いのか不明
プログラムが分かりにくくなったのはとりあえず分かる

(defun readstream(callback)
  (labels ((rec(n)
    (let ((line (read-line *standard-input* nil)))
      (when line
     (funcall callback line n)
     (rec (1+ n))))))
 (rec 0)))

(let ((a '(0 1 2 3)))
  (defun tosymb(line)
 (mapcar (lambda(n) (read-from-string (substitute #\B #\. line) nil nil :start n :end (1+ n))) a))
  (defmacro tocross(lst)
 `(list
    (list ,@(mapcar (lambda(n) `(nth ,n (nth ,n ,lst))) a))
    (list ,@(mapcar (lambda(n) `(nth (- 3 ,n) (nth ,n ,lst))) a))
    ))
  (defmacro tovertical(lst)
 `(list
    ,@(mapcar (lambda(m)
     (cons 'list (mapcar (lambda(n) `(nth ,m (nth ,n ,lst))) a))
     ) a)
    )
 )
  (defun makelst(b n)
 (mapcar (lambda(m) (if (= n m) 't b)) a))

  (defmacro searcher(lst v)
 `(let ((target ',(mapcar (lambda(n) (makelst v n)) a)))
    (labels ((rec(ta)
      (cond ((null ta) nil)
      ((equal (car ta) ,lst) ',v)
      (t (rec (cdr ta))))))
   (rec (cons (list ',v ',v ',v ',v) target))
    )
 ))
  )

(defun hanbetsu(inlst)
  (labels ((rec(lst)
    (cond ((null lst) nil)
       ((searcher (car lst) x) 'x)
       ((searcher (car lst) o) 'o)
       (t (rec (cdr lst))))))
 (rec inlst)))

(defun drawp(lst)
  (labels ((rec(lst)
    (cond ((null lst) 'd)
       ((find 'b (car lst)) 'n)
       (t (rec (cdr lst))))))
 (rec lst)))

(defmacro ifelse(pred else)
  `(let ((r ,pred))
  (if r
    r
    (progn ,else))))

(defun test()
  (let ((lst '((a b c d) (e f g h) (i j k l) (m n o p))))
 (format t "~A~%" (macroexpand-1 '(ifelse (hanbetsu (tocross in)) (lambda()))))
 ;(format t "~A~%" (drawp '((a z c d e))))
 ;(format t "~A~%" (mapcar (lambda(n) (makelst 'x n)) '(0 1 2 3)))
 ;(format t "~A~%" (macroexpand-1 '(searcher (car lst) x)))
 ;(format t "~A~%" (hanbetsu '((x x t x))))
 ;(format t "~A~%" (macroexpand-1 '(tocross lst)))
 ;(format t "~A~%" (tocross lst))
 ;(format t "~A~%" (macroexpand-1 '(tovertical lst)))
 ;(format t "~A~%" (tovertical lst))
 (format t "~%~%")
 ))
;(test)

(defun compute(in)
  (ifelse (hanbetsu (tocross in))
    (ifelse (hanbetsu (tovertical in))
      (ifelse (hanbetsu in)
        (drawp in)))))

(let ((in nil)
   (index 0)
   (messagelut '((x . "X won") (o . "O won") (d . "Draw") (n . "Game has not completed"))))
  (readstream (lambda(line n)
    (cond ((zerop (rem n 5)) (setf in nil) (incf index))
    ((= (rem n 5) 4)
     (progn
    (setf in (cons (tosymb line) in))
    (format t "Case #~A: ~A~%" index (cdr (assoc (compute (reverse in)) messagelut)))
    ))
    (t (setf in (cons (tosymb line) in)))))
  )
  )