;;;; A generic body that allocates a container of its own element type.
;;;;
;;;; The caller-allocated spelling — the caller passes a destination slice and
;;;; the callee fills it — is the one a generic could always write. This is the
;;;; other half: [sorted] below asks for the storage itself, at whatever type
;;;; the instantiation turned out to be, and hands the container back.
;;;;
;;;; What makes that work is that a type variable names a type wherever a type
;;;; name goes, in both spellings: [$t] is how a defn signature introduces the
;;;; variable and [t] is how the body spells the same one, and the constructors
;;;; that read a type argument — vec-new, map-new, array, a cast — accept
;;;; either. The size and the alignment flan_vec_init is given are produced
;;;; from the element type at the point the copy is checked, so each copy
;;;; carries its own: 4 and 4 in the i32 one, 8 and 8 in the f64 one. The
;;;; abstract pass, which checks the body once with nothing substituted, is
;;;; never emitted, so no copy ever asks for the size of a variable.

;; The motivating case: allocate, fill, sort, return. Two element types below,
;; so there are two copies and the storage in each is the instantiation's.
(defn sorted [xs [$t]] (Vec $t)
  {:where (ordered? $t)}
  (let [v (vec-new $t)]
    (dotimes [i (len xs)] (push v (at xs i)))
    (sort (slice v))
    v))

;; The same, against a named allocator rather than the context's. Both arities
;; read their element type the same way, so both take a variable.
(defn sorted-in [xs [$t]  al Allocator] (Vec $t)
  {:where (ordered? $t)}
  (let [v (vec-new $t al)]
    (dotimes [i (len xs)] (push v (at xs i)))
    (sort (slice v))
    v))

;; A Map whose key is the variable. The predicate is what lets the hash and the
;; equality be deferred to the copy; see generics.flan for that half.
(defn distinct-count [ks [$k]] i32
  {:where (hashable? $k)}
  (let [m (map-new $k i32)]
    (dotimes [i (len ks)]
      (put m (at ks i) 1))
    (let [n (len m)] (free m) n)))

;; The zeroed fixed array. Its length is still a compile-time constant; only
;; the element type is the variable, and that is answered per copy.
(defn middle-of [x $t] $t
  (let [a (array 3 $t)]
    (set (at a 1) x)
    (at a 1)))

;; A cast to the variable, written with the sigil.
(defn widen [x i32  d $t] $t
  {:where (numeric? $t)}
  (do d ($t x)))

;; There is no row here for a type variable that instantiates at dyn: a
;; generic is not instantiated at dyn at all, and the refusal says to reach
;; for the dyn side instead. So nothing a copy of one of these bodies does
;; can reach the dyn container.

;; Allocation failure inside a generic copy, handled the way exhausted.flan
;; handles it: a ceiling, a handler that raises it, and retry re-attempting the
;; request that did not fit. The globals are because a handler cannot see the
;; locals of the function that established it.
(defonce tight Allocator)
(defonce failures i64)

(defn main [] ()
  (let [ns [5 3 9 1]
        fs [2.5 0.5 1.5]
        a (sorted (slice ns 0 4))
        b (sorted (slice fs 0 3))]
    (println (at (slice a) 0))       ; 1
    (println (at (slice a) 3))       ; 9
    (println (at (slice b) 0))       ; 0.5
    (println (len (slice b)))        ; 3
    (free a)
    (free b))

  (let [ns [4 2 8]
        ar (arena-new 4096)
        c (sorted-in (slice ns 0 3) ar)]
    (println (at (slice c) 0))       ; 2
    (free-all ar))

  (let [ns [7 7 3]
        ws ["a" "b" "a"]]
    (println (distinct-count (slice ns 0 3)))   ; 2
    (println (distinct-count (slice ws 0 3))))  ; 2

  (println (middle-of 6))               ; 6
  (println (middle-of 1.5))             ; 1.5
  (println (widen 3 0.0))               ; 3

  ;; The guard, the condition and the restart are the concrete form's, emitted
  ;; into the copy unchanged. 32 bytes is four i32 and the sixteen this fills
  ;; are not.
  (set tight (heap-allocator))
  (set-alloc-budget tight 32)
  (handler-bind
    [(StorageExhausted [c]
       (set failures (+ failures 1))
       (set-alloc-budget tight (* 4 (alloc-budget tight)))
       (invoke-restart 'retry))]
    (let [ns [9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4]
          d (sorted-in (slice ns 0 16) tight)]
      (println (len (slice d)))      ; 16
      (println (at (slice d) 0))     ; 0
      (free d)))
  (println (> failures 0))              ; true
  (set-alloc-budget tight 0))