learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-73.scm (2768B)

      1 (define-library (sicp solutions chapter-2 exercise-73)
      2   (import (scheme base))
      3   (import (scheme cxr))
      4   (import (scheme write))
      5   (import (srfi :26))
      6   (import (srfi :111))
      7   (import (sicp utils))
      8   (import (only (sicp solutions chapter-2 exercise-56)
      9                 =number?
     10                 make-exponentiation
     11                 make-product
     12                 make-sum
     13                 same-variable?
     14                 ))
     15   (export deriv
     16           get
     17           put)
     18 
     19   (begin
     20     (define put-get-table '())
     21 
     22     (define (put operator data-type proc)
     23       (define new-key (cons operator data-type))
     24       (define new-key-value-pair (cons new-key proc))
     25       (set! put-get-table
     26             (cons new-key-value-pair
     27                   (filter
     28                    (lambda (key-value-pair)
     29                      (not
     30                       (equal?
     31                        (car key-value-pair)
     32                        new-key)))
     33                    put-get-table))))
     34 
     35     (define (get op data-type)
     36       (define search-result
     37         (filter (lambda (key-value-pair)
     38                   (equal?
     39                    (cons op data-type)
     40                    (car key-value-pair)))
     41                 put-get-table))
     42       (if (null? search-result)
     43           (error "Unknown expression type: " op data-type)
     44           (cdar search-result)))
     45 
     46     (define (operator exp)
     47       (car exp))
     48 
     49     (define (operands exp)
     50       (cdr exp))
     51 
     52     (define (variable? exp)
     53       (symbol? exp))
     54 
     55     (define (deriv exp var)
     56       (cond
     57        ((number? exp) 0)
     58        ((variable? exp)
     59         (if (same-variable? exp var)
     60             1
     61             0))
     62        (else
     63         ((get 'deriv (operator exp))
     64          (operands exp)
     65          var))))
     66 
     67     (define (addend exp)
     68       (car exp))
     69 
     70     (define (augend exp)
     71       (cadr exp))
     72 
     73     (put 'deriv
     74          '+
     75          (lambda (exp var)
     76            (display (list 'deriv '+ exp var))
     77            (newline)
     78            (make-sum
     79             (deriv (addend exp) var)
     80             (deriv (augend exp) var))))
     81 
     82     (define (multiplier p)
     83       (car p))
     84 
     85     (define (multiplicand p)
     86       (cadr p))
     87 
     88     (put 'deriv
     89          '*
     90          (lambda (exp var)
     91            (make-sum
     92             (make-product (multiplier exp)
     93                           (deriv (multiplicand exp) var))
     94             (make-product (deriv (multiplier exp) var)
     95                           (multiplicand exp)))))
     96 
     97     (define (base e)
     98       (car e))
     99 
    100     (define (exponent e)
    101       (cadr e))
    102 
    103     (put 'deriv
    104          '**
    105          (lambda (exp var)
    106            (display (list 'deriv '** exp var))
    107            (newline)
    108            (make-product (exponent exp)
    109                          (make-exponentiation (base exp)
    110                                               (make-sum (exponent exp) -1)))))))