flan/test/programs/generics.flan

;;;; Generics by monomorphisation, end to end.
;;;;
;;;; A [$t] binds a type variable in a defn signature and every call site
;;;; instantiates the body at the types it passes. The body is checked once
;;;; *abstractly*, with nothing substituted, so an operator the variable is
;;;; not declared to support is refused at the definition and not at whichever
;;;; call site happened to reach a type that worked — see generic-reject.flan
;;;; and generic-runaway.flan for that half.
;;;;
;;;; What this program is asserting, in order: one variable at several types,
;;;; a variable bound inside a slice, a generic calling a generic at its own
;;;; variable so that instantiation has to be transitive, the four where
;;;; predicates, two variables at once, println deferred to the instantiation,
;;;; the collapsed prelude family the whole feature was for, and the family
;;;; over (Option $t) — or-else and some? — which is the one that declares no
;;;; predicate at all, so a $t that owns storage instantiates it too.

;; One variable, several types, and (ident 3) and (ident 7) share one copy.
;; The identity needs its parameter once, so it needs nothing declared: a type
;; variable is move-only by default and one move is what this is.
(defn ident [x $t] $t x)

;; The variable is bound *inside* a type constructor, which is a structural
;; walk rather than a name match.
(defn first-or [s [$t]  d $t] $t
  (if (= (len s) 0) d (at s 0)))

;; A generic calling a generic at its own variable: the copy of [swap] is
;; generated when [rotate] is instantiated and not before.
(defn rotate [s [$t]] ()
  (dotimes [i (- (len s) 1)]
    (swap s i (+ i 1))))

;; numeric? admits + - * / %.
(defn twice [x $t] $t
  {:where (numeric? $t)}
  (+ x x))

;; equal? admits = and !=; ordered? admits < <= > >= min max, and entails
;; equal?.
(defn count-of [s [$t]  x $t] i32
  {:where (equal? $t)}
  (let [n 0]
    (dotimes [i (len s)]
      (when (= (at s i) x)
        (set n (+ n 1))))
    n))

(defn clamp-to [x $t  lo $t  hi $t] $t
  {:where (ordered? $t)}
  (min (max x lo) hi))

;; Two variables, and the second is determined by its own argument.
(defn fst [a $t  b $u] $t
  (do b a))

;; println over a type variable is the one form the abstract pass defers to
;; the instantiation, because its legality is only decidable after
;; substituting. The structural printer is selected per copy.
(defn show [x $t] ()
  (println x))

;; A cast to a type variable. [(t x)] is not a name [is_cast] knows — [t] is
;; not a machine type — so it is its own arm, and [numeric?] is what admits
;; it, because a cast produces a number. Inside the copy the target is
;; concrete and the emitter sees an ordinary cast.
(defn widen [x i32  d $t] $t
  {:where (numeric? $t)}
  (do d (t x)))

;; The builtins that take a *type name* as an argument, over a variable. Each
;; reaches the one list of what names a type; (map-new t i32) is the other.
(defn one-of [x $t] (Vec $t)
  (let [v (vec-new t)]
    (push v x)
    v))

;; An empty (Option (Vec u8)), which main needs to reach or-else's None branch
;; at a type that owns storage. It is a function and not a bare None at the
;; call site because a bare None there is refused — "nothing here says what
;; None is an Option of" — and a return type is one of the two places the
;; checker names as somewhere to say it. It is also the shape every real caller
;; is in: what arrives at or-else came out of something, the way edn/read's
;; answer does.
(defn none-vec [] (Option (Vec u8))
  None)

;; (zeroed) takes its type from the position it is written in, so a variable
;; in that position is answered by the instantiation like any other type.
(defn zero-of [x $t] $t
  (do x (zeroed)))

