;;; .EnTete "Le-Lisp (c) version 15.2" " " "The Le-Lisp Benchmarks (12)"
;;; .EnPied "deriv.ll" "%" " "
;;; .SuperTitre "The Le-Lisp Benchmarks (12)"
;;;
;;; .Centre "*****************************************************************"
;;; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA.  "
;;; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
;;; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA                 "
;;; .Centre "*****************************************************************"
;;;
;;; .Centre "$Header: deriv.ll,v 1.1 88/11/17 09:51:36 chaillou Exp $"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File:         deriv.cl
; Description:  The DERIV benchmark from the Gabriel tests.
; Author:       Vaughan Pratt
; Created:      8-Apr-85
; Modified:     10-Apr-85 14:53:50 (Bob Shaw)
; Language:     Common Lisp
; Package:      User
; Status:       Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; (12) DERIV -- Symbolic derivative benchmark written by Vaughn Pratt.  
;;; It uses a simple subset of Lisp and does a lot of  CONSing. 

(defun check-deriv ()
   (check-value '(test-deriv 1) 7))

(defun meter-deriv ()
   (perform-meter '(deriv-run) 'deriv))

(defun test-deriv (n)
   (if (eq n 1)
       (deriv-run)
       (repeat n (deriv-run))))

;;;

(defun deriv-aux (a) (list '/ (deriv a) a))

(defun deriv (a)
  (cond 
    ((atom a)
     (cond ((eq a 'x) 1) (t 0)))
    ((eq (car a) '+)	
     (cons '+ (mapcar #'deriv (cdr a))))
    ((eq (car a) '-) 
     (cons '- (mapcar #'deriv 
		      (cdr a))))
    ((eq (car a) '*)
     (list '* 
	   a 
	   (cons '+ (mapcar #'deriv-aux (cdr a)))))
    ((eq (car a) '/)
     (list '- 
	   (list '/ 
		 (deriv (cadr a)) 
		 (caddr a))
	   (list '/ 
		 (cadr a) 
		 (list '*
		       (caddr a)
		       (caddr a)
		       (deriv (caddr a))))))
    (t 'error)))

(defun deriv-run ()
   (repeat 5000
	   (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))))