大体3000行程度のC++になった。 もっとも単純な機能のschemeとなっている。macroやcall/ccはない。GCはboehmGCを使用した。 C++で作るにあたって、一番違ったのはreaderとobjectだった。 そこらへんを見ると参考になるかも。 githubにおいた micro-scheme gi…

(define (make-unbound-variable! var env) (define (env-loop env) (define (scan prev-vars vars prev-vals vals) (cond ((null? vars) (env-loop (enclosing-envrionment env))) ((eq? var (car vars)) (set-cdr! prev-vars (cdr vars)) (set-cdr! prev-v…

(define (env-loop null-proc find-proc name var env) (define (scan vars vals) (cond ((null? vars) (null-proc env)) ((eq? var (car vars)) (find-proc vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unb…

(define (make-frame variables values) (if (= (length variables) (length values)) (reverse (let make-frame-iter ((vars variables) (vals values)) (cons (cons (car vars) (cdr vals)) (make-frame-iter (cdr vars) (cdr vals))))) (error "variables…

;; しょうもない変更だが、let式を変更する。 (let ((a b) (c d) (e f))) ;; -> (let (a b c d e f)) ;; とかけるようにしよう。 (define (let->combination exp) (let ((second (cadr exp))) (let ((named? (symbol? second))) (let ((bindings (if named? …

;; doを作ってみる (do binds (predicate value) body) ;; である。 ;; binds部は ((var-name initialize-value update-expression) ... ) ;; である。 (do ((var-name1 initialize-value1 update-expression1) (var-name2 initialize-value2 update-express…

(define (fib n) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) ;; -> (define (fib n) (let ((a 1) (b 0) (count n)) (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))…

(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z)) ;=> (let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z)))) (define (let*->nested-lets exp) (let ((bindings (cadr exp))) (let binds->lets ((binds bindings)) (if (null? (cdr binds)) (…

(define (let->combination exp) (let ((bindings (cadr exp))) (let ((vars (map car bindings)) (exps (map cadr bindings))) (append (list (append (list 'lambda vars) (cddr exp))) exps)))) (define (eval-let exp env) (eval (let->combitation exp)…

(define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (cond-clauses exp) (cdr exp)) (define (cond-predicate clause) (car clause))…

(define (eval-and-sequence exps env) (if (null? exps) 'true (if (true? (eval (first-exp exps) env)) (eval-and-sequence (rest-exps exps) env) 'false))) (define (eval-and exp env) (eval-and-sequence (cdr exp) env)) (put 'eval 'and eval-and) …

(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) (else (let ((proc (get 'eval (car exp)))) (if proc (proc exp env) (if (application? exp) (apply (eval (operator exp) env) (list-of…

(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((call? exp) (apply (eval (operator exp) env…

;; 4.1 ;L->R (define (list-of-values exps env) (if (no-operands? exps) '() (let ((val (eval (first-operand exps) env))) (cons val (list-of-values (rest-operands exps) env))))) ;R->L (define (list-of-values exps env) (if (no-operands? exps)…

並列性の問題は一時とばす。 後で必ず戻る。 4章までワープ

(define (subtracter a b c) (adder c b a)) (define (divider a b c) (multiplier c b a)) (define (c+ x y) (let ((z (make-connector))) (adder x y z) z)) (define (c- x y) (let ((z (make-connector))) (subtracter x y z) z)) (define (c* x y) (let …

図は面倒 心の中に思い描いた。

(define (squarer a b) (define (process-new-value) (if (has-value? b) (if (< (get-value b) 0) (error "square less than 0 -- SQUARER" (get-value b)) (set-value! a (sqrt (get-value b)) me)) (if (has-value? a) (set-value! b (* (get-value a) (g…

(define (squarer a b) (multiplier a a b)) (define a (make-connector)) (define b (make-connector)) (squarer a b) (probe "A" a) (probe "B" b) (set-value! a -3 'user) ;Probe: B = 9 (forget-value! a 'user) (set-value! b 9 'user) ;Probe: B = 9 …

(define (averager a b c) (let ((d (make-connector)) (e (make-connector))) (adder a b d) (multiplier d e c) (constant 0.5 e) 'ok)) (define a (make-connector)) (define b (make-connector)) (define c (make-connector)) (averager a b c) (probe "…

(define the-agenda (make-agenda)) (define a1 (make-wire)) (define a2 (make-wire)) (define output (make-wire)) (probe 'a1 a1) (probe 'a2 a2) (probe 'output output) (and-gate a1 a2 output) (set-signal! a1 0) (set-signal! a2 1) (propagate) (s…

;wireの実装上、信号が切り替わったときにしか登録したactionは実行されないため、 ;もし、ある回路シミュレーターの入力値が変化しなかった場合、出力側が正しくない値だったとしても、actionが実行されず修正されないことが起こりうる。 ;よって初めに、回…

(define (ripple-carry-adder ak bk sk c) (let ((ck (map (lambda (x) (make-wire)) sk))) (let iter (ak bk sk ck) (if (null? (cdr ck)) (full-adder (car ak) (car bk) (car ck) (car sk) c) (begin (full-adder (car ak) (car bk) (car ck) (car sk) (c…

;;意外と思いつかなかった。20分も悩んだ。 (define (or-gate a1 a2 output) (let ((a3 (make-wire)) (a4 (make-wire)) (o1 (make-wire))) (inverter a1 a3) (inverter a2 a4) (and-gate a3 a4 o1) (inverter o1 output) 'ok)) ;;遅延時間は (+ (* inverter-…

(define a (make-wire)) (define b (make-wire)) (define c (make-wire)) (define d (make-wire)) (define e (make-wire)) (define s (make-wire)) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) (define (half-adder a b s c) (let ((…

(define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) ;(time (fib 35)) ; real 3.050 ; user 3.010 ; sys 0.040 9227465 (define (memorize f) (let ((table (make-table))) (let ((get (table 'lookup-proc)) (put (t…

(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を扱うことでメモリ操作が出来るらしい。 (…