;;;-*- Mode:LISP; Package:BENCH-FFDERIV; Base:8 -*-
;;; From the "Dick Gabriel" Benchmark Series.
;;; Enhancements (C) Copyright 1983, Lisp Machine, Inc.

;;; #+MACLISP added for SUBRCALLAGE -GJC 12/15/83 23:28:09
;;;BEGIN
;;;FDDERIV
#-LISPM (DECLARE (MAPEX T))

(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))

(DEFUN (PLUS DERIV #+MACLISP DERIV) (A)
       (CONS 'PLUS (MAPCAR 'DERIV A)))

(DEFUN (DIFFERENCE DERIV #+MACLISP DERIV) (A)
       (CONS 'DIFFERENCE (MAPCAR 'DERIV 
				 A)))

(DEFUN (TIMES DERIV #+MACLISP DERIV) (A)
	(LIST 'TIMES (CONS 'TIMES A)
		(CONS 'PLUS (MAPCAR 'DER1 A))))

(DEFUN (QUOTIENT DERIV #+MACLISP DERIV) (A)
       (LIST 'DIFFERENCE 
	     (LIST 'QUOTIENT 
		   (DERIV (CAR A)) 
		   (CADR A))
	     (LIST 'QUOTIENT 
		   (CAR A) 
		   (LIST 'TIMES
			 (CADR A)
			 (CADR A)
			 (DERIV (CADR A))))))

(DEFUN DERIV (A)
  (COND 
    ((ATOM A)
     (COND ((EQ A 'X) 1) (T 0)))
    (T (LET ((DERIV (GET (CAR A) 'DERIV)))
	 (COND (DERIV #+MACLISP (SUBRCALL T DERIV (CDR A))
		      #-MACLISP (FUNCALL DERIV (CDR A)))
	       (T 'ERROR))))))

(DEFUN RUN ()
 (DECLARE #-LISPM (FIXNUM I))
 (DO ((I 0 (1+ I)))
     ((= I 1000.))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))

;(include "timer.lsp")

(timer timit 
	(run))
;;;END