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


.5

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

鬱気味で、何もする気が起きない。

...けど、他にすることもなさ過ぎるので、引き続き

レトロに風味でSRFI-1の関数を作ろう。作ろう。

;; LIST-REF
(DEFUN LIST-REF (CLIST I)
  (IF (OR (MINUSP I) (> I (LENGTH CLIST)))
      (ERROR "ERROR: ARGUMENT OUT OF RANGE: ~A" I)
    (NTH I CLIST)))

;; TAKE
(DEFUN TAKE (LIST INDEX)
  (PROG (L R CNT)
        (SETQ L LIST)
        (SETQ CNT INDEX)
     L  (COND ((OR (ENDP L) (>= 0 CNT)) (RETURN (NREVERSE R))))
        (PUSH (POP L) R)
        (DECF CNT)
        (GO L)))

;; DROP
(DEFUN DROP (LIST INDEX)
  (PROG (L CNT)
        (SETQ L LIST)
        (SETQ CNT INDEX)
      L (COND ((OR (ENDP L) (>= 0 CNT)) (RETURN L)))
        (POP L)
        (DECF CNT)
        (GO L)))

;;(DEFUN DROP (LIST INDEX)
;;  (NTHCDR INDEX LIST))

;; SPLIT-AT
(DEFUN SPLIT-AT (LIST INDEX)
  (PROG (L R CNT)
        (SETQ L LIST)
        (SETQ CNT INDEX)
      L (COND ((OR (ENDP L) (>= 0 CNT)) 
               (RETURN (VALUES (NREVERSE R) L))))
        (PUSH (POP L) R)
        (DECF CNT)
        (GO L)))

2007-06-07


.4

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

SRFIをまったりと実装して過す初夏。

レトロコンピューティングということで、MacLispで作ってみることに。

さて、現在使えるMaclispの処理系は、どういうものになるかというと、やはりエミュレータ等がメインになるかと思われ、自分もsimhで動く、PDP-10上のITSで稼働させてみたり、公開TOPS-20サイトにログインして動かしてみたりしています。

Maclispの開発環境はどんな感じかといえば、自分も良く分かってはいませんが、恐らく定番はMaclispのLEDIT+EMACSか、TECOということになるんじゃないかと思います。

使い勝手としては、70年代のslimeといった感じ。

EMACSで編集して選択したS式や、リージョンの内容をLispに送り評価、編集し…というのを繰り返す感じです。ショートカットキーがあるので、案外快適にLispとEMACSを行ったり来たりできます。

というか、EMACSの操作感が殆ど現在と一緒なので快適なのかもしれませんが。

;; =============================================================================
;; Function: list= elt= list1 ... -> boolean
;; 要素比較の同値述語手続きを使用して、リストの同値性を判定します。 
;; =============================================================================

;; Maclisp
(defun list= (elt= &rest lists)
  (do ((l lists (cdr l)))
      ((null (cdr l)) t)
    (or (do ((x (car l)  (cdr x))
             (y (cadr l) (cdr y)))
            ((null x) t)
          (or (funcall elt= (car x) (car y))
              (return nil)))
        (return nil))))

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