Game of life in Clojure + seesaw, based on reddit thread, see comments

gol.clj

;;; 
;;; see https://www.reddit.com/r/Clojure/comments/gcry9d/why_does_my_clojure_implementation_of_conways/
;;; for initial implementation
;;; 

(ns gol.core
  (:gen-class)
  (:import
   [java.awt Color Graphics])
  (:use seesaw.core
        seesaw.color
        seesaw.graphics))

(definline equiv
  [x y]
  `(clojure.lang.Numbers/equiv ~x ~y))

(definline eq0?
  [x]
  `(equiv ~(int 0) ~x))

(defn unchecked-mod
  "Modulus of num and div. Truncates toward negative infinity."
  [num div]
  (let [m (unchecked-remainder-int num div)]
    (if (or (eq0? m) (= (pos? num) (pos? div)))
      m
      (unchecked-add-int m div))))

;;; see https://github.com/clojurebook/ClojureProgramming/blob/bcc7c58862982a5793e22788fc11a9ed7ffc548f/ch11-maths-repl-interactions.clj#L582
(defmacro deep-aget
  "Gets a value from a multidimensional array as if via `aget`,
   but with automatic application of appropriate type hints to
   each step in the array traversal as guided by the hint added
   to the source array.
   e.g. (deep-aget ^doubles arr i j)"
  ([array idx]
   `(aget ~array ~idx))
  ([array idx & idxs]
   (let [a-sym (gensym "a")]
     `(let [~a-sym (aget ~(vary-meta array assoc :tag 'objects) ~idx)]
        (deep-aget ~(with-meta a-sym {:tag (-> array meta :tag)}) ~@idxs)))))

(defmacro deep-aset
  "Sets a value in a multidimensional array as if via `aset`,
   but with automatic application of appropriate type hints to
   each step in the array traversal as guided by the hint added
   to the target array.
   e.g. (deep-aset ^doubles arr i j 1.0)"
  [array & idxsv]
  (let [hints '{booleans boolean, bytes byte
                chars char, longs long
                ints int, shorts short
                doubles double, floats float}
        hint (-> array meta :tag)
        [v idx & sxdi] (reverse idxsv)
        idxs (reverse sxdi)
        v (if-let [h (hints hint)] (list h v) v)
        nested-array (if (seq idxs)
                       `(deep-aget ~(vary-meta array assoc :tag 'objects) ~@idxs)
                       array)
        a-sym (gensym "a")]
    `(let [~a-sym ~nested-array]
       (aset ~(with-meta a-sym {:tag hint}) ~idx ~v))))

(set! *warn-on-reflection* true)
(set! *unchecked-math* true)

(def wCells  100)
(def hCells 100)
(def rows 100)
(def cols 100)
(def cellSize 5)
(def cellColor (color 0 255 0))
(def statusBarHeight 20)
(def windowWidth  (* wCells cellSize))
(def windowHeight (+ statusBarHeight (* hCells cellSize)))
(def frameCap 30)
(def maxFrameDuration (quot 1000 frameCap))

(defn build-board
  [rows cols]
  (let [a (int-array cols)
        t (type a)]
    (into-array t (repeatedly rows #(int-array cols)))))

(defn init-board
  [board rows cols]
  (loop [row (int 0)]
    (when-not (= row rows)
      (loop [col (int 0)]
        (when-not (= col cols)
          (deep-aset ^ints board row col (rand-int 2))
          (recur (unchecked-inc-int col))))
      (recur (unchecked-inc-int row)))))

(def boards
  (let [b1 (build-board rows cols)
        b2 (build-board rows cols)]
    (init-board b1 rows cols)
    (into-array (type b1) [b1 b2])))

(def current-board (atom (int 0)))


(defn neighbors-around
  [board ?row rows ?col cols]
  (let [start-row (unchecked-dec-int ?row)
        end-row (unchecked-add-int ?row (int 2))
        start-col (unchecked-dec-int ?col)
        end-col (unchecked-add-int ?col (int 2))
        found (int 0)]
    (loop [row start-row
           found found]
      (if-not (equiv row end-row)
        (recur (unchecked-inc-int row)
               (int
                (loop [col start-col
                       found found]
                  (if-not (equiv col end-col)
                    (let [-row (unchecked-mod row rows)
                          -col (unchecked-mod  col cols)]
                      (if (and (equiv ?row -row) (equiv ?col -col))
                        (recur (unchecked-inc-int col) found)
                        (recur (unchecked-inc-int col)
                               (unchecked-add-int found (deep-aget ^ints board -row -col)))))
                    (int found)))))
        (int found)))))


(def lastTime (atom (System/currentTimeMillis)))

(def alive (int 1))
(def dead (int 0))

(defn step
  [gen1 gen2 rows cols]
  (loop [row (int 0)]
    (when-not (= row rows)
      (loop [col (int 0)]
        (when-not (= col cols)
          (let [-ns (neighbors-around gen1 row rows col cols)
                cell (deep-aget ^ints gen1 row col)]
            (if (= alive cell)
              (if (or (= -ns 2) (= -ns 3))
                (deep-aset ^ints gen2 row col alive)
                (deep-aset ^ints gen2 row col dead))
              (if (= -ns 3)
                (deep-aset ^ints gen2 row col alive)
                (deep-aset ^ints gen2 row col dead))))
          (recur (unchecked-inc-int col))))
      (recur (unchecked-inc-int row)))))


(defn fps
  []
  (let [previous @lastTime
        current (System/currentTimeMillis)
        diff (- current previous)
        toSleep (- maxFrameDuration diff)]
    (when (pos? toSleep) (Thread/sleep toSleep))
    (reset! lastTime (System/currentTimeMillis))
    (double (/ 1000 (- (System/currentTimeMillis) previous)))))

(def red (color 255 0 0))
(def blue (color 0 0 255))

(defn painter- [c ^Graphics g]
  (let [curr @current-board
        board (deep-aget ^objects boards (int curr))
        next-curr (unchecked-subtract-int 1 curr)
        next-board (deep-aget ^objects boards (int next-curr))]
    (.setColor g red)
    (.drawRect g 0 0 windowWidth (- windowHeight statusBarHeight))
    (.setColor g cellColor)
    (dotimes [row rows]
      (dotimes [col cols]
        (let [cell (deep-aget ^ints board row col)]
          (when (= alive cell)
            (.fillRect g (* cellSize col) (* cellSize row) cellSize cellSize)))))
    (.setColor g blue)
    (.drawString g ^String (str "Simulations per second: " (fps)) (int 50) (int (- windowHeight 5)))
    (step board next-board rows cols)
    (reset! current-board next-curr)))

(def m-canvas
  (canvas :id :mcanvas
          :background :black
          :paint painter-))

(defn -main
  [& args]
  (invoke-later
   (-> (frame :title "Game Of Life",
              :width (+ 3 windowWidth), :height (inc windowHeight),
              :content m-canvas,)
       show!)))

(def t (timer (fn [e] (repaint! m-canvas)) :delay 1))

numeric equivalence via == is also way better than =

numeric equivalence via == is also way better than =

I forgot about ==, which is just a wrapper for equiv, which I wrote one for myself.
Didn't bother doing the same forstep since I saw in a flame graph that cycles were significantly dominated by neighbors-around

The only remaining work would be to add fast-math, but I wanted to see how fast we could go with plain clojure.