;;;; Any typed container crosses into dyn as a view: every element type and
;;;; any storage. 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
;;;; the stale-view modes under --dev only: a release build keeps no record of
;;;; frames or blocks, so it neither checks nor promises anything there.

;; Unannotated parameters and returns are dyn: every call below boxes its
;; typed argument into a view at the call.
(defn show [label d] ()
  (print label)
  (print " ")
  (println d))

(defn bump-all [d] ()
  (dotimes [i (length d)]
    (set (at d i) (+ (at d i) 1))))

(defn keep [d] dyn d)

;; Field offsets only C's layout rule gets right: a u8, then an i64 aligned
;; to 8, an f32, a bool, three u16 at 2, an i32 at 4.
(defstruct Mix [a u8  b i64  c f32  d bool  e [3 u16]  f i32])
(defstruct Point [x f32  y i32])
(defstruct Named [name str  id u32])
(defstruct Wide [a u64  b i64])
(defstruct Small [x i8  z bool])

(declare gc-collect [] () "flan_gc_collect")
(declare gc-live-bytes [] i64 "flan_gc_live_bytes")
(defonce g3 [3 i64])
(defn first-of [d] dyn (at d 0))

(defn make-point [] Point (Point {.x 1.5 .y 2}))

(defn param-array [xs [4 i32]] i32
  ;; A parameter array is this frame's copy.
  (bump-all xs)
  (at xs 3))

(defn param-slice [xs [i64]] ()
  (bump-all xs))

(defonce held dyn nil)

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

(defn stash [d] () (set held d))

;; A slice of a local, crossing where the compiler cannot tie it to a frame:
;; bound to a local first, and passed through a slice parameter.
(defn leak-slice-local [] ()
  (let [a [(i64 5) 6 7]
        s (slice a 0 3)]
    (stash s)))
(defn via-slice [xs [i64]] () (stash xs))
(defn leak-slice-param [] ()
  (let [a [(i64 5) 6 7]]
    (via-slice (slice a 0 3))))

(defn clobber [] i64
  (let [b [(i64 7) 8 9 10 11 12]]
    (+ (at b 0) (at b 5))))

