(define (make-table) (let ((local-table (cons '*table* '()))) (define (make-tree entry left right) (list entry left right)) (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) (define (right-branch tree) (caddr tree)) …

(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc2 key records test) (cond ((null? records) #f) ((test key (caar records)) (car records)) (else (assoc2 key (cdr records) test)))) (define (lookup-iter keys t…

(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc2 key records test) (cond ((null? records) #f) ((test key (caar records)) (car records)) (else (assoc2 key (cdr records) test)))) (define (lookup key-1 key-2…

(cons back-pointer (cons item next-pointer)) ;この形を一つのqueueオブジェクトとする。 ;項目が3個なのでclosureでやる手もあるが、メモリコピーが多発し消費が激しいためlistのポインタを使う。 ;schemeはconsを扱うことでメモリ操作が出来るらしい。 (…

(define (make-queue) (let ((front-ptr '()) (rear-ptr '())) (define (empty?) (null? front-ptr)) (define (set-front-ptr! item) (set! front-ptr item)) (define (set-rear-ptr! item) (set! rear-ptr item)) (define (insert! item) (let ((new-pair (…

(define (front-ptr q) (car q)) (define (rear-ptr q) (cdr q)) (define (set-front-ptr! q i) (set-car! q i)) (define (set-rear-ptr! q i) (set-cdr! q i)) (define (empty-queue? q) (null? (front-ptr q))) (define (make-queue) (cons '() '())) (def…

図は面倒

; listがループしていなければ、絶対に交わることの無い二つのイテレータによって解決する。 ; イテーレータxが2進む間にイテレータyは1進む。 (define (include-loop-2? x) (define (iter x y toggle) (if (not (pair? x)) #f (if (eq? x y) #t (iter (cdr …

(define (include-loop? x) (define first-point x) (define (iter x) (if (null? x) #f (or (eq? first-point x) (iter (cdr x))))) (iter (cdr x))) ;;出来たと思ったが、これだと途中から途中へ循環している場合に対応できない。 (define a '(1 2 3)) (se…

(define (count-pairs-2 x) (define counted-pairs '()) (define (add-pair! p) (set! counted-pairs (cons p counted-pairs))) (define (already-counted? p) (memq p counted-pairs)) (define (iter x) (if (or (not (pair? x)) (already-counted? x)) 0 (…

(define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1))) ;;3 (define a (cons 1 (cons 2 (cons 3 '())))) (count-pairs a) ;-> 3 ;;4 (define a (cons '() '())) (define b (cons '() '())) (define c (cons '…

図はめんどう。 z1はリスト構造が一つしかなく、それにcar部とcdr部が両方接続しているため、set-car!によってポインタを変更すると両方とも変わる。 z2はリスト構造が二つあるため、car部が接続しているリストのcarポインタが変更されるだけである。

(define (mystery x) (define (loop x y) (if (null? x) y (let ((temp (cdr x))) (set-cdr! x y) (loop temp x)))) (loop x '())) ;;リストを破壊的に逆転させる？ (mystery '(1 2 3 4 5)) (5 4 3 2 1) ;; ok (define v '(a b c d)) (define w (mystery v))…

最後のcdrに格納されるポインタが、トップをさすような構造。 (last-pair z)は無限ループを引き起こす。

;; 1: (a b) ;; 2: (a b c d)

局所手続きの部分もbalanceと同じように、別々に保持される。 基本的に共有されない。

図はめんどいので飛ばす。 内部環境の箱が縦に並ぶような形になる。

図はめんどいので飛ばす。 再帰版はすべて横並び 反復版はfact-iterが横並び。

(define f (let ((m 0) (n 0)) (lambda (x) (set! m n) (set! n x) m)))

(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define …

;ここでは、精度は必要ないので線形合同法をストレートに使う。 (define random-init 8) (define (rand-update x) (remainder (+ (* 3 x) 5) 13)) (define rand (let ((x random-init)) (lambda (op) (cond ((eq? op 'generate) (begin (set! x (rand-update…

(define (monte-carlo trials experiment) (define (iter trials-remaining trials-passed) (cond ((= trials-remaining 0) (/ trials-passed trials)) ((experiment) (iter (- trials-remaining 1) (+ trials-passed 1))) (else (iter (- trials-remaining …

(define (call-the-cops) (print "通報しますた！")) (define (make-account balance password) (let ((pwmiss 0)) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define …

(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define …

(define (make-monitored func) (let ((acc 0)) (lambda args (if (eq? (car args) 'how-many-calls?) acc (begin (set! acc (+ acc 1)) (apply func args))))))

(define (make-accumulator base) (let ((acc base)) (lambda (addr) (begin (set! acc (+ addr acc)) acc))))

2章最後までskip

(define (type-tag datum) (cond ((pair? datum) (car datum)) ((number? datum) 'scheme-number) (else (error "Bat tagged datum -- TYPE-TAG" datum)))) (define (contents datum) (cond ((pair? datum) (cdr datum)) ((number? datum) datum) (else (err…

(magnitude z) ここで z -> '(complex rectangular 3 4) apply-genericでcomplex型のmagnitude関数が呼び出される。 その関数はグローバルのmagnitude関数である。 よってグローバルのmagnitude関数にcomplex型の型情報を剥ぎ取った中身がもう一度渡される。…

汎用演算 新しい型を追加するとき すべての汎用選択子の定義を変更する必要あり 名前などがかぶらないように注意しないといけない。 新しい演算を追加するとき ふつうに新しく書くだけ。 データ主導 新しい型を追加するとき 内部手続きとして名前を気にせず…