;; The map operations over a key that is a type variable. The hash and the
;; equality are concrete symbols chosen from the concrete key type, so there
;; is nothing to emit here — these are deferred to the instantiation, the way
;; println is, and {:where (hashable? $t)} is what allows it: the refusal for
;; a key type that cannot be hashed lands at the call site, against a
;; requirement written down in this signature. Without the clause the type
;; (Map $t i32) is refused where it is written; see generic-map-reject.flan
;; for the call-site half.
(defn bump [k $t  n i32] i32
  {:where (hashable? $t)}
  (let [m (map-new t i32)]
    (reserve m 8)
    (put m k n)
    (put m k (+ n (match (get m k) (Some v) v _ 0)))
    (let [c (clone m)
          answer (+ (match (get c k) (Some v) v _ -1)
                    (if (has-key? c k) 1 0))]
      (free c)
      (free m)
      answer)))

(defn main [] ()
  (println (ident 3))
  (println (ident 4.5))
  (println (ident true))
  (println (ident 7))

  (let [ns [5 3 9 1]
        fs [2.5 0.5 1.5]]
    (println (first-or (slice ns 0 4) -1))
    (println (first-or (slice ns 0 0) -1))
    (rotate (slice ns 0 4))
    (println (at ns 3))

    (println (twice 21))
    (println (twice 1.5))
    (println (count-of (slice ns 0 4) 9))
    (println (clamp-to 12 0 10))
    (println (clamp-to 0.5 1.0 9.0))
    (println (fst 8 true))

    (show 3)
    (show 4.5)
    (show "text")

    ;; The collapsed prelude family, at both element types.
    (sort (slice ns 0 4))
    (println (at ns 0))
    (sort-by (slice fs 0 3) (fn [a b] (> a b)))
    (println (at fs 0))
    (reverse (slice ns 0 4))
    (println (at ns 0))
    (map-in-place (slice ns 0 4) (fn [x] (* x 2)))
    (println (reduce (slice ns 0 4) 0 (fn [a b] (+ a b))))
    (match (min-of (slice ns 0 4)) (Some m) (println m) _ (println -1))
    (match (max-of (slice fs 0 3)) (Some m) (println m) _ (println -1.0))
    (match (index-of (slice ns 0 4) 18) (Some i) (println i) _ (println -1))

    ;; or-else and some?, which are the same family over (Option $t) and take
    ;; no predicate: they move the payload out or read the tag, and neither is
    ;; an operation the variable has to be declared to support.
    ;;
    ;; Both branches at two scalar types, because a default that is returned
    ;; and a default that is discarded are two different lowerings and only one
    ;; of them is exercised by a call that happens to be Some.
    (println (or-else (index-of (slice ns 0 4) 18) -1))   ; the Some branch
    (println (or-else (index-of (slice ns 0 4) 77) -1))   ; the None branch
    (println (or-else (max-of (slice fs 0 3)) 0.0))
    (println (or-else (max-of (slice fs 0 0)) 0.0))
    (println (some? (index-of (slice ns 0 4) 18)))
    (println (some? (index-of (slice ns 0 4) 77)))
    (println (some? (parse-i64 (bytes "12"))))

    ;; And at a $t that owns storage, which is the case the scalars above say
    ;; nothing about. What comes back is a *header* onto one of the two
    ;; buffers, so both are still the caller's to free — hence two frees and
    ;; not one, and the lengths are what say which header each answer holds.
    (let [full (vec-new u8)
          empty (vec-new u8)]
      (push full 65)
      (push full 66)
      (println (len (or-else (Some full) empty)))   ; 2, full's header
      (println (len (or-else (none-vec) empty)))    ; 0, empty's
      (free full)
      (free empty))

    (println (widen 3 0.0))
    (println (widen 3 (i64 0)))
    (println (zero-of 9))

    ;; One written body, two key types, two emitted copies.
    (println (bump 7 10))
    (println (bump "key" 3))

    (let [a (arena-new 4096)
          keep (filter (slice ns 0 4) (fn [x] (> x 5)))
          one (one-of 4.5)]
      (println (len (as-slice keep)))
      (println (at (as-slice one) 0))
      (free one)
      (free keep)
      (free-all a))))