flan/test/programs/int-generic.flan

;;;; is-integer, end to end: the bound is-numeric was one type too wide for.
;;;;
;;;; Three families in here, in order. The collapsed abs — one written body
;;;; under {:where (is-integer $t)} where abs-i32 and abs-i64 used to be, pinned
;;;; at six widths, at both signed minimums (the answer is itself, because the
;;;; negation wraps — what every two's-complement abs does), and beside the
;;;; libm float pair it deliberately does not shadow: (abs-f64 -0.0) is 0
;;;; because fabs clears the sign bit, which no integer body spells. Then the
;;;; operations only is-integer admits in a generic body — bit-and, bit-or,
;;;; bit-xor, the shifts, and % — at several widths each. Then the join:
;;;; mixed widths at one $t resolve to the wider type in either argument
;;;; order (TODO.org, "abs is one generic, and a bound joins to the wider
;;;; type"), so both orders print the same number from the same copy.

(defonce i32min i32 -2147483648)
(defonce i64min i64 -9223372036854775808)

;; The low n bits, which needs a shift, a bit-and and the literal 1 — every
;; one of them admitted by is-integer and none by anything weaker.
(defn low-bits [x $t  n $t] $t
  {:where (is-integer $t)}
  (bit-and x (- (<< 1 n) 1)))

;; Truncated %, the semantics everywhere in the language, in a generic body.
(defn is-even [x $t] bool
  {:where (is-integer $t)}
  (= (% x 2) 0))

;; xor and or, and the shift right.
(defn toggle [x $t  m $t] $t
  {:where (is-integer $t)}
  (bit-xor x m))

(defn with-flag [x $t  f $t] $t
  {:where (is-integer $t)}
  (bit-or x f))

(defn halve [x $t] $t
  {:where (is-integer $t)}
  (>> x 1))

;; The untyped literal at a bounded variable: admitted under is-integer by the
;; same arm that admits it under is-numeric, ranged per copy.
(defn plus-300 [x $t] $t
  {:where (is-integer $t)}
  (+ x 300))

;; The join family. is-eq2 is the pair the refusal used to be pinned on.
(defn is-eq2 [a $t  b $t] bool
  {:where (is-equal $t)}
  (= a b))

(defn tri [a $t  b $t  c $t] $t
  {:where (is-numeric $t)}
  (+ a (+ b c)))

;; ── Conversions under a bound ──────────────────────────────────────────
;; A cast asks whether its operand is a number, and inside a generic body no
;; type is there to answer. The bound answers instead, for every copy at
;; once: is-integer admits only integer kinds and every one of them converts,
;; so the body is checked once here and the conversion is the ordinary one in
;; each copy. This is the shape the bug report was written against — a sum
;; that narrows each element to the i32 it accumulates in.
(defn total [xs [$t]] i32
  {:where (is-integer $t)}
  (let [acc 0]
    (dotimes [i (length xs)] (set acc (+ acc (i32 (at xs i)))))
    acc))

;; The same rule widening. i64 → f64 rounds above 2^53 and i32 → f64 does
;; not, and neither is refused when the type is written out, so neither is
;; refused under the bound: a conversion is not a claim that the value
;; survives, it is the claim that the operand is a number.
(defn mean [xs [$t]] f64
  {:where (is-integer $t)}
  (let [sum 0.0]
    (dotimes [i (length xs)] (set sum (+ sum (f64 (at xs i)))))
    (/ sum (f64 (length xs)))))

;; is-numeric is the weaker bound and narrowing is legal under it too, because
;; it is legal at every type it admits: (i32 x) on a written f64 truncates
;; towards zero, and that is what the f32 copy of this does.
(defn truncate [x $t] i32
  {:where (is-numeric $t)}
  (i32 x))

;; The other direction, which is where the two bounds part company. An enum
;; is an i32 and a float has no enum reading, so this one needs is-integer
;; exactly — is-numeric would admit an f64 copy the concrete arm refuses.
(defenum Step [back -1  stay 0  forward 1])

(defn step-of [n $t] Step
  {:where (is-integer $t)}
  (Step n))

(defn main [] ()
  ;; abs, one body, six widths.
  (println (abs (i8 -7)))
  (println (abs -7))
  (println (abs (i64 -7)))
  (println (abs (u8 7)))
  (println (abs (u32 7)))
  (println (abs (u64 7)))
  ;; The signed minimums answer themselves: the negation wraps, and saturating
  ;; quietly would be the wrong answer this file exists to refuse.
  (println (abs i32min))
  (println (abs i64min))
  ;; The float abs stays libm's: a sign-bit clear, so -0.0 comes back 0.
  (println (abs-f64 -0.0))
  (println (abs-f32 -0.0))
  (println (abs-f64 -1.5))
  (println (abs-f32 -2.5))

  ;; The is-integer-only operations, per width.
  (println (low-bits 255 3))
  (println (low-bits (u16 65535) (u16 4)))
  (println (low-bits (i64 1023) (i64 5)))
  (println (is-even 4))
  (println (is-even (u8 3)))
  (println (is-even (i64 -2)))
  (println (toggle (u8 255) (u8 15)))
  (println (with-flag 8 1))
  (println (halve (u64 10)))
  (println (halve (i64 -4)))
  (println (plus-300 1))
  (println (plus-300 (i64 1)))

  ;; The join: both orders, one copy, one answer.
  (let [a (i8 3)
        b (i64 3)]
    (println (is-eq2 a b))
    (println (is-eq2 b a)))
  (let [x (u32 1)
        y (i32 2)
        z (i64 3)]
    ;; u32 and i32 meet at no type of their own; all three meet at the i64,
    ;; wherever it stands in the argument list.
    (println (tri x y z))
    (println (tri z y x)))
  ;; A literal beside a wider variable joins too: 4 arrives as an i32 and the
  ;; copy is i64's.
  (let [w (i64 38)]
    (println (tri w 3 1)))
  ;; And the one direction a container-bound variable does admit: the slice
  ;; fixed $t at i32 exactly, and a narrower scalar widens *into* that — the
  ;; same conversion a monomorphic i32 parameter would apply. (The reverse,
  ;; an i64 scalar against this slice, stays refused; the checker pins it.)
  (let [ns [5 3 9 1]]
    (match (index-of (slice ns 0 4) (i16 9))
      (Some i) (println i)
      _ (println -1)))

  ;; The conversions, generic and concrete side by side. Each pair is one
  ;; conversion written twice — once at a bounded variable and once at the
  ;; type a copy is made at — and the two answer the same number, which is
  ;; the whole claim the bound makes.
  (let [small [5 3 9 1]
        wide  [(i64 5) (i64 3) (i64 9) (i64 1)]]
    (println (total (slice small 0 4)))
    (println (total (slice wide 0 4)))
    (println (mean (slice small 0 4)))
    (println (mean (slice wide 0 4))))
  (println (truncate (i64 9)))
  (println (truncate 2.75))
  (println (truncate -2.75))
  (println (i32 2.75))
  (println (step-of 1))
  (println (step-of (u8 0)))
  (println (i32 (step-of (i64 -1)))))