116 lines
4.4 KiB
Plaintext
116 lines
4.4 KiB
Plaintext
;;;; A dyn value where typed code wrote a str, a slice, a fixed array or a
|
|
;;;; struct. Mode 0 is the survey; the others are one trap each, since a trap
|
|
;;;; ends the process. test_acceptance.ml runs it on both backends and under
|
|
;;;; --dev, where mode 8 (a view of a returned call's local) traps as well.
|
|
|
|
(declare gc-collect [] () "flan_gc_collect")
|
|
(declare gc-count [] i64 "flan_gc_count")
|
|
|
|
(defstruct Point [x f64 y i32])
|
|
(defstruct Named [name str id u32])
|
|
(defclass pt [x y])
|
|
|
|
;; Unannotated parameters and returns are dyn.
|
|
(defn keep [d] dyn d)
|
|
(defn text-of [d] dyn (slice d 0 5))
|
|
|
|
(defn shout [s str] () (println s))
|
|
(defn keep-str [s str] str s)
|
|
;; The text crosses in this frame, whose dyn slots are gone once it returns.
|
|
(defn fetch [] str (keep-str (text-of (keep "pinned text"))))
|
|
(defn sum [xs [const i64]] i64
|
|
(let [t (i64 0)]
|
|
(dotimes [i (length xs)] (set t (+ t (at xs i))))
|
|
t))
|
|
(defn bump [xs [i64]] ()
|
|
(dotimes [i (length xs)] (set (at xs i) (+ (at xs i) 100))))
|
|
(defn sumf [xs [const f64]] f64
|
|
(let [t 0.0]
|
|
(dotimes [i (length xs)] (set t (+ t (at xs i))))
|
|
t))
|
|
(defn bytes-sum [xs [const u8]] i64
|
|
(let [t (i64 0)]
|
|
(dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
|
|
t))
|
|
(defn names [xs [const str]] ()
|
|
(dotimes [i (length xs)] (println (at xs i))))
|
|
(defn words [xs [const [const u8]]] i64 (length (at xs 1)))
|
|
(defn triple [a [3 i64]] i64 (+ (at a 0) (at a 2)))
|
|
(defn grid [g [2 [2 i32]]] i32 (at g 1 0))
|
|
(defn px [p Point] f64 (+ (.x p) (f64 (.y p))))
|
|
(defn named [n Named] () (println (.name n) (.id n)))
|
|
(defn f64s [xs [f64]] () (println (length xs)))
|
|
(defn raw [xs [u8]] () (println (length xs)))
|
|
|
|
;; A view of a local, kept past the call that owns the local.
|
|
(defonce held dyn nil)
|
|
(defn leak-local [] ()
|
|
(let [a [(i64 1) 2 3]]
|
|
(set held (keep a))))
|
|
|
|
(defn main [args [str]] i32
|
|
(let [n (i32 (bytes->i64 (bytes-view (at args 1))))]
|
|
(cond
|
|
(= n 0)
|
|
(do
|
|
;; A text becomes a str.
|
|
(shout (keep "hello"))
|
|
(println (length (keep-str (keep "four"))))
|
|
;; A str kept past its crossing, the text reachable only through
|
|
;; the pin, while collections run and the heap is refilled.
|
|
(let [s (fetch)]
|
|
(gc-collect)
|
|
(dotimes [i 20000] (text-of (keep "XXXXXXXXXX")))
|
|
(gc-collect)
|
|
(dotimes [i 20000] (text-of (keep "XXXXXXXXXX")))
|
|
(println s))
|
|
;; A pin ends at free-temp: a thousand crossed texts are collected.
|
|
(free-temp)
|
|
(gc-collect)
|
|
(let [before (gc-count)]
|
|
(dotimes [i 1000] (keep-str (text-of (keep "abcdefgh"))))
|
|
(free-temp)
|
|
(gc-collect)
|
|
(println (< (- (gc-count) before) 100)))
|
|
;; A view of typed storage comes back as that storage.
|
|
(let [a [(i64 1) 2 3]]
|
|
(bump (keep a))
|
|
(println a)
|
|
(println (sum (keep a))))
|
|
(let [v (vec-new i64)]
|
|
(push v 5) (push v 6)
|
|
(bump (keep v))
|
|
(println (at v 0) (at v 1))
|
|
(free v))
|
|
;; A plain dyn vec is a checked copy for a [const T].
|
|
(println (sum (the dyn [1 2 3 4])))
|
|
(println (sumf (the dyn [1 2.5])))
|
|
(println (bytes-sum (the dyn [1 2 255])))
|
|
(println (bytes-sum (keep "AB")))
|
|
(names (the dyn ["ada" "bo"]))
|
|
(println (words (the dyn ["x" "yyy"])))
|
|
;; A view of other elements too.
|
|
(let [b [(i32 7) 8]]
|
|
(println (sum (keep b))))
|
|
;; A fixed array and a struct are values: a copy either way.
|
|
(println (triple (the dyn [10 20 30])))
|
|
(let [a [(i64 4) 5 6]] (println (triple (keep a))))
|
|
(println (grid (the dyn [[1 2] [3 4]])))
|
|
(println (px (the dyn {:x 1.5 :y 2})))
|
|
(println (px (pt 2.5 3)))
|
|
(let [p (Point {.x 0.25 .y 4})] (println (px (keep p))))
|
|
(named (the dyn {:name "cy" :id 9}))
|
|
0)
|
|
(= n 1) (do (println (sum (the dyn [1 "a" 3]))) 0)
|
|
(= n 2) (do (bump (the dyn [1 2])) 0)
|
|
(= n 3) (do (println (sum (keep "abc"))) 0)
|
|
(= n 4) (do (println (bytes-sum (the dyn [1 300]))) 0)
|
|
(= n 5) (do (println (triple (the dyn [1 2]))) 0)
|
|
(= n 6) (do (println (px (the dyn {:x 1.5}))) 0)
|
|
(= n 7) (do (shout (keep 5)) 0)
|
|
(= n 8) (do (leak-local) (bump held) 0)
|
|
(= n 9) (do (raw (keep "abc")) 0)
|
|
(= n 10) (let [a [(f32 1) 2]] (f64s (keep a)) 0)
|
|
(= n 11) (do (println (px (the dyn {:x 1.5 :y "no"}))) 0)
|
|
:else 1)))
|