開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- Scheme (プログラミング言語)
- kscheme (ksi)(github) (処理系)
計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第2章(データによる抽象の構築)、2.5(汎用演算システム)、2.5.1(汎用算術演算)、問題2.77、78、79、80.を取り組んでみる。
その他参考書籍
問題2.77、78、79、80.
コード(Emacs)
((lambda ()
(load "procedures.scm")
(newline)
(define (p obj) (display obj) (newline))
(p '2.77)
(p "apply-genericは2回呼び出される。")
(p 2.78)
(define (attach-tag type-tag contents)
(if (number? contents)
contents
(cons type-tag contents)))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(if (number? datum)
'scheme-number
(error "bad tagged datum -- type-tag" datum))))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(if (number? datum)
datum
(error "bad tagged datum -- contents" datum))))
(define (make-table)
((lambda (local-table)
(define (lookup key-1 key-2)
((lambda (subtable)
(if subtable
((lambda (record)
(if record
(cdr record)
#f))
(assoc key-2 (cdr subtable)))
#f))
(assoc key-1 (cdr local-table))))
(define (insert! key-1 key-2 value)
((lambda (subtable)
(if subtable
((lambda (record)
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(assoc key-2 (cdr subtable)))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table))))
'ok)
(assoc key-1 (cdr local-table))))
(define (dispatch m)
(if (eq? m 'lookup-proc)
lookup
(if (eq? m 'insert-proc!)
insert!
(error "unknown operation -- table" m))))
dispatch)
(list '*table*)))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
(define (apply-generic op . args)
((lambda (type-tags)
((lambda (proc)
(if proc
(apply proc (map contents args))
(error "no method for these types -- apply-generic"
(list op type-tags))))
(get op type-tags)))
(map type-tag args)))
(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))
(define (install-scheme-number-package)
(define (tag x)
(attach-tag 'scheme-number x))
(put 'add '(scheme-number scheme-number)
(lambda (x y) (tag (+ x y))))
(put 'sub '(scheme-number scheme-number)
(lambda (x y) (tag (- x y))))
(put 'mul '(scheme-number scheme-number)
(lambda (x y) (tag (* x y))))
(put 'div '(scheme-number scheme-number)
(lambda (x y) (tag (/ x y))))
(put 'equ? '(scheme-number scheme-number)
(lambda (x y) (= x y)))
(put '=zero? '(scheme-number)
(lambda (x) (= x 0)))
(put 'make 'scheme-number
(lambda (x) (tag x)))
'scheme-number-package)
(define (install-rational-package)
(define (numer x) (car x))
(define (denom x) (cdr x))
;; kscheme の gcd の実装がおかしいっぽいからとりあえず既約分数にはしない状態で
;; gcd が修正し終わったら、分母n、分子dを最大公約数(gcd n d) で割る。
(define (make-rat n d)
(cons n d))
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (rat-equ? x y)
(and (= (numer x) (numer y))
(= (denom x) (denom y))))
(define (tag x) (attach-tag 'rational x))
(put 'add '(rational rational)
(lambda (x y) (tag (add-rat x y))))
(put 'sub '(rational rational)
(lambda (x y) (tag (sub-rat x y))))
(put 'mul '(rational rational)
(lambda (x y) (tag (mul-rat x y))))
(put 'div '(rational rational)
(lambda (x y) (tag (div-rat x y))))
(put 'equ? '(rational rational)
(lambda (x y) (rat-equ? x y)))
(put '=zero? '(rational)
(lambda (x) (= (numer x) 0)))
(put 'make 'rational
(lambda (n d) (tag (make-rat n d))))
'rational-package)
(define (make-rational n d)
((get 'make 'rational) n d))
(install-scheme-number-package)
(install-rational-package)
(p (add 1 2))
(p (add (make-rational 1 2) (make-rational 3 4)))
(p 2.79)
(p (equ? 1 1))
(p (equ? 1 2))
(p (equ? (make-rational 1 2) (make-rational 1 2)))
(p (equ? (make-rational 1 2) (make-rational 3 4)))
(p 2.30)
(p (=zero? 0))
(p (=zero? 1))
(p (=zero? (make-rational 0 2)))
(p (=zero? (make-rational 1 2)))
'done))
入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))
$ ksi < sample77.scm ksi> 2.77 apply-genericは2回呼び出される。 2.78 3 (rational 10 . 8) 2.79 #t #f #t #f 2.3 #t #f #t #f => done ksi> $
0 コメント:
コメントを投稿