public
Last active

  • Download Gist
lambda.lsp
Common Lisp
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
;; lambda.lsp - newLISPでラムダ計算をしてみるテスト
 
;; newLISPの以下の性質を利用することで、動的束縛を静的束縛のように振舞わせる
;; * 読取器が大文字小文字を区別すること
;; * ラムダ式がオープン(リストのサブタイプ)であり、変更が容易なこと
;; * 大文字から始まるシンボルを展開する関数(expand)が用意されている
 
;; 当然ながら、変数が重複するとシンボルの展開がおかしくなるのでエラー
;; 場合によってはラムダ式の仮引数が展開されて妙なことに (しかもエラーの通知がない)
 
;; 参考リンク
;; - Lambda calculus - http://en.wikipedia.org/wiki/Lambda_calculus
;; - ラムダ計算 - http://ja.wikipedia.org/wiki/%E3%83%A9%E3%83%A0%E3%83%80%E8%A8%88%E7%AE%97
;; - Y Function - http://www.newlisp.org/index.cgi?Y_Function
 
 
(define-macro (LAMBDA)
(append (lambda ) (expand (args))))
 
(define DEFINE define)
 
 
;;;##自然数と算術 (number)
 
(DEFINE ZERO (LAMBDA (F) (LAMBDA (X) X))) ; 0 := λfx.x
(DEFINE ONE (LAMBDA (F) (LAMBDA (X) (F X)))) ; 1 := λfx.fx
(DEFINE TWO (LAMBDA (F) (LAMBDA (X) (F (F X))))) ; 2 := λfx.f(fx)
(DEFINE THREE (LAMBDA (F) (LAMBDA (X) (F (F (F X)))))) ; 3 := λfx.f(f(fx))
 
(DEFINE (SUCC N) (LAMBDA (F) (LAMBDA (X) (F (N F X))))) ; SUCC := λnfx.f (n f x)
 
(DEFINE (PLUS M N) (LAMBDA (F) (LAMBDA (X) ((M F) ((N F) X))))) ; PLUS := λmnfx.m f (n f x)
(DEFINE (MULT M N) (LAMBDA (F) (LAMBDA (X) ((N (M F)) X)))) ; MULT := λmnf.m (n f)
(DEFINE (POW B E) (E B)) ; POW := λbe.e b
 
(define (to-number x) ((x (lambda (n) (+ n 1))) 0))
(define (to-lambda n) (if (< 0 n) (SUCC (to-lambda (- n 1))) (ZERO)))
 
(to-number ZERO) ;=> 0
(to-number ONE) ;=> 1
(to-number TWO) ;=> 2
(to-number (PLUS ONE TWO)) ;=> 3
 
 
;;;##論理記号と述語 (boolean)
 
(DEFINE TRUE (LAMBDA (X Y) X)) ; TRUE := λx y. x
(DEFINE FALSE (LAMBDA (X Y) Y)) ; FALSE := λx y. y
 
(DEFINE (AND P Q) (P Q FALSE)) ; AND := λp q. p q FALSE
(DEFINE (OR P Q) (P TRUE Q)) ; OR := λp q. p TRUE q
(DEFINE (NOT P) (P FALSE TRUE)) ; NOT := λp. p FALSE TRUE
(DEFINE (IF P X Y) (P X Y)) ; IFTHENELSE := λp x y. p x y
 
(DEFINE ZEROP (LAMBDA (N) (N (LAMBDA (X) FALSE) TRUE)))
 
(define bool (lambda (p) (p "TRUE" "FALSE")))
 
;(IF TRUE (LAMBDA () (+ 10 2)) (LAMBDA () (* 10 2)))
 
;(bool (AND TRUE FALSE)) ;=> "FALSE"
;(bool (OR TRUE FALSE)) ;=> "TRUE"
;(bool (OR FALSE FALSE)) ;=> "FALSE"
;(bool (NOT FALSE)) ;=> "TRUE"
;(bool (ZEROP (PLUS ZERO ZERO))) ;=> "TRUE"
 
;;;##対 (pair)
 
(DEFINE (CONS X Y) (LAMBDA (M) (M X Y))) ; CONS := λx y m. m x y
(DEFINE (CAR P) (P TRUE)) ; CAR := λp. p TRUE
(DEFINE (CDR P) (P FALSE)) ; CDR := λp. p FALSE
 
;(CDR (CONS (CONS 1 2) 3)) ;=> 3
 
 
;;;##再帰 (recursion)
 
;; *** あまり再帰が深いとスタックを食い潰すので使えない
 
(define IF if)
 
(DEFINE Y
(LAMBDA (F)
((LAMBDA (H) (LAMBDA (X) ((F (H H)) X)))
(LAMBDA (H) (LAMBDA (X) ((F (H H)) X))))))
 
(DEFINE FACT
(Y (LAMBDA (F)
(LAMBDA (N)
(IF (= N 0) 1 (* N (F (- N 1))))))))
 
;; (define F
;; (lambda (Q)
;; (LAMBDA (n)
;; (if (= n 1) 1 (* n ((Q Q) (- n 1)))))))
;((F F) 10) ;=> 3628800
 
;;; EOF

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.