Skip to content

Instantly share code, notes, and snippets.

@shkmr shkmr/lisupu.scm Secret
Created Dec 3, 2015

Embed
What would you like to do?
リスプ
; $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
)
|#
; おしまい
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.