読者です 読者をやめる 読者になる 読者になる

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