2.57.tex

\documentclass[a4paper,12pt]{article}
\usepackage{listings}
\lstset{language=Lisp}

\begin{document}
\begin{lstlisting}
(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp))))
        ((exponentiation? exp)
         (make-product
          (exponent exp)
          (make-product (make-exponentiation
                         (base exp)
                         (make-sub (exponent exp) 1))
                        (deriv (base exp) var))))
        (else
         (error "unknown expression type -- DERIV"
                exp))))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (simplify proc acc vars args)
  (cond ((null? args)
         (cons acc vars))
        ((number? (car args))
         (simplify proc
                   (proc (car args) acc)
                   vars
                   (cdr args)))
        (else
         (simplify proc
                   acc
                   (cons (car args) vars)
                   (cdr args)))))

(define (make-sum a1 a2 . rest)
  (let ((lst (simplify + 0 '()
                       (cons a1 (cons a2 rest)))))
    (cond ((null? (cdr lst)) (car lst))
          ((zero? (car lst))
           (if (null? (cddr lst))
               (cadr lst)
               (cons '+ (cdr lst))))
          (else (cons '+ lst)))))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))

(define (addend s) (cadr s))
(define (augend s)
  (let ((lst (cddr s)))
    (if (null? (cdr lst))
        (car lst)
        (cons '+ lst))))

(define (make-product m1 m2 . rest)
  (let ((lst (simplify * 1 '()
                       (cons m1 (cons m2 rest)))))
    (cond ((null? (cdr lst)) (car lst))
          ((= (car lst) 0) 0)
          ((= (car lst) 1)
           (if (null? (cddr lst))
               (cadr lst)
               (cons '* (cdr lst))))
          (else (cons '* lst)))))

(define (product? x)
  (and (pair? x) (eq? (car x) '*)))

(define (multiplier p) (cadr p))
(define (multiplicand p)
  (let ((lst (cddr p)))
    (if (null? (cdr lst))
        (car lst)
        (cons '* lst))))

(define (make-sub a1 a2)
  (make-sum a1 (make-product -1 a2)))

(define (make-exponentiation base exponent)
  (cond ((=number? exponent 0) 1)
        ((=number? exponent 1) base)
        (else (list '** base exponent))))

(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))

(define (base e) (car (cdr e)))
(define (exponent e) (car (cdr (cdr e))))
\end{lstlisting}
\end{document}