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-06-01


.3

| 23:03 | .3 - わだばLisperになる を含むブックマーク はてなブックマーク - .3 - わだばLisperになる

毎日少しでもコードを書いてみようということで、好みの題材を色々物色。

自分は、アプリケーションの作成にはあまり興味がなく、ユーティリティや、処理系自体に興味があるみたいなので、SchemeのSRFIをCommon Lispで書いてみることにした。SRFIの内容も覚えられて一石二鳥。

Gaucheのマニュアルが親切な解説付きなので、それを参考に作ってみる。

何故か無性にPROGが使いたいので、6~70年代のスタイルで書いてみることに。…割には、レトロさが徹底できていない。

;; =============================================================================
;; Function: xcons cd ca
;; =============================================================================
;;     [SRFI-1] (cons ca cd) と同等です。高階手続きへ渡すのに便利です。 

(defun xcons (cd ca)
  (cons ca cd))

;; =============================================================================
;; Function: cons* elt1 elt2 …
;; =============================================================================
;; [SRFI-1] list と似ていますが、最後の引数が構築されたリストの末尾になります。
;; Gauche の組み込み手続き list* と同意です。

;;     (cons* 1 2 3 4) ⇒ (1 2 3 . 4)
;;     (cons* 1) ⇒ 1

(defun cons* (&rest elts)
  (cond ((cdr elts)
	 (prog (init l retlst)
	       (setq init (reverse elts))
	       (setq l (cddr init))
	       (setq retlst (cons (cadr init) (car init)))
	     l (cond ((endp l) (return retlst)))
	       (setq retlst (cons (car l) retlst))
	       (setq l (cdr l))
	       (go l)))
	('t (car elts))))

;; =============================================================================
;; Function: list-tabulate n init-proc
;; =============================================================================
;; [SRFI-1] n個の要素をもつリストを構築し、それぞれの要素を (init-proc i) で生成
;; します。
;;
;;     (list-tabulate 4 values) ⇒ (0 1 2 3)

(defun list-tabulate (n init-proc)
  (prog (l retlst)
        (setq l (iota n))
      l (cond ((endp l) (return (nreverse retlst))))
	(setq retlst (cons (funcall init-proc (car l)) retlst))
	(setq l (cdr l))
	(go l)))

;; =============================================================================
;; Function: iota count &optional (start 0) (step 1)
;; =============================================================================
;; [SRFI-1] startから始まり、stepずつ増加する、 count 個の要素からなる数値のリス
;; トを返します。
;;
;;     (iota 5) ⇒ (0 1 2 3 4)
;;     (iota 5 0 -0.1) ⇒ (0 -0.1 -0.2 -0.3 -0.4)

(defun iota (count &optional (start 0) (step 1))
  (prog (i c retlst)
        (setq i start)
	(setq c count)
	(setq retlst '() )
      l (cond ((zerop c) (return (nreverse retlst))))
	(setq retlst (cons i retlst))
	(setq c (1- c))
	(setq i (+ step i))
	(go l)))