;;;; A dyn value read out of a place, held while a sibling operand runs.
;;;;
;;;; Every line below reads the vector in [other] into an operand position —
;;;; a call's argument, a struct literal's field, an array literal's element,
;;;; a runtime call's argument, a function value's argument, the array an
;;;; index is taken of — and then runs a
;;;; sibling that overwrites [other] and allocates enough to collect. Once
;;;; [other] is overwritten, the only reference to the vector is the operand
;;;; being held, so unless that operand has a root of its own the collection
;;;; frees it and the line prints whatever the freed block holds next.
;;;;
;;;; [churn] ends in an explicit collection, so each line is tested against a
;;;; collection that certainly ran and not against the trigger's timing.

(defstruct T [d dyn n i64])
(defstruct W [t T k i64])
(defstruct A2 [xs [2 dyn]])
(declare gc-collect [] () "flan_gc_collect")

(defonce other T)
(defonce dst T)
(defonce pair [2 dyn])
(defonce w W)

(defn churn [] i64
  (let [i 0]
    (while (< i 2000)
      (let [v (vec-new dyn)] (push v i) (push v "junk"))
      (set i (+ i 1)))
    (gc-collect)
    7))

(defn kept [] dyn
  (let [v (vec-new dyn)] (push v "kept") (push v 42) v))

;;; A fresh vector in [other], old enough that it is no longer among the
;;; collector's most recent allocations.
(defn fill [] () (set (.d other) (kept)) (churn))

;;; Overwrite [other], then allocate and collect.
(defn clobber [] i64 (set other (T {.n 0})) (churn))
(defn clobber-dyn [] dyn (clobber) (vec-new dyn))
(defn clobber-idx [] i32 (clobber) 0)

(defn pick [x dyn n i64] dyn x)
(defn pick-t [t T n i64] dyn (.d t))

(defn show [label str v dyn] ()
  (churn)
  (println label (at v 0) (at v 1)))

(defn main [] ()
  ;; A call's argument.
  (fill)
  (set (.d dst) (pick (.d other) (clobber)))
  (show "call:" (.d dst))

  ;; A struct literal's field.
  (fill)
  (set dst (T {.d (.d other) .n (clobber)}))
  (show "struct:" (.d dst))

  ;; An array literal's element.
  (fill)
  (set pair [(.d other) (clobber-dyn)])
  (show "array:" (at pair 0))

  ;; A runtime call's argument: dyn equality is a call into the runtime, and
  ;; its first operand is held while the second is computed.
  (fill)
  (println "runtime:" (= (.d other) (do (clobber) (kept))))

  ;; A local, overwritten by the sibling rather than a global.
  (fill)
  (let [x (.d other)]
    (set (.d dst) (pick x (do (set x 0) (clobber))))
    (show "local:" (.d dst)))

  ;; A whole struct with a dyn field in it, passed by value.
  (fill)
  (set (.d dst) (pick-t other (clobber)))
  (show "aggregate:" (.d dst))

  ;; The same struct as a field of a struct literal.
  (fill)
  (set w (W {.t other .k (clobber)}))
  (show "nested:" (.d (.t w)))

  ;; Through a function value.
  (fill)
  (let [g pick]
    (set (.d dst) (g (.d other) (clobber)))
    (show "fn value:" (.d dst)))

  ;; An array literal indexed while the index runs: the array is a temporary
  ;; taken by address, and the temporary is what is held.
  (fill)
  (set (.d dst) (at [(.d other) (.d other)] (clobber-idx)))
  (show "index:" (.d dst))

  ;; The same through a field of a struct literal.
  (fill)
  (set (.d dst) (at (.xs (A2 {.xs [(.d other) (.d other)]})) (clobber-idx)))
  (show "field index:" (.d dst)))