flan/spike/generics/prelude-shapes.flan

52 lines
1.3 KiB
Plaintext

;; Which of prelude.ml's per-type families collapse as they are written, and
;; which need their signature changed. Nothing here is installed in the
;; prelude; it is the same bodies, over $t, checked and run.
(defn keep [s [$t] keep? (Fn [$t] bool)] (Vec $t)
(let [v (vec-new t)]
(dotimes [i (len s)]
(when (keep? (at s i))
(push v (at s i))))
v))
(defn apply! [s [$t] f (Fn [$t] $t)] ()
(dotimes [i (len s)]
(set (at s i) (f (at s i)))))
(defn fold [s [$t] init $t f (Fn [$t $t] $t)] t
(let [acc init]
(dotimes [i (len s)]
(set acc (f acc (at s i))))
acc))
(defn flip! [s [$t]] ()
(let [i 0
j (- (len s) 1)]
(while (< i j)
(let [tmp (at s i)]
(set (at s i) (at s j))
(set (at s j) tmp))
(set i (+ i 1))
(set j (- j 1)))))
(defvar ns [5 i32])
(defvar fs [5 f32])
(defn main [] ()
(let [xs (slice ns 0 5)
ys (slice fs 0 5)]
(dotimes [i 5]
(set (at xs i) (+ i 1))
(set (at ys i) (f32 (* 2 (+ i 1)))))
(apply! xs (fn [x] (* x 10)))
(apply! ys (fn [x] (* x (f32 2))))
(flip! xs)
(flip! ys)
(println (fold xs 0 (fn [a b] (+ a b))))
(println (fold ys (f32 0) (fn [a b] (+ a b))))
(let [evens (keep xs (fn [x] (= (% x 20) 0)))]
(println (len evens))
(free evens))
(println (at xs 0))
(println (at ys 0))))