Joseph Ferano
26c53e0a19
The mechanical half, ahead of the parser change that needs it. tools/unit-return.py
fills the empty slot with () and rewrites Unit as () wherever a type is spelled --
(Fn [i32] Unit), (Map i32 Unit), a return type written out.
Deciding whether a defn already had a return type is the whole difficulty, and
the script does it the way parse.ml did: is_type_form is transcribed rather than
improved, because being identical to the parser it replaces is what makes the
sweep meaning-preserving. It is re-runnable, so the lanes that branched before
this can have the same pass at merge:
python3 tools/unit-return.py .
python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \
test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el
python3 tools/unit-return.py --raw-ml lib/prelude.ml
python3 tools/unit-return.py --in-html web/index.html
-v logs every defn it saw and what it decided, which is how a sweep of 440 sites
gets reviewed at all. Embedded modes pool a file's type declarations across all
its fragments, because a snippet split across concatenation -- decls ^ "(defn f
[s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled
names count only in bare-symbol position, for the same reason the prelude's do.
A fragment that cuts off mid-form is skipped rather than guessed at. Five sites
in test_flan.ml still needed a hand, and they are in this commit.
Two things ride along because the sweep needs them: parse.ml reads a lone () as
the return type of a function with no body, which was not a shape the old
optional slot could produce; and the map refusals name () rather than Unit, since
that is now the spelling a caller wrote.
110 lines
3.5 KiB
Plaintext
110 lines
3.5 KiB
Plaintext
;; Walking a map, which is what flan_map_next exists for. Every other map
|
|
;; operation addresses one entry by hashing it; this is the only thing that
|
|
;; reads the block in order.
|
|
;;
|
|
;; Block order is the hash's order and not the insertion's, so nothing here
|
|
;; may depend on which entry comes first: the checks are a sum, a count and a
|
|
;; membership test, all of them order-free. That is not a weakness of the test,
|
|
;; it is the contract — a caller that wants an order sorts what it collected.
|
|
|
|
(defn sum-and-count [] ()
|
|
(let [m (map-new i32 i32)]
|
|
(put m 1 10)
|
|
(put m 2 20)
|
|
(put m 3 30)
|
|
(put m 4 40)
|
|
(let [cur (i64 0)
|
|
k 0
|
|
v 0
|
|
keys 0
|
|
vals 0
|
|
n 0]
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set keys (+ keys k))
|
|
(set vals (+ vals v))
|
|
(set n (+ n 1)))
|
|
(print n) (print " ") (print keys) (print " ") (print vals) (println ""))
|
|
(free m)))
|
|
|
|
;; A map that never allocated has no block at all, and one that allocated and
|
|
;; holds nothing has a block of nothing but zeroed hashes. Both walk zero
|
|
;; times, and they are different code paths to get there.
|
|
(defn the-empty-cases [] ()
|
|
(let [m (map-new i32 i32)
|
|
cur (i64 0)
|
|
k 0
|
|
v 0
|
|
n 0]
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set n (+ n 1)))
|
|
(print "never allocated: ") (print n) (println "")
|
|
(reserve m 64)
|
|
(set cur (i64 0))
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set n (+ n 1)))
|
|
(print "allocated and empty: ") (print n) (println "")
|
|
(free m)))
|
|
|
|
;; A cursor left past the end keeps answering false rather than wrapping, so a
|
|
;; second loop over a spent cursor is empty and not a repeat.
|
|
(defn a-spent-cursor [] ()
|
|
(let [m (map-new i32 i32)]
|
|
(put m 5 50)
|
|
(put m 6 60)
|
|
(let [cur (i64 0) k 0 v 0 n 0]
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set n (+ n 1)))
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set n (+ n 1)))
|
|
(print "spent: ") (print n) (println ""))
|
|
(free m)))
|
|
|
|
;; A string key and a struct value: the key run and the value run have
|
|
;; different element sizes and different cell packing, so this is the case that
|
|
;; would catch the two runs being indexed with one geometry.
|
|
(defstruct Point [x i32 y i32])
|
|
|
|
(defn wider-entries [] ()
|
|
(let [m (map-new string Point)]
|
|
(put m "a" (Point {.x 1 .y 2}))
|
|
(put m "bb" (Point {.x 3 .y 4}))
|
|
(put m "ccc" (Point {.x 5 .y 6}))
|
|
(let [cur (i64 0)
|
|
k ""
|
|
v (Point {})
|
|
chars 0
|
|
xs 0
|
|
ys 0]
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set chars (+ chars (len k)))
|
|
(set xs (+ xs (.x v)))
|
|
(set ys (+ ys (.y v))))
|
|
(print chars) (print " ") (print xs) (print " ") (print ys) (println ""))
|
|
(free m)))
|
|
|
|
;; Growth past the 75% threshold rehashes into a new block, so this walks a map
|
|
;; whose layout is nothing like its insertion order and at a capacity several
|
|
;; doublings past the minimum.
|
|
(defn after-growth [] ()
|
|
(let [m (map-new i64 i64)]
|
|
(dotimes [i 500]
|
|
(put m (i64 i) (* (i64 i) 2)))
|
|
(let [cur (i64 0)
|
|
k (i64 0)
|
|
v (i64 0)
|
|
n 0
|
|
doubled 0]
|
|
(while (map-next! m (addr cur) (addr k) (addr v))
|
|
(set n (+ n 1))
|
|
(when (= v (* k 2)) (set doubled (+ doubled 1))))
|
|
(print n) (print " ") (print doubled) (print " ") (print (len m)) (println ""))
|
|
(free m)))
|
|
|
|
(defn main [] i32
|
|
(sum-and-count)
|
|
(the-empty-cases)
|
|
(a-spent-cursor)
|
|
(wider-entries)
|
|
(after-growth)
|
|
0)
|