;;;; A dyn value where typed code wrote a str, a slice, a fixed array or a
;;;; struct. Mode 0 is the survey; the others are one trap each, since a trap
;;;; ends the process. test_acceptance.ml runs it on both backends and under
;;;; --dev, where mode 8 (a view of a returned call's local) traps as well.

(declare gc-collect [] () "flan_gc_collect")
(declare gc-count [] i64 "flan_gc_count")

(defstruct Point [x f64  y i32])
(defstruct Named [name str  id u32])
(defclass pt [x y])

;; Unannotated parameters and returns are dyn.
(defn keep [d] dyn d)
(defn text-of [d] dyn (slice d 0 5))

(defn shout [s str] () (println s))
(defn keep-str [s str] str s)
;; The text crosses in this frame, whose dyn slots are gone once it returns.
(defn fetch [] str (keep-str (text-of (keep "pinned text"))))
(defn sum [xs [const i64]] i64
  (let [t (i64 0)]
    (dotimes [i (length xs)] (set t (+ t (at xs i))))
    t))
(defn bump [xs [i64]] ()
  (dotimes [i (length xs)] (set (at xs i) (+ (at xs i) 100))))
(defn sumf [xs [const f64]] f64
  (let [t 0.0]
    (dotimes [i (length xs)] (set t (+ t (at xs i))))
    t))
(defn bytes-sum [xs [const u8]] i64
  (let [t (i64 0)]
    (dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
    t))
(defn names [xs [const str]] ()
  (dotimes [i (length xs)] (println (at xs i))))
(defn words [xs [const [const u8]]] i64 (length (at xs 1)))
(defn triple [a [3 i64]] i64 (+ (at a 0) (at a 2)))
(defn grid [g [2 [2 i32]]] i32 (at g 1 0))
(defn px [p Point] f64 (+ (.x p) (f64 (.y p))))
(defn named [n Named] () (println (.name n) (.id n)))
(defn f64s [xs [f64]] () (println (length xs)))
(defn raw [xs [u8]] () (println (length xs)))

(declare pin-count [] i64 "flan_dyn_pin_count")
(defn slen [s str] i64 (length s))
(defn f32s [xs [const f32]] () (println (length xs)))
(defclass pq [x])

;; A str kept in a global past free-temp: a dev build's copy is poisoned.
(defonce kept str "")
(defn stash-str [] () (set kept (keep-str (keep "kept text"))))

;; A view of a local, kept past the call that owns the local.
(defonce held dyn nil)
(defn leak-local [] ()
  (let [a [(i64 1) 2 3]]
    (set held (keep a))))

(defn main [args [str]] i32
  (let [n (i32 (bytes->i64 (bytes-view (at args 1))))]
    (cond
      (= n 0)
      (do
        ;; A text becomes a str.
        (shout (keep "hello"))
        (println (length (keep-str (keep "four"))))
        ;; A str kept past its crossing, the text reachable only through
        ;; the pin, while collections run and the heap is refilled.
        (let [s (fetch)]
          (gc-collect)
          (dotimes [i 20000] (text-of (keep "XXXXXXXXXX")))
          (gc-collect)
          (dotimes [i 20000] (text-of (keep "XXXXXXXXXX")))
          (println s))
        ;; A pin ends at free-temp: a thousand crossed texts are collected.
        (free-temp)
        (gc-collect)
        (let [before (gc-count)]
          (dotimes [i 1000] (keep-str (text-of (keep "abcdefgh"))))
          (free-temp)
          (gc-collect)
          (println (< (- (gc-count) before) 100)))
        ;; The same texts crossing again and again are pinned once each.
        (let [t1 (keep "one") t2 (keep "two") n (i64 0)]
          (dotimes [i 100000] (set n (+ n (slen t1) (slen t2))))
          (println n (< (pin-count) 10)))
        ;; A view of typed storage comes back as that storage.
        (let [a [(i64 1) 2 3]]
          (bump (keep a))
          (println a)
          (println (sum (keep a))))
        (let [v (vec-new i64)]
          (push v 5) (push v 6)
          (bump (keep v))
          (println (at v 0) (at v 1))
          (free v))
        ;; A plain dyn vec is a checked copy for a [const T].
        (println (sum (the dyn [1 2 3 4])))
        (println (sumf (the dyn [1 2.5])))
        (println (bytes-sum (the dyn [1 2 255])))
        (println (bytes-sum (keep "AB")))
        (names (the dyn ["ada" "bo"]))
        (println (words (the dyn ["x" "yyy"])))
        ;; A view of other elements too.
        (let [b [(i32 7) 8]]
          (println (sum (keep b))))
        ;; A fixed array and a struct are values: a copy either way.
        (println (triple (the dyn [10 20 30])))
        (let [a [(i64 4) 5 6]] (println (triple (keep a))))
        (println (grid (the dyn [[1 2] [3 4]])))
        (println (px (the dyn {:x 1.5 :y 2})))
        (println (px (pt 2.5 3)))
        (let [p (Point {.x 0.25 .y 4})] (println (px (keep p))))
        (named (the dyn {:name "cy" :id 9}))
        0)
      (= n 1) (do (println (sum (the dyn [1 "a" 3]))) 0)
      (= n 2) (do (bump (the dyn [1 2])) 0)
      (= n 3) (do (println (sum (keep "abc"))) 0)
      (= n 4) (do (println (bytes-sum (the dyn [1 300]))) 0)
      (= n 5) (do (println (triple (the dyn [1 2]))) 0)
      (= n 6) (do (println (px (the dyn {:x 1.5}))) 0)
      (= n 7) (do (shout (keep 5)) 0)
      (= n 8) (do (leak-local) (bump held) 0)
      (= n 9) (do (raw (keep "abc")) 0)
      (= n 10) (let [a [(f32 1) 2]] (f64s (keep a)) 0)
      (= n 11) (do (println (px (the dyn {:x 1.5 :y "no"}))) 0)
      (= n 12) (do (f32s (the dyn [1.5 1e300])) 0)
      (= n 13) (do (println (px (pq 1.5))) 0)
      (= n 14) (do (println (px (the dyn {:x 1.5 :y 2 :z 3}))) 0)
      (= n 15)
      (do (stash-str)
          (free-temp)
          (gc-collect)
          (dotimes [i 1000] (text-of (keep "XXXXXXXXXX")))
          (println (at kept 0))
          0)
      :else 1)))