(defn main [args [str]] i32
  (let [n (i32 (bytes->i64 (bytes-view (at args 1))))]
    (cond
      (= n 0)
      (do
        ;; Every integer width, a local array each: read widens, write stores.
        (let [a [(i8 -1) -2 -3]
              b [(u8 250) 251 252]
              c [(i16 -300) 300]
              d [(u16 60000) 1]
              e [(i32 -70000) 70000]
              f [(u32 4000000000) 1]
              g [(i64 -5) 5]
              h [(u64 9000000000000000000) 1]]
          (bump-all a) (bump-all b) (bump-all c) (bump-all d)
          (bump-all e) (bump-all f) (bump-all g) (bump-all h)
          (show "i8" a) (show "u8" b) (show "i16" c) (show "u16" d)
          (show "i32" e) (show "u32" f) (show "i64" g) (show "u64" h)
          (println (at b 2)))
        ;; f32: read widens, write narrows, and an int goes in when the f32
        ;; holds it exactly.
        (let [fs [(f32 0.5) 1.25]
              dv (keep fs)]
          (set (at dv 0) 2.75)
          (set (at dv 1) 3.1)
          (show "f32" dv)
          (set (at dv 0) 4)
          (println (at fs 0)))
        ;; bool, through a slice cut from a local array.
        (let [bs [true false true]]
          (let [dv (keep (slice bs 0 3))]
            (set (at dv 1) true)
            (show "bool" dv)
            (println (at bs 1))))
        ;; The author's case: a [u8] from bytes, sorted in place by dyn code.
        (let [text (bytes "INSERTIONSORT")]
          (let [d (keep text)]
            (dotimes [i (length d)]
              (let [j i]
                (while (and (> j 0) (< (at d j) (at d (- j 1))))
                  (let [t (at d j)]
                    (set (at d j) (at d (- j 1)))
                    (set (at d (- j 1)) t))
                  (set j (- j 1))))))
          (println (str text)))
        ;; A struct: a map-like view, written through get and put.
        (let [p (Point {.x 0.5 .y 3})
              dp (keep p)]
          (show "point" dp)
          (set (get dp :y) 40)
          (put dp :x 9.5)
          (println (.y p))
          (println (.x p))
          (println (get dp :x))
          (println (length dp))
          (println (has-key? dp :y)))
        ;; Every field of a padded struct reads back.
        (let [m (Mix {.a 7 .b -9000000000 .c 2.5 .d true .e [1 2 3] .f -4})]
          (show "mix" (keep m))
          (set (at (get (keep m) :e) 2) 65535)
          (println (at (.e m) 2)))
        ;; A str field reads as text.
        (let [nm (Named {.name "ada" .id 7})]
          (show "named" (keep nm)))
        ;; Nested arrays: a view of a view.
        (let [grid [[(i32 1) 2 3] [4 5 6]]
              dg (keep grid)]
          (set (at (at dg 1) 2) 60)
          (show "grid" dg)
          (println (at (at grid 1) 2)))
        ;; An array of structs.
        (let [ps [(Point {.x 1.0 .y 1}) (Point {.x 2.0 .y 2})]
              dp (keep ps)]
          (set (get (at dp 1) :y) 20)
          (show "points" dp)
          (println (.y (at ps 1))))
        ;; A Vec in a local: a push through the view grows the typed Vec.
        (let [v (vec-new i32)]
          (push v 1)
          (let [dv (keep v)]
            (push dv 2)
            (push dv 3)
            (show "vec" dv))
          (println (length v)))
        ;; A Vec of structs.
        (let [v (vec-new Point)]
          (push v (Point {.x 0.0 .y 5}))
          (let [dv (keep v)]
            (set (get (at dv 0) :y) 6))
          (println (.y (at v 0))))
        ;; Parameters: an array parameter is the callee's copy; a slice
        ;; parameter sees the caller's elements.
        (let [xs [(i32 1) 2 3 4]]
          (println (param-array xs))
          (println (at xs 3)))
        (let [ys [(i64 1) 2]]
          (param-slice (slice ys 0 2))
          (println (at ys 1)))
        ;; A temporary: a struct returned by a call.
        (show "temp" (keep (make-point)))
        ;; A heap slice, and an arena's Vec.
        (let [c (clone (slice [(i64 1) 2 3] 0 3))]
          (bump-all c)
          (println (at c 2)))
        (let [ar (arena-new 4096)]
          (with-allocator ar
            (let [v (vec-new i16)]
              (push v 1)
              (push v 2)
              (bump-all v)
              (println (at v 1))))
          (arena-destroy ar))
        ;; Two views of equal structs are equal.
        (let [p (Point {.x 1.0 .y 2})
              q (Point {.x 1.0 .y 2})]
          (println (= (keep p) (keep q))))
        ;; .field and [:k] on a struct's view: a read is get, a set is put,
        ;; and the typed struct sees every write.
        (let [p (Point {.x 1.0 .y 2})
              m (Mix {.a 1 .b 2 .c 0.5 .d false .e [1 2 3] .f 4})
              dp (keep p)
              dm (keep m)]
          (set (.y dp) 5)
          (update (.y dp) + 10)
          (set (at dp :x) 2.5)
          (set (.d dm) true)
          (set (at (.e dm) 1) 20)
          (println (.y dp) (at dp :x) (.a dm) (.d dm) (at (.e dm) 1))
          (println (.y p) (.x p) (.d m) (at (.e m) 1)))
        0)
      ;; A value an element's width cannot hold.
      (= n 1)
      (let [b [(u8 1) 2]]
        (set (at (keep b) 0) 300)
        0)
      ;; A u64 above the largest dyn int.
      (= n 2)
      (let [h [(u64 18000000000000000000)]]
        (println (at (keep h) 0))
        0)
      ;; A field a struct does not have.
      (= n 3)
      (let [p (Point {.x 1.0 .y 2})]
        (println (get (keep p) :z))
        0)
      ;; A view of a local, used after its call returned: stale in a dev build.
      (= n 4)
      (do (leak-local)
          (println (clobber))
          (println (at held 0))
          0)
      ;; A slice of a Vec's block, used after the Vec grew and moved.
      (= n 5)
      (let [v (vec-new i64)]
        (push v 1)
        (let [d (keep (slice v))]
          (dotimes [i 100] (push v i))
          (println (at d 0)))
        0)
      ;; A heap slice used after it was freed.
      (= n 6)
      (let [c (clone (slice [(i64 1) 2 3] 0 3))
            d (keep c)]
        (free c)
        (println (at d 0))
        0)
      ;; An arena's storage used after free-all.
      (= n 7)
      (let [ar (arena-new 4096)
            v (with-allocator ar (clone (slice [(i32 4) 5] 0 2)))
            d (keep v)]
        (free-all ar)
        (println (at d 1))
        0)
      ;; A str element is read-only through a view.
      (= n 8)
      (let [nm (Named {.name "ada" .id 7})]
        (put (keep nm) :name "bob")
        0)
      ;; An int an f32 does not hold exactly: 2^24 + 1.
      (= n 9)
      (let [fs [(f32 0.5)]]
        (set (at (keep fs) 0) 16777217)
        0)
      ;; A field a struct does not have, through .field.
      (= n 10)
      (let [p (Point {.x 1.0 .y 2})]
        (set (.z (keep p)) 3)
        0)
      ;; A million views made and dropped: the collector takes back every
      ;; byte it charged for them.
      (= n 11)
      (let [s (i64 0)]
        (set (at g3 0) 1)
        (dotimes [i 300000] (set s (+ s (i64 (first-of g3)))))
        (gc-collect)
        (println s (< (gc-live-bytes) 1000000))
        0)
      ;; Stale through a slice bound to a local, and through a slice parameter.
      (= n 12)
      (do (leak-slice-local) (println (clobber)) (println (at held 0)) 0)
      (= n 13)
      (do (leak-slice-param) (println (clobber)) (println (at held 0)) 0)
      ;; A field given a value of the wrong type, or nil, or out of range.
      (= n 14)
      (let [p (Small {.x 1 .z true})] (set (.x (keep p)) 1.5) 0)
      (= n 15)
      (let [p (Small {.x 1 .z true})] (set (.z (keep p)) nil) 0)
      (= n 16)
      (let [p (Small {.x 1 .z true})] (set (.x (keep p)) 200) 0)
      ;; A stale view printed, measured and asked for a key, at their sites.
      (= n 17)
      (do (leak-local) (println (clobber)) (println held) 0)
      (= n 18)
      (do (leak-local) (println (clobber)) (println (length held)) 0)
      ;; A u64 above the dyn int range prints, and reading it traps here.
      (= n 19)
      (let [w (Wide {.a 18000000000000000000 .b 1})
            d (keep w)]
        (println d)
        (println (.a d))
        0)
      ;; An element's range, with its article.
      (= n 20)
      (let [a [(i8 1)]] (set (at (keep a) 0) 200) 0)
      :else (do (println "?") 1))))