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,
;;;; and the collapsed prelude family the whole feature was for.

;; 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))

;; (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! (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))
    (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))))