Paste: struct array benchmark - lisp version


(declaim (inline %make-point point-norm))

(defstruct (point (:constructor %make-point))
  (x 0 :type single-float)
  (y 0 :type single-float)
  (z 0 :type single-float))

(defun make-point (n)
  (declare (optimize (speed 3))
	   (type integer n))
  (let* ((s (sin n))
	 (c (cos n)))
    (%make-point :x s
		 :y (* c 3)
		 :z (/ (* s s) 2))))

(defun make-points (len)
  (let ((array (make-array len)))
    (dotimes (i len)
      (setf (aref array i)
      	    (make-point i)))
    array))


(defun normalize-point (point)
  (declare (optimize (speed 3)))
  (let* ((x (point-x point))
	 (y (point-y point))
	 (z (point-z point))
	 (norm (sqrt (+ (* x x)
			(* y y)
			(* z z)))))
    (setf (point-x point) (/ x norm)
	  (point-y point) (/ y norm)
	  (point-z point) (/ z norm))
    point))

(defun normalize-points (sequence)
  (map-into sequence 'normalize-point sequence))

(defun max-point (point other-point)
  (declare (optimize (speed 3)))
  (macrolet ((mxmize (&rest rest)
	       `(setf ,@(loop for slot in rest
			   nconc `((,slot point)
				   (max (,slot point)
				    (,slot other-point)))))))
    (mxmize point-x point-y point-z)
    point))

(defun max-points (sequence)
  (reduce 'max-point sequence))

(defun benchmark (size)
  (let ((points (make-points size)))
    (normalize-points points)
    (print (max-points points))))

(time
 (benchmark 5000000))