home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8707 / 49 / deriv.cl < prev    next >
Encoding:
Text File  |  1990-07-13  |  1.3 KB  |  52 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; File:         deriv.cl
  3. ; Description:  The DERIV benchmark from the Gabriel tests.
  4. ; Author:       Vaughan Pratt
  5. ; Created:      8-Apr-85
  6. ; Modified:     10-Apr-85 14:53:50 (Bob Shaw)
  7. ; Language:     Common Lisp
  8. ; Package:      User
  9. ; Status:       Public Domain
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;;; DERIV -- Symbolic derivative benchmark written by Vaughn Pratt.  
  13. ;;; It uses a simple subset of Lisp and does a lot of  CONSing. 
  14.  
  15. (defun deriv-aux (a) (list '/ (deriv a) a))
  16.  
  17. (defun deriv (a)
  18.   (cond 
  19.     ((atom a)
  20.      (cond ((eq a 'x) 1) (t 0)))
  21.     ((eq (car a) '+)    
  22.      (cons '+ (mapcar #'deriv (cdr a))))
  23.     ((eq (car a) '-) 
  24.      (cons '- (mapcar #'deriv 
  25.               (cdr a))))
  26.     ((eq (car a) '*)
  27.      (list '* 
  28.        a 
  29.        (cons '+ (mapcar #'deriv-aux (cdr a)))))
  30.     ((eq (car a) '/)
  31.      (list '- 
  32.        (list '/ 
  33.          (deriv (cadr a)) 
  34.          (caddr a))
  35.        (list '/ 
  36.          (cadr a) 
  37.          (list '*
  38.                (caddr a)
  39.                (deriv (caddr a))))))
  40.     (t 'error)))
  41.  
  42. (defun run ()
  43.   (do ((i 0 (1+ i)))
  44.       ((= i 1000))
  45.     (declare (fixnum i))
  46.     (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
  47.     (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))))
  48.  
  49. ;;; call:  (run)
  50.  
  51. (run-benchmark "Deriv" '(run))
  52.