shkmr/lisupu.scm Secret

## lisupu.scm
; $Id: lisp.scm,v 1.2 2003/03/13 04:43:03 skimu Exp $
;;;
;;; LISP in Scheme
;;;
#|
  これを書いたのはもう10年以上前になるのか。。。
　当時は EUC を使ってたのだけど、今回復活にあったて utf-8 に変換して、
　ファイル名も戯さんに提案していただいた lisupu.scm に変更。
　あと、いろいろ口上を並べたけれど、今となっては恥ずかしいので消しました。
  先頭の rcsid は CVS を使ってた当時そのまま残しておきます。

　　　　　　　　　　　　　2015年12月　skimu@mac.com
|#
;;;
;;; 組み込み関数(基本オブジェクトの実装)
;;; 基本的に Scheme の実装をそのまま使う
;;;

(define (じゃない x)    (if (null? x)   '真 '()))

(define (対？ x)        (if (pair? x) '真 '()))
(define 対成  cons)
(define アレ  car)
(define ダレ  cdr)
(define (記号？ x)      (if (symbol? x) '真 '()))
(define (等しい？ x y)  (if (eq? x y)   '真 '()))

(define (数？ x)        (if (number? x) '真 '()))
(define (＝ x y)        (if (= x y)     '真 '()))
(define (＜ x y)        (if (< x y)     '真 '()))
(define ＋    +)
(define −    -)
(define ×    *)
(define ÷    /)

(define (組込関数？ x)  (if (procedure? x) '真 '()))
(define 組込 apply)

