Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-07-16

.8

| 11:02 | .8 - わだばLisperになる を含むブックマーク はてなブックマーク - .8 - わだばLisperになる

日課練習、日課練習

SRFI-1のfold-rightを作ってみた。

ややこしい。というか、ちゃんとできてるのか疑問。

(defun fold-right (kons knil &rest clists)
  (do ((pairs
        (do ((ls clists (mapcar #'cdr ls))
             (r '() (cons (mapcar #'car ls) r)))
            ((some #'endp ls) r))
        (cdr pairs))
       (r knil (apply kons `(,@(car pairs) ,r))))
      ((endp pairs) r)))

(defun fold-right (kons knil &rest clists)
  (prog (r pairs)
        (setq r knil)
    a   (cond ((some #'endp clists) (go b)))
        (push (mapcar #'car clists) pairs)
        (setq clists (mapcar #'cdr clists))
        (go a)
    b   (cond ((endp pairs) (return r)))
        (setq r (apply kons `(,@(car pairs) ,r)))
        (pop pairs)
        (go b)))