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-25

.12

| 00:28 | .12 - わだばLisperになる を含むブックマーク はてなブックマーク - .12 - わだばLisperになる

日課練習、SRFI-1細かいの色々。

*print-circle*はtのこころ。

;; ================================================================
(defun zip (&rest clists)
  (apply #'mapcar #'list clists))

;; ================================================================
(defun length+ (list)
  (and (proper-list? list)
       (list-length list)))

;; ================================================================
(defun proper-list? (x)
  (and (listp x)
       (not (circular-list? x))
       (null (cdr (last x)))))

;; ================================================================
(defun null-list? (x)
  (and (or (proper-list? x)
	   (circular-list? x)
	   (error "*** ERROR: argument must be a list, but got: ~S" x))
       (null x)))

;; ================================================================
(defun dotted-list? (x)
  (and (listp x)
       (not (circular-list? x))
       (not (null (cdr (last x))))))

;; ================================================================
(defun circular-list? (lst)
  (and (consp lst)
       (not (atom (cdr lst)))
       (cddr lst)
       (prog (x y)
             (setq x (cdr lst))
	     (setq y (cddr lst))
          l  (cond ((null x) (return nil))
		   ((eq x y) (return t)))
	     (setq x (cdr x))
	     (setq y (cddr y))
	     (go l))))

;; ================================================================
(defun null? (x)
  (null x))

;; ================================================================
(defun pair? (x)
  (consp x))

;; ================================================================
(defun not-pair? (x)
  (not (consp x)))