A demo of the Loopus loop optimization framework, as presented at https://european-lisp-symposium.org/2022

2022-03-22-els-loopus-demo.lisp

(in-package #:cl-user)

(defun jacobi-a (dst src &optional (w 0.25d0))
  (declare (type (simple-array double-float 2) dst src)
           (type double-float w))
  (loop for i from 1 below (1- (array-dimension dst 0)) do
    (loop for j from 1 below (1- (array-dimension dst 1)) do
      (setf (aref dst i j)
            (* w
               (+
                (aref src i (1+ j))
                (aref src i (1- j))
                (aref src (1+ i) j)
                (aref src (1- i) j)))))))

(defun jacobi-bench (jacobi &optional (iterations (expt 10 7)))
  (let* ((m 3)
         (n 320)
         (args '(:element-type double-float :initial-element 0d0))
         (a (apply #'make-array (list m n) args))
         (b (apply #'make-array (list m n) args))
         (timestamp (get-internal-real-time)))
    (loop repeat (floor iterations 2) do
      (funcall jacobi a b)
      (funcall jacobi b a))
    (format t "~&FLOP/s: ~E~%"
            (coerce
             (/ (* 4 iterations (- m 2) (- n 2))
                (/ (- (get-internal-real-time) timestamp)
                   internal-time-units-per-second))
             'single-float))))

(defun jacobi-b (dst src &optional (w 0.25d0))
  (declare (type (simple-array double-float 2) dst src)
           (type double-float w))
  (loopus:for (i 1 (1- (array-dimension dst 0)))
    (loopus:for (j 1 (1- (array-dimension dst 1)))
      (setf (aref dst i j)
            (* w
               (+
                (aref src i (1+ j))
                (aref src i (1- j))
                (aref src (1+ i) j)
                (aref src (1- i) j)))))))

(defun brrrt (&optional (n 60))
  (loop for i below n do
    (let ((*standard-output* (make-broadcast-stream)))
      (jacobi-bench 'jacobi-b))
    (format t "~&Common Lisp go br~{~C~}rt.~%"
            (make-list i :initial-element #\r))))