SICPを読む上でよく見るメモ
ゼミのたびに「あの単語の意味ってなんだったっけ？」って事案が多発するので定義をまとめた記事を作ります。
適用順序評価と正規順序評価
- 正規順序評価(normal-order evaluation)
完全に展開してから簡約する。
- 適用順序評価(applicative-order evaluation)
引数を評価してから展開する。
displayとnewline
condの中でdisplayを複数使いたいときは次のようにする
(cond (condition?) (display hoge) (newline) )
次のようにすると怒られる
(cond (condition?) ((display hoge) (newline)) )
二つ目だとundefにundefを適用して死ぬ。一つ目は多分最後の値（ここだと(newline)によるundef）だけが返ってくるからセーフっぽい。
(define define 0)
(define define 0)
defineできなくなって詰む。
（文責：どりきゃす）
undefについて
( (hoge x) (huga y))
とかやって(hoge x)が(undefined)を返すと、(undefined (huga y))を実行しようとしてエラーが出て死ぬので
(define (undefToNil x)
nil)
とかを用意してやって
( (undefToNil (hoge x)) (huga y))とかしておくと(nil (huga y))とかになって美味しいみたいな話
putとget
tree-mapを使った実装
(define (key-compare a b) 0) (define tm (make-tree-map key-compare)) (define (put op type item) (tree-map-put! tm (cons op type) item)) (define (get op type) (if (tree-map-exists? tm (cons op type)) (tree-map-get tm (cons op type)) #f))
ついでにattach-tag
(define (attach-tag type-tag contents) (cons type-tag contents )) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum: TYPE-TAG" datum ))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum: CONTENTS" datum )))
by pine
回路シミュレータで必要な関数定義
(define (half-adder a b s c) (let ((d (make-wire )) (e (make-wire ))) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) 'ok)) (define (full-adder a b c-in sum c-out) (let ((s (make-wire )) (c1 (make-wire )) (c2 (make-wire ))) (half-adder b c-in s c1) (half-adder a s sum c2) (or-gate c1 c2 c-out) 'ok)) (define (inverter input output) (define (invert-input) (let (( new-value (logical-not (get-signal input )))) (after-delay inverter-delay (lambda () (set-signal! output new-value ))))) (add-action! input invert-input) 'ok) (define (logical-not s) (cond ((= s 0) 1) ((= s 1) 0) (else (error "Invalid signal" s)))) (define (and-gate a1 a2 output) (define (and-action-procedure) (let (( new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value ))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) (define (logical-and s1 s2) (if (and (= s1 1) (= s2 1)) 1 0)) (define (or-gate a1 a2 output) (define (or-action-procedure) (let ((new-value (logical-or (get-signal a1) (get-signal a2)))) (after-delay or-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 or-action-procedure) (add-action! a2 or-action-procedure) 'ok) (define (logical-or s1 s2) (if (or (= s1 1) (= s2 1)) 1 0)) (define (make-wire) (let (( signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value )) (begin (set! signal-value new-value) (call-each action-procedures )) 'done )) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures )) (proc )) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation: WIRE" m)))) dispatch )) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures )) (call-each (cdr procedures ))))) (define (get-signal wire) (wire 'get-signal )) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value )) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure )) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda )) action the-agenda )) (define (propagate) (if (empty-agenda? the-agenda) 'done (let (( first-item (first-agenda-item the-agenda ))) (first-item) (remove-first-agenda-item! the-agenda) (propagate )))) (define (probe name wire) (add-action! wire (lambda () (newline) (display name) (display " ") (display (current-time the-agenda )) (display " New-value = ") (display (get-signal wire ))))) (define (make-agenda) (list 0)) (define the-agenda (make-agenda )) (define inverter-delay 2) (define and-gate-delay 3) (define or-gate-delay 5) (define (make-time-segment time queue) (cons time queue )) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) (define (current-time agenda) (car agenda )) (define (set-current-time! agenda time) (set-car! agenda time )) (define (segments agenda) (cdr agenda )) (define (set-segments! agenda segments) (set-cdr! agenda segments )) (define (first-segment agenda) (car (segments agenda ))) (define (rest-segments agenda) (cdr (segments agenda ))) (define (empty-agenda? agenda) (null? (segments agenda ))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments ))))) (define (make-new-time-segment time action) (let ((q (make-queue ))) (insert-queue! q action) (make-time-segment time q))) (define (add-to-segments! segments) (if (= (segment-time (car segments )) time) (insert-queue! (segment-queue (car segments )) action) (let ((rest (cdr segments ))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) (cdr segments ))) (add-to-segments! rest ))))) (let (( segments (segments agenda ))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments )) (add-to-segments! segments )))) (define (remove-first-agenda-item! agenda) (let ((q (segment-queue (first-segment agenda )))) (delete-queue! q) (if (empty-queue? q) (set-segments! agenda (rest-segments agenda ))))) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty: FIRST-AGENDA-ITEM") (let (( first-seg (first-segment agenda ))) (set-current-time! agenda (segment-time first-seg )) (front-queue (segment-queue first-seg ))))) (define (make-queue) (cons '() '())) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue )))) (define (insert-queue! queue item) (let (( new-pair (cons item '()))) (cond (( empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair) queue) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair) queue )))) (define (delete-queue! queue) (cond (( empty-queue? queue) (error "DELETE! called with an empty queue" queue )) (else (set-front-ptr! queue (cdr (front-ptr queue ))) queue ))) (define (empty-queue? queue) (null? (front-ptr queue ))) (define (front-ptr queue) (car queue )) (define (rear-ptr queue) (cdr queue )) (define (set-front-ptr! queue item) (set-car! queue item )) (define (set-rear-ptr! queue item) (set-cdr! queue item ))
並列化
参考:
concurrency - implement parallel execute in scheme - Stack Overflow
(define (parallel-execute . procs) (map thread-wait (map (lambda (proc) (thread proc)) procs)))
by tube
Scheme on Scheme
コードは https://github.com/ht918/sicp-zemi
chap4/environments.scm は環境まわりの関数。
chap4/eval.scm を使えば eval が動くはず。