;;;
;;; S-式評価器
;;;
(define (評価 式 環境)
  (cond ((number? 式) 式)                        ; 数は自己評価
        ((null? 式)  式)                         ; 空リストも自己評価
        ((symbol? 式) (変数参照 式 環境))        ; 記号ならば変数参照
        ((procedure? (car 式))
         (組込関数呼出 (car 式) (cdr 式) 環境))
        ((symbol? (car 式))
         (case (car 式)                          ; (sym ...) のパターン
           ((引用 quote)   (cadr 式))            ; (quote exp) は exp
           ((λ)  式)                            ; λ 式は自己評価
           ((μ)  式)                            ; μはマクロ. え？なんか違う？
           ((擬引用 quasiquote)
            (擬引用の評価 (cadr 式) 環境))
           ((もし)                               ; (if c t f)
            (もしの評価 (cadr 式) (cddr 式) 環境))
           (else
            (評価 (cons (変数参照 (car 式) 環境) (cdr 式)) 環境))))
        ((eq? (caar 式) 'λ)                     ; ((lambda a b) c)
         (λ呼出 (cadar 式) (cddar 式) (cdr 式) 環境))
        ((eq? (caar 式) 'μ)
         (評価
          (マクロ展開 (cadar 式) (caddar 式) (cdr 式) 環境)
          環境))))

;;;
;;; 変数参照
;;; 環境 = ((名前 値) ...)
;;;
(define (変数参照 名前 環境)
  (let ((項目 (assq 名前 環境)))
    (if 項目
        (cadr 項目)
        '())))

;;;
;;; 組込関数呼出
;;; 引数リストの各要素を評価して組込関数に渡す
;;;
(define (組込関数呼出 関数 引数リスト 環境)
  (apply 関数 (map (lambda (式)
                     (評価 式 環境))
                   引数リスト)))

;;;
;;; もしの評価
;;; 式リストは (成功式 その他式)
;;;
(define (もしの評価 条件 式リスト 環境)
  (if (not (null? (評価 条件 環境)))
      (評価 (car 式リスト) 環境)
      (if (not (null? (cdr 式リスト)))
          (評価 (cadr 式リスト) 環境)
          '())))

;;;
;;; λ式 (λ 引数形式 式 ...)
;;;
(define (λ呼出 仮引数 本体 引数リスト 環境)
  (let 繰り返し ((本体 本体)
                 (環境 (append (括る 仮引数
                                     (map (lambda (式)
                                            (評価 式 環境))
                                          引数リスト))
                               環境)))
       (if (null? (cdr 本体))
           (評価 (car 本体) 環境)
           (begin
             (評価 (car 本体) 環境)
             (繰り返し (cdr 本体) 環境)))))
#|
; λ呼出 を (λ 引数形式 式) というように一つの式しか取らない
; 仕様にすれば, 次のマクロ展開とλ呼出の違いがはっきり見えてくる.
;
(define (λ呼出 仮引数 式 引数リスト 環境)
  (評価 式 (append (括る 仮引数 (map (lambda (式)
                                       (評価 式 環境))
                                     引数リスト))
                   環境)))
|#

;;;
;;; マクロ展開 (μ 引数形式 式)
;;;
;;; マクロを展開するのに LISP 評価器をそのまんま使ってしまう
;;; これ LISP の最大の特徴 (ほんま？)
;;;
(define (マクロ展開 仮引数 式 引数リスト 環境)
  (評価 式 (append (括る 仮引数 引数リスト) 環境)))

;;;
;;; 括る
;;; 仮引数と値リストを環境の形に括る
;;;
;;;    仮引数     値リスト
;;;    (a b c)    (x y z)   -> ((a x) (b y) (c z))
;;;    (a b . c)  (x y z)   -> ((a x) (b y) (c (z)))
;;;    (a b . c)  (x y z w) -> ((a x) (b y) (c (z w)))
;;;    a          (x y z)   -> ((a (x y z)))
(define (括る 仮引数 値リスト)
  (cond ((null? 値リスト) '())
        ((and (pair? 仮引数) (pair? 値リスト))
         (cons (list (car 仮引数) (car 値リスト))
               (括る (cdr 仮引数) (cdr 値リスト))))
        ((and (symbol? 仮引数) (pair? 値リスト))
         (list (list 仮引数 値リスト)))
        (else (error "なんかへん"))))

;;;
;;; 擬引用の評価
;;;
;;; うーむ, これでいいのかなぁ... 自信無し.
;;;
(define (擬引用の評価 擬引用式 環境)
  (cond ((not (pair? 擬引用式)) 擬引用式)
        ((or (eq? '反引用  (car 擬引用式))
             (eq? 'unquote (car 擬引用式)))
         (評価 (cadr 擬引用式) 環境))
        (else
         (擬引用の評価1 擬引用式 環境))))

(define (擬引用の評価1 擬引用式の並び 環境)
  (cond ((null? 擬引用式の並び) '())
        ((pair? (car 擬引用式の並び))
         (case (caar 擬引用式の並び)
           ((擬引用 quasiquote)
            (cons (car 擬引用式の並び)
                  (擬引用の評価1 (cdr 擬引用式の並び) 環境)))
           ((反引用 unquote)
            (cons (評価 (cadar 擬引用式の並び) 環境)
                  (擬引用の評価1 (cdr 擬引用式の並び) 環境)))
           ((脱反引用 unquote-splicing)
            (append (評価 (cadar 擬引用式の並び) 環境)
                    (擬引用の評価1 (cdr 擬引用式の並び) 環境)))
           (else
            (cons (擬引用の評価1 (car 擬引用式の並び) 環境)
                  (擬引用の評価1 (cdr 擬引用式の並び) 環境)))))
        (else
         (cons (car 擬引用式の並び)
               (擬引用の評価1 (cdr 擬引用式の並び) 環境)))))
;;;
;;; 原始環境
;;;
;;; 'x は Scheme リーダによって (quote x) と読み込まれる.
;;;
(define 原始環境
  `(
    (偽        ())
    (真        真)
;
;  組み込み関数
;
    (じゃない ,じゃない)
    (空？     ,じゃない)
    (対？     ,対？)
    (対成     ,対成)
    (アレ     ,アレ)
    (ダレ     ,ダレ)
    (記号？   ,記号？)
    (等しい？ ,等しい？)
    (数？     ,数？)
    (＝       ,＝)
    (＜       ,＜)
    (＋       ,＋)
    (−       ,−)
    (×       ,×)
    (÷       ,÷)
    (組込関数？,組込関数？)
    (組込     ,組込)
    (括る     ,括る)  ; essential じゃないんだけど... 手抜きです.
;
; マクロ
;
    (置く   (μ (_束縛 . _本体)
              `((λ ,(引数形式へ _束縛)
                  ,@_本体)
                ,@(値リストへ _束縛))))
    (どれも (μ _x
              (もし (空？ _x)
                    真
                    `(もし ,(アレ _x)
                           (どれも ,@(ダレ _x))
                           偽))))
    (どれか (μ _x
              (もし (空？ _x)
                    偽
                    `(もし ,(アレ _x)
                           真
                           (どれか ,@(ダレ _x))))))
    (場合分け (μ (_節 . _残り)
                (もし (空？ _残り)
                    `(もし ,(アレ _節)
                           ,(アダレ _節))
                    `(もし ,(アレ _節)
                           ,(アダレ _節)
                           (場合分け ,@_残り)))))
    (振り分け (μ (_それ _節 . _残り)
                (もし (空？ _残り)
                      (もし (対？ (アレ _節))
                            `(もし (要素？ ,_それ ',(アレ _節))
                                   ,(アダレ _節))
                            `,(アダレ _節))
                      `(もし (要素？ ,_それ ',(アレ _節))
                             ,(アダレ _節)
                             (振り分け ,_それ ,@_残り)))))
;
; ライブラリ
;
    (≦        (λ (x y) (どれか (＜ x y) (＝ x y))))
    (≧        (λ (x y) (じゃない (＜ x y))))
    (＞        (λ (x y) (じゃない (≦ x y))))
    (アアレ    (λ (x) (アレ (アレ x))))
    (アダレ    (λ (x) (アレ (ダレ x))))
    (ダアレ    (λ (x) (ダレ (アレ x))))
    (ダダレ    (λ (x) (ダレ (ダレ x))))
    (アアアレ  (λ (x) (アアレ (アレ x))))
    (アアダレ  (λ (x) (アアレ (ダレ x))))
    (アダアレ  (λ (x) (アダレ (アレ x))))
    (アダダレ  (λ (x) (アダレ (ダレ x))))
    (ダアアレ  (λ (x) (ダアレ (アレ x))))
    (ダアダレ  (λ (x) (ダアレ (ダレ x))))
    (ダダアレ  (λ (x) (ダダレ (アレ x))))
    (ダダダレ  (λ (x) (ダダレ (ダレ x))))
    (アダダアレ (λ (x) (アダダレ (アレ x))))
    (リスト    (λ x x))
    (追加      (λ (x y)
                 (もし (空？ x)
                       y
                       (対成 (アレ x) (追加 (ダレ x) y)))))
    (要素？    (λ (それ 集合)
                 (もし (空？ 集合)
                       偽
                       (もし (等しい？ それ (アレ 集合))
                             真
                             (要素？ それ (ダレ 集合))))))
    (写像      (λ (関数 集合)
                 (もし (空？ 集合)
                       '()
                       (対成 (関数 (アレ 集合))
                             (写像 関数 (ダレ 集合))))))
    (連想      (λ (それ 記憶)
                 (もし (空？ 記憶)
                       偽
                       (もし (等しい？ それ (アアレ 記憶))
                             (アレ 記憶)
                             (連想 それ (ダレ 記憶))))))
    (引数形式へ (λ (束縛)
                  (もし (空？ 束縛)
                        偽
                        (対成 (アアレ 束縛) (引数形式へ (ダレ 束縛))))))
    (値リストへ (λ (束縛)
                  (もし (空？ 束縛)
                        偽
                        (対成 (アダアレ 束縛) (値リストへ (ダレ 束縛))))))
    )
  ) ; 原始環境はここまで


;;;
;;; 遊び方
;;;
;;; 評価器を駆動する関数を書いて, うまく動いてるか調べてみる.
;;;
(define (試験 式 正解)
  (format #t "~a " 式) (flush)
  (let ((値 (評価 式 原始環境)))
    (format #t "-> ~a " 値)
    (if (equal? 値 正解)
        (format #t "正解")
        (format #t "はずれ！！！ 正解は ~a" 正解))
    (newline)))

; 即値
(試験 '1 1)
(試験 '真 '真)
(試験 '偽 '())

; 引用
(試験 ''a 'a)

; 単純呼び出し
(試験 '(アレ (リスト 1 2 3)) 1)
(試験 '(ダレ (リスト 1 2 3)) '(2 3))
(試験 '(リスト 'い 'ろ 'は) '(い ろ は))
(試験 '(リスト 1 2 3) '(1 2 3))
(試験 '(要素？ 'りんご '())   '())
(試験 '(要素？ 'りんご '(バナナ ミカン))  '())
(試験 '(要素？ 'りんご '(バナナ りんご ミカン))   '真)
(試験 '(追加 '(1 2) '(3)) '(1 2 3))
(試験 '(写像 (λ (x) x) '(3 2 1)) '(3 2 1))
(試験 '(括る '(a b c) '(1 2 3)) '((a 1) (b 2) (c 3)))

; マクロ
(試験 '(置く ((a 1) (b 2)) (＋ a b)) 3)
(試験 '(どれか) '())
(試験 '(どれも) '真)
(試験 '(どれか 1 2 3) '真)
(試験 '(どれか 偽 偽 3 偽) '真)
(試験 '(どれか 偽 偽 偽) '())
(試験 '(どれも 1 2 3) '真)
(試験 '(どれも 偽 偽 3 偽) '())
(試験 '(場合分け ((＝ 1 2) 3)
                 ((＝ 2 2) 4)
                 (真       5))
      4)
(試験 '(場合分け ((＝ 1 2) 3)
                 ((＝ 2 3) 4)
                 (真       5))
      5)
(試験 '(振り分け 'りんご
          ((バナナ) '叩き売り)
          ((りんご) 'ジャム)
          ((みかん) 'こたつ)
          (その他  'なに？))
      'ジャム)
(試験 '(振り分け 'トマト
          ((バナナ) '叩き売り)
          ((りんご) 'ジャム)
          ((みかん) 'こたつ)
          (その他   'なに？))
      'なに？)


; 動的スコープだからこんなことも可能なのだ.
(試験 '
   ((λ (階乗)
      (階乗 5))
    (λ (n)
        (もし (＝ n 0)
              1
              (× n (階乗 (− n 1))))))
   120
)

; 閉包(closure)を作ってないから高階関数は作れない.
(試験 '
  ((λ (カレー)
     (置く ((い (カレー 'ライス))
            (ろ (カレー 'うどん)))
       (リスト (い 'チキン)  (ろ 'きつね))))
   (λ (レシピ)
    (λ (具) (リスト 具 レシピ))))
  '((チキン ライス) (きつね うどん)))

; マクロにすればできるけど... ダサ.
(試験 '
  ((λ (カレー)
     (置く ((い (カレー 'ライス))
            (ろ (カレー 'うどん)))
       (リスト (い 'チキン)  (ろ 'きつね))))
   (μ (レシピ)
    `(λ (具) (リスト 具 ,レシピ))))
  '((チキン ライス) (きつね うどん)))


; うんでもってリスプ
(試験 '
  ((λ (評価 変数参照 もしの評価 組込関数呼出 λ呼出)
     (評価 '
             ((λ (階乗)
                (階乗 5))
              (λ (n)
                (もし (＝ n 0)
                      1
                      (× n (階乗 (− n 1))))))
             `(
               (＝       ,＝)
               (−       ,−)
               (×       ,×)
               )))
   (λ (式 環境)                               ; 評価
     (場合分け ((数？ 式) 式)
               ((空？ 式) 式)
               ((記号？ 式) (変数参照 式 環境))
               ((組込関数？ (アレ 式))
                (組込関数呼出 (アレ 式) (ダレ 式) 環境))
               ((記号？ (アレ 式))
                (振り分け (アレ 式)
                   ((λ)  式)
                   ((もし)
                    (もしの評価 (アダレ 式) (ダダレ 式) 環境))
                   (その他
                    (評価 (対成 (変数参照 (アレ 式) 環境) (ダレ 式)) 環境))))
               ((等しい？ (アアレ 式) 'λ)
                (λ呼出 (アダアレ 式) (アダダアレ 式) (ダレ 式) 環境))))
   (λ (名前 環境)                             ; 変数参照
     (置く ((項目 (連想 名前 環境)))
        (もし 項目
              (アダレ 項目)
              偽)))
   (λ (条件 式リスト 環境)                    ; もしの評価
     (もし (じゃない (空？ (評価 条件 環境)))
       (評価 (アレ 式リスト) 環境)
         (もし (じゃない (空？ (ダレ 式リスト)))
               (評価 (アダレ 式リスト) 環境)
               偽)))
   (λ (関数 引数リスト 環境)                  ; 組込関数呼出
     (組込 関数 (写像 (λ (式)
                          (評価 式 環境))
                        引数リスト)))
   (λ (仮引数 式 引数リスト 環境)             ; λ呼出
     (評価 式 (追加 (括る 仮引数
                          (写像 (λ (式)
                                  (評価 式 環境))
                                引数リスト))
                    環境)))

   )
  120
  )

#|
(use ggc.debug.trace)
(trace 評価)
(試験 '
   ((λ (階乗)
      (階乗 5))
    (λ (n)
        (もし (＝ n 0)
              1
              (× n (階乗 (− n 1))))))
   120
)
|#
; おしまい
	; $Id: lisp.scm,v 1.2 2003/03/13 04:43:03 skimu Exp $
	;;;
	;;; LISP in Scheme
	;;;
	#\|
	これを書いたのはもう10年以上前になるのか。。。
	当時は EUC を使ってたのだけど、今回復活にあったて utf-8 に変換して、
	ファイル名も戯さんに提案していただいた lisupu.scm に変更。
	あと、いろいろ口上を並べたけれど、今となっては恥ずかしいので消しました。
	先頭の rcsid は CVS を使ってた当時そのまま残しておきます。

	2015年12月　skimu@mac.com
	\|#
	;;;
	;;; 組み込み関数(基本オブジェクトの実装)
	;;; 基本的に Scheme の実装をそのまま使う
	;;;

	(define (じゃない x) (if (null? x) '真 '()))

	(define (対？ x) (if (pair? x) '真 '()))
	(define 対成 cons)
	(define アレ car)
	(define ダレ cdr)
	(define (記号？ x) (if (symbol? x) '真 '()))
	(define (等しい？ x y) (if (eq? x y) '真 '()))

	(define (数？ x) (if (number? x) '真 '()))
	(define (＝ x y) (if (= x y) '真 '()))
	(define (＜ x y) (if (< x y) '真 '()))
	(define ＋ +)
	(define − -)
	(define × *)
	(define ÷ /)

	(define (組込関数？ x) (if (procedure? x) '真 '()))
	(define 組込 apply)

	;;;
	;;; S-式評価器
	;;;
	(define (評価式環境)
	(cond ((number? 式) 式) ; 数は自己評価
	((null? 式) 式) ; 空リストも自己評価
	((symbol? 式) (変数参照式環境)) ; 記号ならば変数参照
	((procedure? (car 式))
	(組込関数呼出 (car 式) (cdr 式) 環境))
	((symbol? (car 式))
	(case (car 式) ; (sym ...) のパターン
	((引用 quote) (cadr 式)) ; (quote exp) は exp
	((λ) 式) ; λ 式は自己評価
	((μ) 式) ; μはマクロ. え？なんか違う？
	((擬引用 quasiquote)
	(擬引用の評価 (cadr 式) 環境))
	((もし) ; (if c t f)
	(もしの評価 (cadr 式) (cddr 式) 環境))
	(else
	(評価 (cons (変数参照 (car 式) 環境) (cdr 式)) 環境))))
	((eq? (caar 式) 'λ) ; ((lambda a b) c)
	(λ呼出 (cadar 式) (cddar 式) (cdr 式) 環境))
	((eq? (caar 式) 'μ)
	(評価
	(マクロ展開 (cadar 式) (caddar 式) (cdr 式) 環境)
	環境))))

	;;;
	;;; 変数参照
	;;; 環境 = ((名前値) ...)
	;;;
	(define (変数参照名前環境)
	(let ((項目 (assq 名前環境)))
	(if 項目
	(cadr 項目)
	'())))

	;;;
	;;; 組込関数呼出
	;;; 引数リストの各要素を評価して組込関数に渡す
	;;;
	(define (組込関数呼出関数引数リスト環境)
	(apply 関数 (map (lambda (式)
	(評価式環境))
	引数リスト)))

	;;;
	;;; もしの評価
	;;; 式リストは (成功式その他式)
	;;;
	(define (もしの評価条件式リスト環境)
	(if (not (null? (評価条件環境)))
	(評価 (car 式リスト) 環境)
	(if (not (null? (cdr 式リスト)))
	(評価 (cadr 式リスト) 環境)
	'())))

	;;;
	;;; λ式 (λ 引数形式式 ...)
	;;;
	(define (λ呼出仮引数本体引数リスト環境)
	(let 繰り返し ((本体本体)
	(環境 (append (括る仮引数
	(map (lambda (式)
	(評価式環境))
	引数リスト))
	環境)))
	(if (null? (cdr 本体))
	(評価 (car 本体) 環境)
	(begin
	(評価 (car 本体) 環境)
	(繰り返し (cdr 本体) 環境)))))
	#\|
	; λ呼出を (λ 引数形式式) というように一つの式しか取らない
	; 仕様にすれば, 次のマクロ展開とλ呼出の違いがはっきり見えてくる.
	;
	(define (λ呼出仮引数式引数リスト環境)
	(評価式 (append (括る仮引数 (map (lambda (式)
	(評価式環境))
	引数リスト))
	環境)))
	\|#

	;;;
	;;; マクロ展開 (μ 引数形式式)
	;;;
	;;; マクロを展開するのに LISP 評価器をそのまんま使ってしまう
	;;; これ LISP の最大の特徴 (ほんま？)
	;;;
	(define (マクロ展開仮引数式引数リスト環境)
	(評価式 (append (括る仮引数引数リスト) 環境)))

	;;;
	;;; 括る
	;;; 仮引数と値リストを環境の形に括る
	;;;
	;;; 仮引数値リスト
	;;; (a b c) (x y z) -> ((a x) (b y) (c z))
	;;; (a b . c) (x y z) -> ((a x) (b y) (c (z)))
	;;; (a b . c) (x y z w) -> ((a x) (b y) (c (z w)))
	;;; a (x y z) -> ((a (x y z)))
	(define (括る仮引数値リスト)
	(cond ((null? 値リスト) '())
	((and (pair? 仮引数) (pair? 値リスト))
	(cons (list (car 仮引数) (car 値リスト))
	(括る (cdr 仮引数) (cdr 値リスト))))
	((and (symbol? 仮引数) (pair? 値リスト))
	(list (list 仮引数値リスト)))
	(else (error "なんかへん"))))

	;;;
	;;; 擬引用の評価
	;;;
	;;; うーむ, これでいいのかなぁ... 自信無し.
	;;;
	(define (擬引用の評価擬引用式環境)
	(cond ((not (pair? 擬引用式)) 擬引用式)
	((or (eq? '反引用 (car 擬引用式))
	(eq? 'unquote (car 擬引用式)))
	(評価 (cadr 擬引用式) 環境))
	(else
	(擬引用の評価1 擬引用式環境))))

	(define (擬引用の評価1 擬引用式の並び環境)
	(cond ((null? 擬引用式の並び) '())
	((pair? (car 擬引用式の並び))
	(case (caar 擬引用式の並び)
	((擬引用 quasiquote)
	(cons (car 擬引用式の並び)
	(擬引用の評価1 (cdr 擬引用式の並び) 環境)))
	((反引用 unquote)
	(cons (評価 (cadar 擬引用式の並び) 環境)
	(擬引用の評価1 (cdr 擬引用式の並び) 環境)))
	((脱反引用 unquote-splicing)
	(append (評価 (cadar 擬引用式の並び) 環境)
	(擬引用の評価1 (cdr 擬引用式の並び) 環境)))
	(else
	(cons (擬引用の評価1 (car 擬引用式の並び) 環境)
	(擬引用の評価1 (cdr 擬引用式の並び) 環境)))))
	(else
	(cons (car 擬引用式の並び)
	(擬引用の評価1 (cdr 擬引用式の並び) 環境)))))
	;;;
	;;; 原始環境
	;;;
	;;; 'x は Scheme リーダによって (quote x) と読み込まれる.
	;;;
	(define 原始環境
	`(
	(偽 ())
	(真真)
	;
	; 組み込み関数
	;
	(じゃない ,じゃない)
	(空？ ,じゃない)
	(対？ ,対？)
	(対成 ,対成)
	(アレ ,アレ)
	(ダレ ,ダレ)
	(記号？ ,記号？)
	(等しい？ ,等しい？)
	(数？ ,数？)
	(＝ ,＝)
	(＜ ,＜)
	(＋ ,＋)
	(− ,−)
	(× ,×)
	(÷ ,÷)
	(組込関数？,組込関数？)
	(組込 ,組込)
	(括る ,括る) ; essential じゃないんだけど... 手抜きです.
	;
	; マクロ
	;
	(置く (μ (_束縛 . _本体)
	`((λ ,(引数形式へ _束縛)
	,@_本体)
	,@(値リストへ _束縛))))
	(どれも (μ _x
	(もし (空？ _x)
	真
	`(もし ,(アレ _x)
	(どれも ,@(ダレ _x))
	偽))))
	(どれか (μ _x
	(もし (空？ _x)
	偽
	`(もし ,(アレ _x)
	真
	(どれか ,@(ダレ _x))))))
	(場合分け (μ (_節 . _残り)
	(もし (空？ _残り)
	`(もし ,(アレ _節)
	,(アダレ _節))
	`(もし ,(アレ _節)
	,(アダレ _節)
	(場合分け ,@_残り)))))
	(振り分け (μ (_それ _節 . _残り)
	(もし (空？ _残り)
	(もし (対？ (アレ _節))
	`(もし (要素？ ,_それ ',(アレ _節))
	,(アダレ _節))
	`,(アダレ _節))
	`(もし (要素？ ,_それ ',(アレ _節))
	,(アダレ _節)
	(振り分け ,_それ ,@_残り)))))
	;
	; ライブラリ
	;
	(≦ (λ (x y) (どれか (＜ x y) (＝ x y))))
	(≧ (λ (x y) (じゃない (＜ x y))))
	(＞ (λ (x y) (じゃない (≦ x y))))
	(アアレ (λ (x) (アレ (アレ x))))
	(アダレ (λ (x) (アレ (ダレ x))))
	(ダアレ (λ (x) (ダレ (アレ x))))
	(ダダレ (λ (x) (ダレ (ダレ x))))
	(アアアレ (λ (x) (アアレ (アレ x))))
	(アアダレ (λ (x) (アアレ (ダレ x))))
	(アダアレ (λ (x) (アダレ (アレ x))))
	(アダダレ (λ (x) (アダレ (ダレ x))))
	(ダアアレ (λ (x) (ダアレ (アレ x))))
	(ダアダレ (λ (x) (ダアレ (ダレ x))))
	(ダダアレ (λ (x) (ダダレ (アレ x))))
	(ダダダレ (λ (x) (ダダレ (ダレ x))))
	(アダダアレ (λ (x) (アダダレ (アレ x))))
	(リスト (λ x x))
	(追加 (λ (x y)
	(もし (空？ x)
	y
	(対成 (アレ x) (追加 (ダレ x) y)))))
	(要素？ (λ (それ集合)
	(もし (空？集合)
	偽
	(もし (等しい？それ (アレ集合))
	真
	(要素？それ (ダレ集合))))))
	(写像 (λ (関数集合)
	(もし (空？集合)
	'()
	(対成 (関数 (アレ集合))
	(写像関数 (ダレ集合))))))
	(連想 (λ (それ記憶)
	(もし (空？記憶)
	偽
	(もし (等しい？それ (アアレ記憶))
	(アレ記憶)
	(連想それ (ダレ記憶))))))
	(引数形式へ (λ (束縛)
	(もし (空？束縛)
	偽
	(対成 (アアレ束縛) (引数形式へ (ダレ束縛))))))
	(値リストへ (λ (束縛)
	(もし (空？束縛)
	偽
	(対成 (アダアレ束縛) (値リストへ (ダレ束縛))))))
	)
	) ; 原始環境はここまで


	;;;
	;;; 遊び方
	;;;
	;;; 評価器を駆動する関数を書いて, うまく動いてるか調べてみる.
	;;;
	(define (試験式正解)
	(format #t "~a " 式) (flush)
	(let ((値 (評価式原始環境)))
	(format #t "-> ~a " 値)
	(if (equal? 値正解)
	(format #t "正解")
	(format #t "はずれ！！！正解は ~a" 正解))
	(newline)))

	; 即値
	(試験 '1 1)
	(試験 '真 '真)
	(試験 '偽 '())

	; 引用
	(試験 ''a 'a)

	; 単純呼び出し
	(試験 '(アレ (リスト 1 2 3)) 1)
	(試験 '(ダレ (リスト 1 2 3)) '(2 3))
	(試験 '(リスト 'い 'ろ 'は) '(いろは))
	(試験 '(リスト 1 2 3) '(1 2 3))
	(試験 '(要素？ 'りんご '()) '())
	(試験 '(要素？ 'りんご '(バナナミカン)) '())
	(試験 '(要素？ 'りんご '(バナナりんごミカン)) '真)
	(試験 '(追加 '(1 2) '(3)) '(1 2 3))
	(試験 '(写像 (λ (x) x) '(3 2 1)) '(3 2 1))
	(試験 '(括る '(a b c) '(1 2 3)) '((a 1) (b 2) (c 3)))

	; マクロ
	(試験 '(置く ((a 1) (b 2)) (＋ a b)) 3)
	(試験 '(どれか) '())
	(試験 '(どれも) '真)
	(試験 '(どれか 1 2 3) '真)
	(試験 '(どれか偽偽 3 偽) '真)
	(試験 '(どれか偽偽偽) '())
	(試験 '(どれも 1 2 3) '真)
	(試験 '(どれも偽偽 3 偽) '())
	(試験 '(場合分け ((＝ 1 2) 3)
	((＝ 2 2) 4)
	(真 5))
	4)
	(試験 '(場合分け ((＝ 1 2) 3)
	((＝ 2 3) 4)
	(真 5))
	5)
	(試験 '(振り分け 'りんご
	((バナナ) '叩き売り)
	((りんご) 'ジャム)
	((みかん) 'こたつ)
	(その他 'なに？))
	'ジャム)
	(試験 '(振り分け 'トマト
	((バナナ) '叩き売り)
	((りんご) 'ジャム)
	((みかん) 'こたつ)
	(その他 'なに？))
	'なに？)


	; 動的スコープだからこんなことも可能なのだ.
	(試験 '
	((λ (階乗)
	(階乗 5))
	(λ (n)
	(もし (＝ n 0)
	1
	(× n (階乗 (− n 1))))))
	120
	)

	; 閉包(closure)を作ってないから高階関数は作れない.
	(試験 '
	((λ (カレー)
	(置く ((い (カレー 'ライス))
	(ろ (カレー 'うどん)))
	(リスト (い 'チキン) (ろ 'きつね))))
	(λ (レシピ)
	(λ (具) (リスト具レシピ))))
	'((チキンライス) (きつねうどん)))

	; マクロにすればできるけど... ダサ.
	(試験 '
	((λ (カレー)
	(置く ((い (カレー 'ライス))
	(ろ (カレー 'うどん)))
	(リスト (い 'チキン) (ろ 'きつね))))
	(μ (レシピ)
	`(λ (具) (リスト具 ,レシピ))))
	'((チキンライス) (きつねうどん)))


	; うんでもってリスプ
	(試験 '
	((λ (評価変数参照もしの評価組込関数呼出 λ呼出)
	(評価 '
	((λ (階乗)
	(階乗 5))
	(λ (n)
	(もし (＝ n 0)
	1
	(× n (階乗 (− n 1))))))
	`(
	(＝ ,＝)
	(− ,−)
	(× ,×)
	)))
	(λ (式環境) ; 評価
	(場合分け ((数？式) 式)
	((空？式) 式)
	((記号？式) (変数参照式環境))
	((組込関数？ (アレ式))
	(組込関数呼出 (アレ式) (ダレ式) 環境))
	((記号？ (アレ式))
	(振り分け (アレ式)
	((λ) 式)
	((もし)
	(もしの評価 (アダレ式) (ダダレ式) 環境))
	(その他
	(評価 (対成 (変数参照 (アレ式) 環境) (ダレ式)) 環境))))
	((等しい？ (アアレ式) 'λ)
	(λ呼出 (アダアレ式) (アダダアレ式) (ダレ式) 環境))))
	(λ (名前環境) ; 変数参照
	(置く ((項目 (連想名前環境)))
	(もし項目
	(アダレ項目)
	偽)))
	(λ (条件式リスト環境) ; もしの評価
	(もし (じゃない (空？ (評価条件環境)))
	(評価 (アレ式リスト) 環境)
	(もし (じゃない (空？ (ダレ式リスト)))
	(評価 (アダレ式リスト) 環境)
	偽)))
	(λ (関数引数リスト環境) ; 組込関数呼出
	(組込関数 (写像 (λ (式)
	(評価式環境))
	引数リスト)))
	(λ (仮引数式引数リスト環境) ; λ呼出
	(評価式 (追加 (括る仮引数
	(写像 (λ (式)
	(評価式環境))
	引数リスト))
	環境)))

	)
	120
	)

	#\|
	(use ggc.debug.trace)
	(trace 評価)
	(試験 '
	((λ (階乗)
	(階乗 5))
	(λ (n)
	(もし (＝ n 0)
	1
	(× n (階乗 (− n 1))))))
	120
	)
	\|#
	; おしまい