flan/lib/prelude.ml

(** The milestone-2 prelude, written in Flan.

    Printing is deliberately *not* a primitive (plan.org, Milestone-2
    primitives): [write-stdout] is the one output primitive and everything
    above it is Flan. That is what keeps a second backend cheap — a primitive
    is the only thing implemented twice.

    It lives here as a string rather than as a file because there is no package
    loader yet; at milestone 3 it becomes an ordinary [core:] package and this
    module goes away. The acceptance programs may call anything defined here.

    No overloading: [print-f64] and [print-str] name the type, because
    compile-time overloading before the checker is stable is how a small
    language stops being one. A single [println] is milestone 5. *)

let source = {flan|
(defn print-bytes [b [u8]]
  (write-stdout b))

(defn print-str [s string]
  (write-stdout (bytes s)))

(defn print-f64 [x f64]
  (write-stdout (f64->bytes x)))

(defn print-i64 [x i64]
  (write-stdout (i64->bytes x)))

(defn newline []
  (write-stdout (bytes "\n")))

;; A seeded PRNG in Flan rather than libc's, because a grid hash is only a
;; regression test if the sequence is byte-identical on native and wasm32
;; (plan.org, RNG is ours). PCG-XSH-RR 32: one u64 LCG step per draw, folded
;; down to 32 bits by an xorshift and rotated by the state's top five bits.
(defvar rand-state u64 6364136223846793005)

(defn rand-seed [seed u64]
  (set rand-state (+ (* seed 6364136223846793005) 1442695040888963407)))

(defn rand-u32 [] u32
  (let [s rand-state]
    (set rand-state (+ (* s 6364136223846793005) 1442695040888963407))
    ;; The rotate is masked to 5 bits: a 32-bit shift by 32 is poison in LLVM,
    ;; and r = 0 is the case that would ask for it.
    (let [x (u32 (>> (bit-xor (>> s 18) s) 27))
          r (u32 (>> s 59))]
      (bit-or (>> x r) (<< x (bit-and (- 32 r) 31))))))

;; In [0, 1). The divisor is 2^32 exactly, so the result never reaches 1.0.
(defn rand-f32 [] f32
  (/ (f32 (rand-u32)) 4294967296.0))

;; Prints s and then a newline. Takes a string, not an Option or an any —
;; there is nothing to dispatch on yet.
(defn print-line [s string]
  (print-str s)
  (newline))

;; ── Slice algorithms, all in place ────────────────────────────────────
;;
;; Over [i32] and nothing else. There are no generics, so one of these per
;; element type is one *copy* per element type, emitted into every program;
;; i32 is the type indices, ids and tile values already have, and f32 copies
;; wait until a program actually wants them.
;;
;; A slice is ptr+len and non-owning, so these mutate the storage they were
;; handed: sorting (slice grid 4 9) sorts those five elements of grid and
;; leaves the rest alone. That is the whole reason the shape is in-place —
;; there is no allocator to return a new sequence from.

(defn swap-i32! [s [i32]  i i32  j i32]
  (let [t (at s i)]
    (set (at s i) (at s j))
    (set (at s j) t)))

(defn reverse-i32! [s [i32]]
  (let [i 0
        j (- (len s) 1)]
    (while (< i j)
      (swap-i32! s i j)
      (set i (+ i 1))
      (set j (- j 1)))))

;; Insertion sort: in place, no recursion, no auxiliary array and no
;; comparison function — quicksort would want a stack and mergesort a buffer,
;; and neither exists. Ascending, and stable, though with no payload type to
;; carry that is not yet observable.
(defn sort-i32! [s [i32]]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        ;; `and` short-circuits, which is load-bearing: at j = 0 the left test
        ;; fails and (at s -1) is never evaluated, so this does not trap.
        (while (and (> j 0) (> (at s (- j 1)) (at s j)))
          (swap-i32! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

;; The first index holding x. None rather than -1, because Option is what the
;; language has and a sentinel index is the bug this avoids.
(defn index-of-i32 [s [i32]  x i32] (Option i32)
  (dotimes [i (len s)]
    (when (= (at s i) x)
      (return (Some i))))
  None)

;; None for an empty slice: there is no least i32 that is also an honest
;; answer, and returning one would be a value the caller cannot tell from a
;; real element.
(defn min-i32 [s [i32]] (Option i32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (min m (at s i))))
      (Some m))))

(defn max-i32 [s [i32]] (Option i32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (max m (at s i))))
      (Some m))))

;; Accumulates in i64 and each element is widened explicitly — there is no
;; implicit widening anywhere in the language, and summing a screenful of i32
;; into an i32 is how a total silently wraps.
(defn sum-i32 [s [i32]] i64
  (let [t (i64 0)]
    (dotimes [i (len s)]
      (set t (+ t (i64 (at s i)))))
    t))
|flan}

let file = "<prelude>"

let forms () = Reader.read_all ~file source