;;-*-mode:lisp;package:bench-marleen-*-
;; (C) Copyright 1983, Lisp Machine, Inc.


;; These were forwarded by Mr. Didier Loye, Graphael S.A. in FRANCE,
;; the LMI french connection, from Marleen Stint of
;; FACULTIET DER WISKUNDE EN NATUURWETENSCHAPPEN
;; KATHOLIEKE UNIVERSITEIT, NIJMEGEN NEDERLAND.


;; BEMERUNKGEN:
;;
;; DIE ANGENBENEN LAUFZIETEN FUER DIE REVERSE-FUNKTIONEN GELTEN FUER
;; EIEN LISTE VON 52 REALZAHLEH.
;;
;; GRYDLAGE DES TEST IST:
;;
;;    B. HEBEL: IST LISP EINE LANGSAME SPRACHE?
;;              MEMO ANS-13, FORSCHUNGSTELLE FUER INFORMATIONS-
;;              WISSENSCHAFT UND KUENSTLICHE INTELLIGENZ, UNI HAMBURG

(EVAL-WHEN (EVAL COMPILE LOAD)
  (DEFCONST *MICRO-HACK*
	    #+LMI '(REVERSEA REVERSEB REVERSE2 REVERSEC ACKER ACKERT MY-APPEND)
	    #-LMI NIL))

(EVAL-WHEN (LOAD COMPILE)
  (IF *MICRO-HACK*
      (MAPC #'(LAMBDA (X)
		(PUTPROP X T 'COMPILER:MICROCOMPILE)
		(PUTPROP X ':DYNAMIC ':DEPEND-ON-BEING-MICROCOMPILED))
	    *MICRO-HACK*)))

(DEFUN REVERSEA (X)
  (PROG (Y)
	A (COND ((NULL X) (RETURN Y)))
	(SETQ Y (CONS (CAR X) Y))
	(SETQ X (CDR X))
	(GO A)))

(DEFUN REVERSEB (X)
  (REVERSE2 X NIL))

(DEFUN REVERSE2 (X Y)
  (COND ((NULL X) Y)
	(T (REVERSE2 (CDR X) (CONS (CAR X) Y)))))

(DEFUN REVERSEC (X)
  (COND ((NULL X) NIL)
	(T (#+LMI MY-APPEND #-LMI APPEND
	     (REVERSEC (CDR X))
	     (CONS (CAR X) NIL)))))

(DEFUN ACKER (X Y)
  (COND ((EQ X 0) (ADD1 Y))
	((EQ Y 0) (ACKER (SUB1 X) 1))
	(T (ACKER (SUB1 X) (ACKER X (SUB1 Y))))))

(DEFUN ACKERT (X Y)
  ;; self-tail-recursion optimization done by hand, could easily be
  ;; done by the compiler because it knows to generate CALL D-RETURN #'ACKER
  ;; anyway.
  (PROG ()
     TAIL
     (COND ((EQ X 0) (RETURN (ADD1 Y)))
	   ((EQ Y 0)
	    (SETQ X (SUB1 X)
		  Y 1)
	    (GO TAIL))
	   (T
	    (SETQ Y (ACKERT X (SUB1 Y))
		  X (SUB1 X))
	    (GO TAIL)))))

#+LMI
(DEFUN MY-APPEND (X Y)
  ;; with microcoded REVERSEC we should use microcoded MY-APPEND
  ;; otherwise we are just testing the speed of append.
  (DO ((L X (CDR L)))
      ((NULL L) Y)
    (PUSH (CAR L) Y)))

(IF *MICRO-HACK*
    (APPLY (PROGN 'COMPILER:MA-LOAD) *MICRO-HACK*))


;; GJC:
;; Since these "reverse" functions do not rplacad and do not look at the list
;; elements we simply use the result of (MAKE-LIST 52.) as input data.

(declare (special our-list))

(setq our-list (make-list 52.))

(timer rev0
       (do ((j 0 (1+ j)))
	   ((= j 100.))))
	 

(timer reva
       (do ((j 0 (1+ j)))
	   ((= j 100.))
	 (reversea our-list)))

(timer revb
       (do ((j 0 (1+ j)))
	   ((= j 100.))
	 (reverseb our-list)))

(timer revc
       (do ((j 0 (1+ j)))
	   ((= j 100.))
	 (reversec our-list)))

(timer acker-3-3
       (do ((j 0 (1+ j)))
	   ((= j 10.))
	 (acker 3 3)))

(timer acker-3-4
       (do ((j 0 (1+ j)))
	   ((= j 100.))
	 (acker 3 4)))

(timer ackert-3-3
       (do ((j 0 (1+ j)))
	   ((= j 10.))
	 (ackert 3 3)))

(timer ackert-3-4
       (do ((j 0 (1+ j)))
	   ((= j 100.))
	 (ackert 3 4)))