(define (make-accumulator n) (let ((sum n)) (lambda (num) (set! sum (+ sum num)) sum))) gosh> (define A (make-accumulator 5)) A gosh> (A 10) 15 gosh> (A 10) 25

(define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let ((new-c (div (coeff t1) …

;; 2.89 ;; 濃い多項式に適している実装 (define (make-polynomial valiable term-list) (cons valiable term-list)) (define (valiable p) (car p)) (define (term-list p) (cdr p)) (define (valiable? v) (symbol? v)) (define (same-valiable? v1 v2) (a…

;; polynominal-package (define (=zero? p) (= 0 (coeff p))) (put '=zero? '(polynominal) (lambda (p) (=zero? p))) ;; 2.88 (define (negative x) (apply-generic 'negative x)) ;; scheme-number (define (negative-integer x) (- x)) (put 'negative '…

;; polynominal-package (define (=zero? p) (= 0 (coeff p))) (put '=zero? '(polynominal) (lambda (p) (=zero? p)))

(define (square x) (apply-generic 'square x)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (atangent x) (apply-generic 'atangent x))…

(define (install-project-packege) (define (project x) (apply-generic 'project x)) (put 'project 'complex (lambda (x) (make-real (real-part x)))) (put 'project 'real (lambda (x) (let ((rational (inexact->exact x))) (make-rational (numerator…

(define (apply-generic op . args) (let ((type-tags (map type-tag args)) (tower '(complex real rational scheme-number))) ;; 同じタイプか調べる述語 (define (same-type? a b) (eq? (type-tag a) (type-tag b))) ;; aよりもbのほうが階層が高いか調べ…

(define (raise x) (apply-generic 'raise x)) ;; scheme-numberパッケージで (define (scheme-number->rational n) (make-rational n 1)) (put 'raise 'scheme-number scheme-number->rational) ;; rationalパッケージで (define (rational->real x) (/ (* …

(define (apply-generic op . args) (let ((type-tags (map type-tag args))) (define (try-coercion args tags) (if (null? tags) (error "Nomethod for these types" (list op type-tags)) (let ((new-args (map (lambda (x) (get-coercion (car tags) (ty…