JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Retire the per-type printers, since print says all of it

Browse Source 
print-str, print-i64, print-f64, print-bytes, print-line and newline leave
the prelude. print and println are the whole printing surface now, and print
is the better call at every one of the sites that used them: it is the same
structural walk without the newline, so the no-newline case the family was
kept for is covered, and it takes the value as it is. The old print-i64
forced an explicit (i64 x) at every call site, because this language widens
nothing implicitly; that cast is gone from 127 places.

Dropping it moves one answer. hash-grid returns u64, and the cast through
the signed printer showed sand-headless's hash as -2851001042534928384.
print routes a u64 through flan_u64_to_bytes, so it now prints
15595743031174623232 — the same 64 bits, read as the unsigned number they
are. The pinned expectation follows the correction.

test-flan-dev.el and test_session.ml both reached for print-line as "a name
the prelude has"; they reach for rand-seed instead.
This commit is contained in:
Joseph Ferano 2026-09-12 05:32:25 +07:00
parent b23bd8e377
commit 96ab4c9cf0
47 changed files with 394 additions and 411 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
calc-me.flan
View File

@ -114,12 +114,12 @@
;; Entry point: (defn main [args [string]] i32). Both the parameter and the
;; return type are optional — sand.flan uses the bare (defn main []) form.
;; print-str/print-f64/print-line are Flan functions over the write-stdout
;; primitive, NOT an overloaded println: compile-time overloading waits for
;; milestone 5, so until then the acceptance programs name the type.
;; print and println are compiler-provided and structural: the walk over the
;; argument's concrete type happens at compile time, so there is nothing to
;; dispatch on at run time and no type to name at the call site.
(defn main [args [string]] i32
(if (< (len args) 2)
(do (print-line "usage: calc-me \"1 + 2 * 3\"") 1)
(do (println "usage: calc-me \"1 + 2 * 3\"") 1)
(match (evaluate (bytes (at args 1)))
(Some v) (do (print-f64 v) (print-line "") 0)
None (do (print-line "calc-me: cannot parse") 1))))
(Some v) (do (print v) (println "") 0)
None (do (println "calc-me: cannot parse") 1))))

10
conditions-play.flan
View File

@ -30,16 +30,16 @@
(retry [] 7)))
(defn run-once []
(print-i64 (i64 (fetch 1))) (newline)
(print (fetch 1)) (println "")
(handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))]
(print-i64 (i64 (fetch 2))) (newline))
(print (fetch 2)) (println ""))
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
(print-i64 (i64 (fetch 3))) (newline))
(print (fetch 3)) (println ""))
(print-i64 seen) (newline)
(print-i64 ticks) (newline))
(print seen) (println "")
(print ticks) (println ""))
(defn main [] i32
(agent/start "/tmp/flan-conditions.sock")

6
emacs/test-flan-dev.el
View File

@ -295,7 +295,7 @@ is written instead — the real `message' call the real command makes."
(and raised (string-match-p "ticks" raised)
(string-match-p "no location" raised))))
(let ((raised nil))
(condition-case err (xref-backend-definitions 'flan "print-line")
(condition-case err (xref-backend-definitions 'flan "rand-seed")
(user-error (setq raised (error-message-string err))))
(test-flan--check "M-. into the prelude refuses, saying why"
(and raised (string-match-p "prelude" raised)
@ -317,7 +317,7 @@ is written instead — the real `message' call the real command makes."
;; The program's own output arrives on replies and lands in its buffer, so
;; a long-running program is not writing into a terminal nobody is watching.
(flan-dev--eval "(defn step [] i64 (do (print-line \"HELLO\") ticks))" "form")
(flan-dev--eval "(defn step [] i64 (do (println \"HELLO\") ticks))" "form")
(let ((seen nil) (deadline (+ (float-time) 10)))
(while (and (not seen) (< (float-time) deadline))
(ignore-errors (flan-dev--request '(:op "describe")))
@ -357,7 +357,7 @@ is written instead — the real `message' call the real command makes."
;; is the result of the request, the output rides along with the reply.
;; Showing them in one place would be convenient and wrong.
(goto-char (point-max))
(insert "(print-line \"PRINTED\")")
(insert "(println \"PRINTED\")")
(flan-repl-return)
(let ((deadline (+ (float-time) 15)))
(while (and (not (with-current-buffer flan-dev-output-buffer

53
lib/prelude.ml
View File

@ -9,37 +9,28 @@
loader yet; at milestone 3 it becomes an ordinary [core:] package and this
module goes away. The acceptance programs may call anything defined here.
[println] is not here and is not a function: it is compiler-provided and
structural, a walk over the concrete type at the call site (check.ml, and
the walk itself in render.ml). That is plan.org's Milestone 5 item, and it
needed none of the rest of milestone 5 -- there is nothing to dispatch on
at run time and no user-supplied printer to choose between, so no type
variables are involved. The earlier note here said a single [println] had
to wait for generics; it did not.
No printing function is here at all any more. [print] and [println] are
the whole printing surface, and neither is a function: both are
compiler-provided and structural, a walk over the concrete type at the
call site (check.ml, and the walk itself in render.ml). That is plan.org's
Milestone 5 item, and it needed none of the rest of milestone 5 -- there
is nothing to dispatch on at run time and no user-supplied printer to
choose between, so no type variables are involved. The earlier note here
said a single [println] had to wait for generics; it did not.
The [print-*] functions stay, and not as compatibility. They print without
a newline and name their type at the call site, which is what a loop that
prints elements separated by spaces wants -- see [show] in
test/programs/slices.flan. [println] cannot express that, and [print] is
structural where these are not: [(print-str s)] is the raw bytes, whereas
[(print s)] is the same walk [println] uses. *)
The per-type family that used to live here -- [print-str], [print-i64],
[print-f64], [print-bytes], [print-line], [newline] -- is gone, and [print]
is strictly the better call for every one of them. [print] is the same walk
as [println] without the trailing newline, so it covers the no-newline case
that was the family's remaining excuse (see [show] in
test/programs/slices.flan). And because this language has no implicit
widening, [(print-i64 x)] forced an explicit [(i64 x)] at every site;
[(print x)] takes the value as it is. That is not only shorter: the cast
through the signed printer turned a [u64] above 2^63 into a negative
number, where [print] routes it through [flan_u64_to_bytes] and prints what
it actually holds. *)
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
@ -62,12 +53,6 @@ let source = {flan|
(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

2
lib/render.ml
View File

@ -77,7 +77,7 @@ let rec render c depth (e : Tast.expr) : Tast.expr list =
| Types.Bool ->
[ unit_ (Tast.If (e, lit "true", lit "false")) ]
(* Evaluated *and then* reported. A Unit expression is almost always a call
made for its effect — (print-line "x") is the REPL's most ordinary
made for its effect — (println "x") is the REPL's most ordinary
input — so emitting the literal without running it would make the prompt
answer () while nothing happened. *)
| Types.Unit -> [ e; lit "()" ]

2
lib/session.ml
View File

@ -14,7 +14,7 @@
- **which names the running process was built with.** A name it has is a
symbol the loaded module binds to; a name it lacks goes through the
by-name registry in runtime/flan_dev.c. Getting this wrong is silent:
treating [print-line] as new gives it a registry cell nobody publishes,
treating [rand-seed] as new gives it a registry cell nobody publishes,
and the first call jumps to null. It has to come from the *checked*
program, because [Check.program] prepends the prelude and no accumulated
AST contains it.

6
sand.flan
View File

@ -172,7 +172,7 @@
(set brush (rl/load-texture "brush.png"))
(set brush-ok (rl/texture-valid? brush))
(unless brush-ok
(print-line "sand: cannot load brush.png — drawing the cursor is off"))
(println "sand: cannot load brush.png — drawing the cursor is off"))
;; The other route to a texture: the file into RAM, changed there, and only
;; then uploaded. An Image that failed to load has a null buffer and
;; unloading it is still safe, so there is one unload and not two.
@ -255,7 +255,7 @@
(rl/init-audio-device)
(set audio-ok (rl/audio-device-ready?))
(unless audio-ok
(print-line "sand: no audio device — the grains are silent"))
(println "sand: no audio device — the grains are silent"))
(build-tone 40)
(let [w (rl/Wave {:frame-count (u32 tone-frames) :sample-rate (u32 tone-rate)
:sample-size 16 :channels 1
@ -319,7 +319,7 @@
(set scene (rl/load-render-texture screen-width screen-height))
(set scene-ok (rl/render-texture-valid? scene))
(unless scene-ok
(print-line "sand: no render texture — drawing straight to the screen")))
(println "sand: no render texture — drawing straight to the screen")))
;; ── The font ────────────────────────────────────────────────────────
;;

10
test/programs/agent.flan
View File

@ -21,14 +21,14 @@
(defn main [args [string]] i32
(if (< (len args) 2)
(do (print-line "usage: agent <socket>") 2)
(do (println "usage: agent <socket>") 2)
(do
(if (< (agent/start (at args 1)) 0)
(do (print-line "cannot listen") 1)
(do (println "cannot listen") 1)
(do
(print-i64 (tick)) (newline)
(print (tick)) (println "")
(while (= (agent/wait 100) 0) 0)
(print-i64 (tick)) (newline)
(print (tick)) (println "")
(while (= (agent/wait 100) 0) 0)
(print-i64 (tick)) (newline)
(print (tick)) (println "")
0)))))

20
test/programs/bounds.flan
View File

@ -13,19 +13,19 @@
(cond
;; In bounds, including both edges: the last index, and a slice that
;; ends exactly at len. Neither may trap.
(= n 0) (do (print-i64 (i64 (at arr 2)))
(print-bytes (slice s 1 5))
(print-bytes (slice s 5 5)) ; empty at len is legal
(newline))
(= n 0) (do (print (at arr 2))
(print (slice s 1 5))
(print (slice s 5 5)) ; empty at len is legal
(println ""))
(= n 3) (print-i64 (i64 (at arr n))) ; past the end of a fixed array
(= n -1) (print-i64 (i64 (at arr n))) ; negative index
(= n 9) (print-i64 (i64 (at s n))) ; past the end of a slice
(= n 3) (print (at arr n)) ; past the end of a fixed array
(= n -1) (print (at arr n)) ; negative index
(= n 9) (print (at s n)) ; past the end of a slice
;; The write path lowers through place/Pindex rather than through At, so
;; it is checked separately even though the message is the same.
(= n 7) (set (at arr n) 1) ; write past the end
(= n 4) (print-bytes (slice s n 9)) ; hi past the end
(= n 2) (print-bytes (slice s n 1)) ; reversed range
(= n 4) (print (slice s n 9)) ; hi past the end
(= n 2) (print (slice s n 1)) ; reversed range
:else (print-line "?"))
:else (println "?"))
0))

6
test/programs/break.flan
View File

@ -28,7 +28,7 @@
(defn main [] i32
(agent/start "/tmp/flan-break.sock")
(print-i64 (i64 (fetch 1))) (newline)
(print-i64 (i64 (fetch 2))) (newline)
(print-i64 (i64 (shadowed 3))) (newline)
(print (fetch 1)) (println "")
(print (fetch 2)) (println "")
(print (shadowed 3)) (println "")
0)

72
test/programs/bytes2.flan
View File

@ -12,19 +12,19 @@
;;;; "1e", " 1", "0x10" and "nan". Each must be None.
(defn show-idx [o (Option i32)]
(print-i64 (i64 (match o (Some i) i None -1)))
(print-str " "))
(print (match o (Some i) i None -1))
(print " "))
(defn show-bool [b bool]
(print-str (if b "t" "f")))
(print (if b "t" "f")))
;; Brackets around the result so an empty trim is visible as [] rather than
;; as nothing at all — the all-whitespace case is otherwise indistinguishable
;; from a trim that printed the wrong slice of length zero.
(defn show-trim [s string]
(print-str "[")
(print-bytes (trim (bytes s)))
(print-str "]"))
(print "[")
(print (trim (bytes s)))
(print "]"))
(defn main [] i32
(show-idx (index-of-bytes (bytes "hello world") (bytes "world"))) ; 6, at the end
@ -32,14 +32,14 @@
(show-idx (index-of-bytes (bytes "hello world") (bytes "o w"))) ; 4, in the middle
(show-idx (index-of-bytes (bytes "banana") (bytes "na"))) ; 2, first of two
(show-idx (index-of-bytes (bytes "aaab") (bytes "aab"))) ; 1, after false starts
(newline)
(println "")
(show-idx (index-of-bytes (bytes "hello") (bytes "hellp"))) ; -1, last byte differs
(show-idx (index-of-bytes (bytes "hi") (bytes "hiya"))) ; -1, longer, no trap
(show-idx (index-of-bytes (bytes "") (bytes "a"))) ; -1, empty haystack
(show-idx (index-of-bytes (bytes "hello") (bytes ""))) ; 0, empty needle
(show-idx (index-of-bytes (bytes "") (bytes ""))) ; 0, both empty
(show-idx (index-of-bytes (bytes "hello") (bytes "hello"))) ; 0, whole string
(newline)
(println "")
(show-trim " hi ") ; [hi]
(show-trim "hi") ; [hi] nothing to remove
@ -49,47 +49,47 @@
(show-trim " a b ") ; [a b] the inner space survives
(show-trim " x") ; [x] one-sided
(show-trim "x ") ; [x]
(newline)
(println "")
(show-bool (digit? \0)) (show-bool (digit? \9)) (show-bool (digit? \/))
(show-bool (digit? \:)) (show-bool (digit? \a))
(newline)
(println "")
(show-bool (space? \space)) (show-bool (space? \tab))
(show-bool (space? \newline)) (show-bool (space? \return))
(show-bool (space? \a)) (show-bool (space? \0))
(newline)
(println "")
;; Accepted. The last is the round trip through %g that proves the value and
;; not merely the acceptance is right.
(print-f64 (match (parse-f64 (bytes "0")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "3.5")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "-3.5")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "+0.25")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1e3")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1.5E-2")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "12")) (Some v) v None -999.0))
(newline)
(print (match (parse-f64 (bytes "0")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "3.5")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "-3.5")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "+0.25")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1e3")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1.5E-2")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "12")) (Some v) v None -999.0))
(println "")
;; Refused. Every one of these is a number out of strtod, which is the point.
(print-f64 (match (parse-f64 (bytes "")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "abc")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1x")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes ".")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1e")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1e+")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes " 1")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "1 ")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "0x10")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "nan")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes "+")) (Some v) v None -999.0))
(newline)
(print (match (parse-f64 (bytes "")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "abc")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1x")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes ".")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1e")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1e+")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes " 1")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "1 ")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "0x10")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "nan")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes "+")) (Some v) v None -999.0))
(println "")
;; A trailing dot with no fraction is a C float literal and is accepted; a
;; leading one is too. Both are here because they are the boundary the
;; digit counter, not the position, decides.
(print-f64 (match (parse-f64 (bytes "1.")) (Some v) v None -999.0)) (print-str " ")
(print-f64 (match (parse-f64 (bytes ".5")) (Some v) v None -999.0))
(newline)
(print (match (parse-f64 (bytes "1.")) (Some v) v None -999.0)) (print " ")
(print (match (parse-f64 (bytes ".5")) (Some v) v None -999.0))
(println "")
;; Parsing a trimmed field, which is why both exist.
(print-f64 (match (parse-f64 (trim (bytes " 2.25 "))) (Some v) v None -999.0))
(newline)
(print (match (parse-f64 (trim (bytes " 2.25 "))) (Some v) v None -999.0))
(println "")
0)

14
test/programs/cleanup.flan
View File

@ -45,17 +45,17 @@
(stop [] 5)))
(defn main [] i32
(print-i64 (early)) (newline) ; 7
(print-i64 order) (newline) ; 21 — innermost first, both ran
(print (early)) (println "") ; 7
(print order) (println "") ; 21 — innermost first, both ran
(print-i64 (i64 (leaky))) (newline) ; 42
(print (leaky)) (println "") ; 42
;; The handler stack must be empty again. If a frame leaked, this signal
;; reaches it and seen moves.
(deep)
(print-i64 seen) (newline) ; 0
(print seen) (println "") ; 0
(set seen 0)
(print-i64 (i64 (nested))) (newline) ; 5
(print-i64 seen) (newline) ; 0 — the outer handler did not run
(print-i64 log) (newline) ; 0
(print (nested)) (println "") ; 5
(print seen) (println "") ; 0 — the outer handler did not run
(print log) (println "") ; 0
0)

12
test/programs/conditions.flan
View File

@ -20,26 +20,26 @@
(defn main [] i32
;; No handler: a no-op, not an abort and not a message (§2).
(load-all)
(print-i64 seen) (newline) ; 0
(print seen) (println "") ; 0
(handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))]
(load-all))
(print-i64 seen) (newline) ; 1 + 2 = 3
(print seen) (println "") ; 1 + 2 = 3
;; Two clauses, and only the matching one runs for each condition.
(handler-bind [(AssetMissing [c] (set seen (+ seen 10)))
(Corrupt [c] (set other (+ other (i64 (.id c)))))]
(load-all))
(print-i64 seen) (newline) ; 3 + 20 = 23
(print-i64 other) (newline) ; 3
(print seen) (println "") ; 3 + 20 = 23
(print other) (println "") ; 3
;; Nesting: the inner frame does not displace the outer one, so both run.
(handler-bind [(Corrupt [c] (set other (+ other 100)))]
(handler-bind [(Corrupt [c] (set other (+ other 1000)))]
(signal (Corrupt {:id 0}))))
(print-i64 other) (newline) ; 3 + 1000 + 100 = 1103
(print other) (println "") ; 3 + 1000 + 100 = 1103
;; And the stack is back to what it was: no handler, no effect.
(load-all)
(print-i64 other) (newline) ; 1103
(print other) (println "") ; 1103
0)

8
test/programs/debug-permuted.flan
View File

@ -18,8 +18,8 @@
(defn main [] i32
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
(let [r (tick (addr c) 41)]
(print-i64 (i64 r)) (newline)
(print-f64 (.heat c)) (newline)
(print-i64 (i64 (.id c))) (newline)
(print-str (.name c)) (newline)
(print r) (println "")
(print (.heat c)) (println "")
(print (.id c)) (println "")
(print (.name c)) (println "")
0)))

8
test/programs/debug.flan
View File

@ -23,8 +23,8 @@
(defn main [] i32
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
(let [r (tick (addr c) 41)]
(print-i64 (i64 r)) (newline)
(print-f64 (.heat c)) (newline)
(print-i64 (i64 (.id c))) (newline)
(print-str (.name c)) (newline)
(print r) (println "")
(print (.heat c)) (println "")
(print (.id c)) (println "")
(print (.name c)) (println "")
0)))

54
test/programs/destructure.flan
View File

@ -23,12 +23,12 @@
(Point {:x 3 :y 4}))
(defn show2 [label string a i32 b i32]
(print-str label)
(print-str " ")
(print-i64 (i64 a))
(print-str " ")
(print-i64 (i64 b))
(newline))
(print label)
(print " ")
(print a)
(print " ")
(print b)
(println ""))
(defn main [] i32
;; :keys, the common case: one name per field, spelled as the field is.
@ -57,28 +57,28 @@
;; so [a b] over a [3 i32] is a compile error and not a silent prefix.
(let [xs [11 22 33]
[a b c] xs]
(print-str "array ")
(print-i64 (i64 a)) (print-str " ")
(print-i64 (i64 b)) (print-str " ")
(print-i64 (i64 c)) (newline))
(print "array ")
(print a) (print " ")
(print b) (print " ")
(print c) (println ""))
;; & rest is the tail as a slice, which is an ordinary (slice xs n (len xs))
;; over a local — nothing new, and nothing that outlives the array.
(let [xs [1 2 3 4 5]
[head & tail] xs]
(print-str "rest ")
(print-i64 (i64 head)) (print-str " ")
(print-i64 (i64 (len tail))) (print-str " ")
(print-i64 (i64 (at tail 0))) (print-str " ")
(print-i64 (i64 (at tail 3))) (newline))
(print "rest ")
(print head) (print " ")
(print (len tail)) (print " ")
(print (at tail 0)) (print " ")
(print (at tail 3)) (println ""))
;; The tail may be empty: naming every element and then asking for the rest
;; is a zero-length slice, not an error.
(let [xs [9 8]
[p q & rest] xs]
(print-str "empty-tail ")
(print-i64 (i64 (+ p q))) (print-str " ")
(print-i64 (i64 (len rest))) (newline))
(print "empty-tail ")
(print (+ p q)) (print " ")
(print (len rest)) (println ""))
;; Patterns nest through each other: a struct inside an array.
(let [ps [(Point {:x 1 :y 2}) (Point {:x 3 :y 4})]
@ -91,18 +91,18 @@
;; scalar's.
(let [ps [(Point {:x 1 :y 2}) (Point {:x 3 :y 4}) (Point {:x 5 :y 6})]
[first & others] ps]
(print-str "struct-tail ")
(print-i64 (i64 (.x first))) (print-str " ")
(print-i64 (i64 (len others))) (print-str " ")
(print-i64 (i64 (.y (at others 0)))) (print-str " ")
(print-i64 (i64 (.x (at others 1)))) (newline))
(print "struct-tail ")
(print (.x first)) (print " ")
(print (len others)) (print " ")
(print (.y (at others 0))) (print " ")
(print (.x (at others 1))) (println ""))
;; Evaluate-once. Two patterns, two calls, four names — one call per pattern.
;; Without the temporary each of the four names would call it again: 4, not 2.
(let [{:keys [x y]} (make-point)
{a :x b :y} (make-point)]
(print-str "calls ")
(print-i64 (i64 calls)) (print-str " ")
(print-i64 (i64 (+ x (+ y (+ a b)))))
(newline))
(print "calls ")
(print calls) (print " ")
(print (+ x (+ y (+ a b))))
(println ""))
0)

2
test/programs/dev-break.flan
View File

@ -26,7 +26,7 @@
(defn main [] i32
(agent/start "/tmp/flan-dev-break-fallback.sock")
(print-i64 (i64 (fetch 1))) (newline)
(print (fetch 1)) (println "")
(dotimes [i 4000]
(agent/wait 5)
(set ticks (step)))

8
test/programs/dev-loop.flan
View File

@ -21,11 +21,11 @@
(defn main [] i32
(agent/start "/tmp/flan-dev-fallback.sock")
(print-i64 (step)) (newline)
(print (step)) (println "")
(while (= (agent/wait 100) 0) 0)
(print-i64 (step)) (newline)
(print (step)) (println "")
(while (= (agent/wait 100) 0) 0)
(print-i64 (step)) (newline)
(print (step)) (println "")
(while (= (agent/wait 100) 0) 0)
(print-i64 (step)) (newline)
(print (step)) (println "")
0)

64
test/programs/edn.flan
View File

@ -42,15 +42,15 @@
c (edn/cursor b)
t (edn/next (addr c))]
(while (and (edn/ok? (addr c)) (!= (.kind t) edn/tok-eof))
(print-str (kind-letter (.kind t)))
(print-str "<")
(print-bytes (.text t))
(print-str ">")
(print (kind-letter (.kind t)))
(print "<")
(print (.text t))
(print ">")
(set t (edn/next (addr c))))
(when (not (edn/ok? (addr c)))
(print-str "ERR@")
(print-i64 (i64 (edn/error-pos (addr c)))))
(newline)))
(print "ERR@")
(print (edn/error-pos (addr c))))
(println "")))
;; The refusals. Asserted on the *reason*, not on the fact of failing: a
;; tokenizer that answered err-unexpected-byte for every one of these would
@ -60,10 +60,10 @@
c (edn/cursor b)]
(while (and (edn/ok? (addr c))
(!= (.kind (edn/next (addr c))) edn/tok-eof)))
(print-i64 (i64 (edn/error-pos (addr c))))
(print-str " ")
(print-str (edn/error-message (edn/error (addr c))))
(newline)))
(print (edn/error-pos (addr c)))
(print " ")
(print (edn/error-message (edn/error (addr c))))
(println "")))
;; ── The worked example: a struct read by hand ───────────────────────
@ -124,20 +124,20 @@
e (read-enemy (addr c))]
(if (edn/ok? (addr c))
(do
(print-str "[")
(print-bytes (.name e))
(print-str "] hp=")
(print-i64 (i64 (.hp e)))
(print-str " speed=")
(print-f64 (f64 (.speed e)))
(print-str " boss=")
(print-str (if (.boss? e) "yes" "no")))
(print "[")
(print (.name e))
(print "] hp=")
(print (.hp e))
(print " speed=")
(print (.speed e))
(print " boss=")
(print (if (.boss? e) "yes" "no")))
(do
(print-str "ERR@")
(print-i64 (i64 (edn/error-pos (addr c))))
(print-str " ")
(print-str (edn/error-message (edn/error (addr c))))))
(newline)))
(print "ERR@")
(print (edn/error-pos (addr c)))
(print " ")
(print (edn/error-message (edn/error (addr c))))))
(println "")))
(defn main [] i32
;; ── Scalars, and the boundaries between them ──────────────────────
@ -149,7 +149,7 @@
;; of the alphabet test is only exercised by a name that has one in it.
(dump "foo Enemy/Goblin -")
(dump ":a :foo/bar") ; k, text without the colon
(newline)
(println "")
;; A number followed immediately by a delimiter, with no space. A scanner
;; that only stopped on whitespace reads "1]" or "1;x" as one atom and then
@ -159,7 +159,7 @@
(dump "{:a 1}")
(dump "1;c") ; a comment starting against the number
(dump ":a;c") ; a keyword ending at a comment
(newline)
(println "")
;; Empty collections, and nesting. An empty map is the case a reader that
;; assumes at least one key-value pair gets wrong.
@ -168,14 +168,14 @@
(dump "()")
(dump "[[1] [2 [3]]]")
(dump "{:a {:b []}}")
(newline)
(println "")
;; A keyword at the very end of input — the loop has to test the length
;; before reading the byte, or this walks off the end.
(dump ":a")
(dump "1")
(dump "\"x\"")
(newline)
(println "")
;; Comments. The last one has no trailing newline, which is the case that
;; separates a scan-to-newline from a scan-to-newline-or-end.
@ -183,11 +183,11 @@
(dump "1 ; trailing\n2")
(dump "1 ; no newline at the end")
(dump ";") ; a bare comment marker, nothing after it
(newline)
(println "")
;; Commas are whitespace in EDN, and are not tokens.
(dump "[1, 2 ,3]")
(newline)
(println "")
;; Strings. The second is the one that matters: a `[` and a `;` inside a
;; string must not open a vector or start a comment.
@ -195,7 +195,7 @@
(dump "\"a[b;c\" 1")
(dump "\"\" 1") ; the empty string is a token with empty text
(dump "\"a b\"")
(newline)
(println "")
;; ── The refusals, each asserted on its own reason ─────────────────
(refusal "\"a\\nb\"") ; an escape inside a string
@ -222,7 +222,7 @@
;; past the end of a fixed array, and the answer is a bounds trap rather
;; than a wrong message. The offset is the 33rd bracket.
(refusal "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[")
(newline)
(println "")
;; ── The struct reader ─────────────────────────────────────────────
(show-enemy "{:name \"goblin\" :hp 12 :speed 1.5 :boss? false}")

10
test/programs/enum-compare.flan
View File

@ -13,15 +13,15 @@
(defn main [] i32
;; Equality, both ways round.
(print-line (if (eq? :mid) "eq yes" "eq no"))
(print-line (if (eq? :hi) "eq yes" "eq no"))
(println (if (eq? :mid) "eq yes" "eq no"))
(println (if (eq? :hi) "eq yes" "eq no"))
;; Ordering, and signed: lo is -1, so an unsigned compare would call it the
;; largest member and answer the other way.
(print-line (if (below? :lo) "lo below mid" "lo not below mid"))
(print-line (if (below? :hi) "hi below mid" "hi not below mid"))
(println (if (below? :lo) "lo below mid" "lo not below mid"))
(println (if (below? :hi) "hi below mid" "hi not below mid"))
;; And through a struct field, which is a different path to the same compare.
(let [s (S {:k :hi})]
(print-line (if (= (.k s) :hi) "field eq yes" "field eq no")))
(println (if (= (.k s) :hi) "field eq yes" "field eq no")))
0)

2
test/programs/error.flan
View File

@ -9,6 +9,6 @@
(defn main [] i32
;; A handler that returns normally. It runs — signal's lookup is the same —
;; and it still does not answer the error.
(handler-bind [(AssetMissing [c] (print-line "handler ran"))]
(handler-bind [(AssetMissing [c] (println "handler ran"))]
(error (AssetMissing {:id 1})))
0)

20
test/programs/machine.flan
View File

@ -29,19 +29,19 @@
(set (at grid 1 2) 7)
(set (at grid 0 0) 5)
(set total (sum-grid))
(print-i64 (i64 total)) (newline) ; 12
(print-i64 (i64 (at pal 2))) (newline) ; 30
(print total) (println "") ; 12
(print (at pal 2)) (println "") ; 30
(let [p (P {:x 1 :y 2})] ; :y omitted is zeroed
(bump (addr p))
(print-i64 (i64 (.x p))) (newline) ; 2
(print (.x p)) (println "") ; 2
(let [l (Line {:a p})]
(print-i64 (i64 (.y (.a l)))) (newline))) ; 2
(print-f64 (f64 (/ 7 2))) (newline) ; 3 integer divide
(print-f64 (/ (f64 7) 2.0)) (newline) ; 3.5 float divide
(print-i64 (i64 (match (find 21) (Some v) v None 0))) (newline) ; 42
(print-i64 (i64 (match (find -1) (Some v) v None 99))) (newline) ; 99
(print (.y (.a l))) (println ""))) ; 2
(print (/ 7 2)) (println "") ; 3 integer divide
(print (/ (f64 7) 2.0)) (println "") ; 3.5 float divide
(print (match (find 21) (Some v) v None 0)) (println "") ; 42
(print (match (find -1) (Some v) v None 99)) (println "") ; 99
(let [q (addr total)]
(print-i64 (i64 (deref q))) (newline) ; 12
(print (deref q)) (println "") ; 12
(set (deref q) 123)
(print-i64 (i64 total)) (newline)) ; 123
(print total) (println "")) ; 123
0)

18
test/programs/math.flan
View File

@ -11,50 +11,50 @@
;;;; cast, has to produce the answer.
(defn show [x f32]
(print-f64 (f64 x))
(print-str " "))
(print x)
(print " "))
(defn main [] i32
;; floor: down on both signs, and unmoved on the integers.
(show (floor-f32 2.7)) (show (floor-f32 2.0)) (show (floor-f32 2.3))
(show (floor-f32 -2.7)) (show (floor-f32 -2.0)) (show (floor-f32 -2.3))
(show (floor-f32 0.5)) (show (floor-f32 -0.5))
(newline)
(println "")
;; ceil: up on both signs. -2.7 must give -2, which is where a ceil written
;; as "floor plus one" goes wrong.
(show (ceil-f32 2.7)) (show (ceil-f32 2.0)) (show (ceil-f32 2.3))
(show (ceil-f32 -2.7)) (show (ceil-f32 -2.0)) (show (ceil-f32 -2.3))
(show (ceil-f32 0.5)) (show (ceil-f32 -0.5))
(newline)
(println "")
;; Zero keeps its sign through floor, which is what the (= x 0.0) guard in
;; it is for and the only place that guard is observable: the cast it skips
;; would turn -0.0 into +0.0, and %g prints the difference. Drop the guard
;; and the third column here reads 0 instead of -0.
(show (floor-f32 0.0)) (show (ceil-f32 0.0)) (show (floor-f32 -0.0))
(newline)
(println "")
;; round: half away from zero on both signs, so -2.5 is -3 and not -2.
(show (round-f32 2.4)) (show (round-f32 2.5)) (show (round-f32 2.6))
(show (round-f32 -2.4)) (show (round-f32 -2.5)) (show (round-f32 -2.6))
(show (round-f32 0.5)) (show (round-f32 -0.5))
(newline)
(println "")
;; Past 2^24 there is no fraction left; the answer is the input, and the
;; cast that would produce it is out of i32's range on the way there.
(show (floor-f32 16777216.0)) (show (ceil-f32 16777216.0))
(show (round-f32 16777216.0)) (show (floor-f32 -16777216.0))
(newline)
(println "")
;; sqrt, including the two values a wrong-sense iteration still passes
;; (0 and 1) and one that is not a perfect square.
(show (sqrt-f32 0.0)) (show (sqrt-f32 1.0)) (show (sqrt-f32 4.0))
(show (sqrt-f32 2.0)) (show (sqrt-f32 0.25)) (show (sqrt-f32 1e6))
(newline)
(println "")
;; A squared distance through sqrt, which is what a game actually calls it
;; for: 3-4-5 exactly, so a last-bit error would show.
(show (sqrt-f32 (+ (* 3.0 3.0) (* 4.0 4.0))))
(newline)
(println "")
0)

4
test/programs/pkg-return.flan
View File

@ -22,6 +22,6 @@
(defn main [] i32
(let [c (fresh (bytes "[1 2]"))
t (edn/next (addr c))]
(print-i64 (i64 (.kind t))) (newline))
(print-i64 (i64 (.n (local)))) (newline)
(print (.kind t)) (println ""))
(print (.n (local))) (println "")
0)

2
test/programs/pkg-shared.flan
View File

@ -11,5 +11,5 @@
(defn main [] i32
(sand/paint-at 4 (/ sand/cols 2))
(sand/step)
(print-line "ok")
(println "ok")
0)

2
test/programs/pkg-unused.flan
View File

@ -8,5 +8,5 @@
(import rl "vendor:raylib")
(defn main [] i32
(print-line "ok")
(println "ok")
0)

16
test/programs/raylib-audio.flan
View File

@ -77,16 +77,16 @@
(defconst wav-path "/tmp/flan-raylib-audio.wav")
(defn show-wave [name string w rl/Wave]
(print-str name)
(print-str " ") (print-i64 (i64 (.frame-count w)))
(print-str " ") (print-i64 (i64 (.sample-rate w)))
(print-str " ") (print-i64 (i64 (.sample-size w)))
(print-str " ") (print-i64 (i64 (.channels w)))
(newline))
(print name)
(print " ") (print (.frame-count w))
(print " ") (print (.sample-rate w))
(print " ") (print (.sample-size w))
(print " ") (print (.channels w))
(println ""))
(defn show-bool [name string b bool]
(print-str name) (print-str " ")
(print-line (if b "yes" "no")))
(print name) (print " ")
(println (if b "yes" "no")))
;; A decoded sample is compared with a tolerance and the verdict is printed,
;; not the number. 1000 over a 15- or 16-bit full scale is 0.0305185 or

42
test/programs/raylib-ffi.flan
View File

@ -12,17 +12,17 @@
;; something to the fields that depends on which is which.
(defn show-texture [t rl/Texture2D]
(print-i64 (i64 (.id t))) (newline)
(print-i64 (i64 (.width t))) (newline)
(print-i64 (i64 (.height t))) (newline)
(print-i64 (i64 (.mipmaps t))) (newline)
(print-i64 (i64 (.format t))) (newline))
(print (.id t)) (println "")
(print (.width t)) (println "")
(print (.height t)) (println "")
(print (.mipmaps t)) (println "")
(print (.format t)) (println ""))
(defn show-rect [r rl/Rectangle]
(print-f64 (f64 (.x r))) (newline)
(print-f64 (f64 (.y r))) (newline)
(print-f64 (f64 (.width r))) (newline)
(print-f64 (f64 (.height r))) (newline))
(print (.x r)) (println "")
(print (.y r)) (println "")
(print (.width r)) (println "")
(print (.height r)) (println ""))
;; ── Camera2D ────────────────────────────────────────────────────────
;;
@ -47,12 +47,12 @@
;; defstruct and this reads (143,-16); swap rotation and zoom and the zoom
;; becomes 0, the transform is singular, and both come back NaN.
(defn show-bool [name string b bool]
(print-str name) (print-str " ")
(print-line (if b "yes" "no")))
(print name) (print " ")
(println (if b "yes" "no")))
(defn show-v [v rl/Vector2]
(print-f64 (f64 (.x v))) (newline)
(print-f64 (f64 (.y v))) (newline))
(print (.x v)) (println "")
(print (.y v)) (println ""))
;; What no geometric call can pin on its own is Vector2's own two fields:
;; exchange x and y everywhere and every component-wise formula is simply
@ -72,8 +72,8 @@
(< (if (< d 0.0) (- 0.0 d) d) 0.0001)))
(defn show-near [name string v rl/Vector2 x f32 y f32]
(print-str name)
(print-line (if (and (near? (.x v) x) (near? (.y v) y)) " ok" " bad")))
(print name)
(println (if (and (near? (.x v) x) (near? (.y v) y)) " ok" " bad")))
(defn main [] i32
(rl/set-trace-log-level :warning)
@ -82,10 +82,10 @@
;; the little-endian reading of the packed integer. An identity would pass a
;; weaker test than this one.
(let [c (rl/get-color 0x11223344)]
(print-i64 (i64 (.r c))) (newline)
(print-i64 (i64 (.g c))) (newline)
(print-i64 (i64 (.b c))) (newline)
(print-i64 (i64 (.a c))) (newline))
(print (.r c)) (println "")
(print (.g c)) (println "")
(print (.b c)) (println "")
(print (.a c)) (println ""))
;; Rectangle, pinned completely. The intersection of (0,0,10,4) and
;; (6,1,10,10) is (6,1,4,3) — four different numbers, each derived from a
@ -190,7 +190,7 @@
(match (rl/collision-lines (rl/Vector2 {:x 0.0 :y 7.0}) (rl/Vector2 {:x 10.0 :y 7.0})
(rl/Vector2 {:x 3.0 :y 0.0}) (rl/Vector2 {:x 3.0 :y 10.0}))
(Some p) (show-v p)
None (print-line "no crossing"))
None (println "no crossing"))
;; The rest of the collision family, each with the case that must come out
;; the other way. Bound and linking is not the same as working: a wrapper
;; whose arguments are in the wrong order links perfectly and answers
@ -268,6 +268,6 @@
(match (rl/collision-lines (rl/Vector2 {:x 0.0 :y 0.0}) (rl/Vector2 {:x 1.0 :y 2.0})
(rl/Vector2 {:x 5.0 :y 0.0}) (rl/Vector2 {:x 6.0 :y 2.0}))
(Some p) (show-v p)
None (print-line "no crossing"))
None (println "no crossing"))
0)

26
test/programs/raylib-font.flan
View File

@ -81,25 +81,25 @@
:advance-x 0 :image (rl/Image {})})))
(defn show-bool [name string b bool]
(print-str name) (print-str " ")
(print-line (if b "yes" "no")))
(print name) (print " ")
(println (if b "yes" "no")))
(defn show-i [name string v i32]
(print-str name) (print-str " ") (print-i64 (i64 v)) (newline))
(print name) (print " ") (print v) (println ""))
(defn show-v [name string v rl/Vector2]
(print-str name)
(print-str " ") (print-f64 (f64 (.x v)))
(print-str " ") (print-f64 (f64 (.y v)))
(newline))
(print name)
(print " ") (print (.x v))
(print " ") (print (.y v))
(println ""))
(defn show-rect [name string r rl/Rectangle]
(print-str name)
(print-str " ") (print-f64 (f64 (.x r)))
(print-str " ") (print-f64 (f64 (.y r)))
(print-str " ") (print-f64 (f64 (.width r)))
(print-str " ") (print-f64 (f64 (.height r)))
(newline))
(print name)
(print " ") (print (.x r))
(print " ") (print (.y r))
(print " ") (print (.width r))
(print " ") (print (.height r))
(println ""))
(defn main [] i32
(rl/set-trace-log-level :warning)

28
test/programs/raylib-image.flan
View File

@ -35,24 +35,24 @@
(defconst png-path "/tmp/flan-raylib-image.png")
(defn show-image [name string i rl/Image]
(print-str name)
(print-str " ") (print-i64 (i64 (.width i)))
(print-str " ") (print-i64 (i64 (.height i)))
(print-str " ") (print-i64 (i64 (.mipmaps i)))
(print-str " ") (print-i64 (i64 (.format i)))
(newline))
(print name)
(print " ") (print (.width i))
(print " ") (print (.height i))
(print " ") (print (.mipmaps i))
(print " ") (print (.format i))
(println ""))
(defn show-color [name string c rl/Color]
(print-str name)
(print-str " ") (print-i64 (i64 (.r c)))
(print-str " ") (print-i64 (i64 (.g c)))
(print-str " ") (print-i64 (i64 (.b c)))
(print-str " ") (print-i64 (i64 (.a c)))
(newline))
(print name)
(print " ") (print (.r c))
(print " ") (print (.g c))
(print " ") (print (.b c))
(print " ") (print (.a c))
(println ""))
(defn show-bool [name string b bool]
(print-str name) (print-str " ")
(print-line (if b "yes" "no")))
(print name) (print " ")
(println (if b "yes" "no")))
;; Every pixel read names its coordinates in the label, so a failure says
;; which one moved rather than only that something did.

2
test/programs/reload-v2.flan
View File

@ -19,7 +19,7 @@
(defn helper [x i64] i64 (* x 3))
(defn bump [] i64
(print-line "v2")
(println "v2")
(set counter (+ counter 10))
(if (> counter 100) (+ (helper counter) 1000) (bump)))

2
test/programs/reload-v3.flan
View File

@ -17,7 +17,7 @@
extra)
(defn bump [] i64
(print-line "v3")
(println "v3")
(set counter (+ counter (added)))
(helper counter))

2
test/programs/reload-v4.flan
View File

@ -17,7 +17,7 @@
extra)
(defn bump [] i64
(print-line "v3")
(println "v3")
(set counter (+ counter (added)))
(helper counter))

2
test/programs/reload.flan
View File

@ -31,7 +31,7 @@
(defn helper [x i64] i64 (* x 2))
(defn bump [] i64
(print-line "v1")
(println "v1")
(set counter (+ counter 1))
(helper counter))

18
test/programs/restarts.flan
View File

@ -48,33 +48,33 @@
(defn main [] i32
;; Nothing handles it, so signal is a no-op and the body's own value stands.
(print-i64 (i64 (fetch 1))) (newline) ; 101
(print-i64 log) (newline) ; 1
(print (fetch 1)) (println "") ; 101
(print log) (println "") ; 1
;; A handler that transfers: the clause's value is the restart-case's.
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
(print-i64 (i64 (fetch 2))) (newline)) ; -1
(print-i64 log) (newline) ; 2 — the defer ran
(print (fetch 2)) (println "")) ; -1
(print log) (println "") ; 2 — the defer ran
(handler-bind [(AssetMissing [c] (invoke-restart 'retry))]
(print-i64 (i64 (fetch 3))) (newline)) ; 7
(print (fetch 3)) (println "")) ; 7
;; §4: the innermost frame offering the name wins, and the clause yields to
;; *its* own continuation — so the +1000 written around the inner
;; restart-case still runs, and the outer clause never does.
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
(print-i64 (i64 (nested 4))) (newline)) ; 1010
(print (nested 4)) (println "")) ; 1010
;; A handler that returns normally transfers nothing: §1's accumulation case
;; still works, and the fall-through stands.
(handler-bind [(AssetMissing [c] (set log (+ log 100)))]
(print-i64 (i64 (fetch 5))) (newline)) ; 101
(print (fetch 5)) (println "")) ; 101
;; The handler runs at the signal, which is inside the call the defer
;; belongs to, so its +100 lands before that defer's +1.
(print-i64 log) (newline) ; 4 + 100 + 1 = 105
(print log) (println "") ; 4 + 100 + 1 = 105
;; error, answered by a transfer. Unanswered it stops the program, which is
;; the trap case in the acceptance table rather than a line here.
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
(print-i64 (i64 (strict 6))) (newline)) ; -2
(print (strict 6)) (println "")) ; -2
0)

4
test/programs/sand-headless.flan
View File

@ -28,6 +28,6 @@
(sand/paint-at 4 (* (+ i 1) (/ sand/cols 5))))
(dotimes [f frames]
(sand/step))
(print-i64 (i64 (sand/hash-grid)))
(newline)
(print (sand/hash-grid))
(println "")
0)

10
test/programs/signedness.flan
View File

@ -7,15 +7,15 @@
(defn main [] i32
;; An arithmetic shift keeps the sign. A logical one on -8 gives a number
;; near 2^63, which is the wrong answer that looks like a huge right one.
(print-i64 (>> (i64 -8) 1)) (newline) ; -4
(print-i64 (>> (i64 -1) 40)) (newline) ; -1, still, however far it goes
(print (>> (i64 -8) 1)) (println "") ; -4
(print (>> (i64 -1) 40)) (println "") ; -1, still, however far it goes
;; And unsigned stays unsigned: 3000000000 has its top bit set, so a signed
;; compare reads it as negative and answers the other way on every operator.
(let [big (bit-or (<< (u32 1) 31) (u32 1000))] ; 2^31 + 1000
(print-line (if (< big (u32 5)) "wrong: signed compare" "big is not small"))
(print-line (if (> big (u32 5)) "big is large" "wrong: signed compare"))
(println (if (< big (u32 5)) "wrong: signed compare" "big is not small"))
(println (if (> big (u32 5)) "big is large" "wrong: signed compare"))
;; The same value through >>, which is logical on an unsigned type: a
;; signed shift here would keep the top bit and answer near 2^31 again.
(print-i64 (i64 (>> big 31))) (newline)) ; 1
(print (>> big 31)) (println "")) ; 1
0)

30
test/programs/slices.flan
View File

@ -17,9 +17,9 @@
(defn show [s [i32]]
(dotimes [i (len s)]
(when (> i 0) (print-str " "))
(print-i64 (i64 (at s i))))
(newline))
(when (> i 0) (print " "))
(print (at s i)))
(println ""))
(defn load-xs []
(set (at xs 0) 5)
@ -35,21 +35,19 @@
(show (slice xs 0 (len xs))) ; 5 -3 5 0 12 -3 7
;; Reading the whole slice, before anything reorders it.
(print-i64 (sum-i32 (slice xs 0 (len xs)))) (newline) ; 23
(print-i64 (i64 (match (min-i32 (slice xs 0 (len xs))) (Some v) v None 99)))
(newline) ; -3
(print-i64 (i64 (match (max-i32 (slice xs 0 (len xs))) (Some v) v None 99)))
(newline) ; 12
(print (sum-i32 (slice xs 0 (len xs)))) (println "") ; 23
(print (match (min-i32 (slice xs 0 (len xs))) (Some v) v None 99))
(println "") ; -3
(print (match (max-i32 (slice xs 0 (len xs))) (Some v) v None 99))
(println "") ; 12
;; First index, not the last: 5 appears at 0 and at 2.
(print-i64 (i64 (match (index-of-i32 (slice xs 0 (len xs)) 5)
(Some v) v None -1)))
(newline) ; 0
(print-i64 (i64 (match (index-of-i32 (slice xs 0 (len xs)) 4)
(Some v) v None -1)))
(newline) ; -1
(print (match (index-of-i32 (slice xs 0 (len xs)) 5) (Some v) v None -1))
(println "") ; 0
(print (match (index-of-i32 (slice xs 0 (len xs)) 4) (Some v) v None -1))
(println "") ; -1
;; An empty slice has no least element, and None is the answer.
(print-i64 (i64 (match (min-i32 (slice xs 3 3)) (Some v) v None 99)))
(newline) ; 99
(print (match (min-i32 (slice xs 3 3)) (Some v) v None 99))
(println "") ; 99
;; Reverse of an odd-length slice: the middle element stays put.
(reverse-i32! (slice xs 0 (len xs)))

26
test/programs/string-of-bytes.flan
View File

@ -21,11 +21,11 @@
(declare-c c-puts [s string] i32 "puts")
(defn shows [s string]
(print-str "[")
(print-str s)
(print-str "] ")
(print-i64 (i64 (len (bytes s))))
(newline))
(print "[")
(print s)
(print "] ")
(print (len (bytes s)))
(println ""))
(defn main [] i32
;; A number. The gap this closes: i64->bytes answers a [u8], every text
@ -46,18 +46,18 @@
;; Round trip: (bytes (string b)) is b, and both directions are the identity.
(let [b (i64->bytes 1234567)]
(print-i64 (i64 (len (bytes (string b)))))
(newline))
(print (len (bytes (string b))))
(println ""))
;; Across the declare-c boundary. The first is a sub-view — five bytes out of
;; eleven, the sixth of which is a space and not a NUL — so a shim that did
;; not copy would print "hello world" here.
(let [s (bytes "hello world")]
(print-str (if (>= (c-puts (string (slice s 0 5))) 0) "ok" "no"))
(newline))
(print-str (if (>= (c-puts (string (i64->bytes 12345))) 0) "ok" "no"))
(newline)
(print (if (>= (c-puts (string (slice s 0 5))) 0) "ok" "no"))
(println ""))
(print (if (>= (c-puts (string (i64->bytes 12345))) 0) "ok" "no"))
(println "")
;; And an empty one: the shim's copy of a zero-length slice is "".
(print-str (if (>= (c-puts (string (slice (bytes "abc") 1 1))) 0) "ok" "no"))
(newline)
(print (if (>= (c-puts (string (slice (bytes "abc") 1 1))) 0) "ok" "no"))
(println "")
0)

80
test/programs/text.flan
View File

@ -7,77 +7,77 @@
;;;; "12x", "-" — each of which a caller could not tell from a real 0.
(defn show-bool [b bool]
(print-str (if b "t" "f")))
(print (if b "t" "f")))
(defn main [] i32
(show-bool (bytes=? (bytes "abc") (bytes "abc"))) ; t
(show-bool (bytes=? (bytes "abc") (bytes "abd"))) ; f same length
(show-bool (bytes=? (bytes "abc") (bytes "ab"))) ; f prefix, not equal
(show-bool (bytes=? (bytes "") (bytes ""))) ; t
(newline)
(println "")
(show-bool (starts-with? (bytes "hello") (bytes "hel"))) ; t
(show-bool (starts-with? (bytes "hello") (bytes "llo"))) ; f matches the end
(show-bool (starts-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap
(show-bool (starts-with? (bytes "hello") (bytes ""))) ; t
(show-bool (starts-with? (bytes "hello") (bytes "hello"))) ; t
(newline)
(println "")
(show-bool (ends-with? (bytes "hello") (bytes "llo"))) ; t
(show-bool (ends-with? (bytes "hello") (bytes "hel"))) ; f matches the start
(show-bool (ends-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap
(show-bool (ends-with? (bytes "hello") (bytes ""))) ; t
(show-bool (ends-with? (bytes "hello") (bytes "hello"))) ; t
(newline)
(println "")
;; First occurrence, and None for a byte that is not there.
(print-i64 (i64 (match (index-of-byte (bytes "banana") \a) (Some i) i None -1)))
(print-str " ")
(print-i64 (i64 (match (index-of-byte (bytes "banana") \z) (Some i) i None -1)))
(print-str " ")
(print-i64 (i64 (match (index-of-byte (bytes "") \a) (Some i) i None -1)))
(newline)
(print (match (index-of-byte (bytes "banana") \a) (Some i) i None -1))
(print " ")
(print (match (index-of-byte (bytes "banana") \z) (Some i) i None -1))
(print " ")
(print (match (index-of-byte (bytes "") \a) (Some i) i None -1))
(println "")
;; Accepted.
(print-i64 (match (parse-i64 (bytes "0")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "42")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "-42")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "+7")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "9007199254740993")) (Some v) v None -999))
(newline)
(print (match (parse-i64 (bytes "0")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "42")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "-42")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "+7")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "9007199254740993")) (Some v) v None -999))
(println "")
;; Refused. Each of these is a 0 out of strtoll, which is the point.
(print-i64 (match (parse-i64 (bytes "")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "abc")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "12x")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes "-")) (Some v) v None -999)) (print-str " ")
(print-i64 (match (parse-i64 (bytes " 1")) (Some v) v None -999))
(newline)
(print (match (parse-i64 (bytes "")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "abc")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "12x")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes "-")) (Some v) v None -999)) (print " ")
(print (match (parse-i64 (bytes " 1")) (Some v) v None -999))
(println "")
(print-f64 (f64 (sign-f32 3.5))) (print-str " ")
(print-f64 (f64 (sign-f32 -3.5))) (print-str " ")
(print-f64 (f64 (sign-f32 0.0)))
(newline)
(print (sign-f32 3.5)) (print " ")
(print (sign-f32 -3.5)) (print " ")
(print (sign-f32 0.0))
(println "")
;; t = 1.0 must return b exactly, which a + t*(b - a) does not always do.
(print-f64 (f64 (lerp 0.0 10.0 0.0))) (print-str " ")
(print-f64 (f64 (lerp 0.0 10.0 0.25))) (print-str " ")
(print-f64 (f64 (lerp 0.0 10.0 1.0))) (print-str " ")
(print-f64 (f64 (lerp 2.0 -2.0 0.5)))
(newline)
(print (lerp 0.0 10.0 0.0)) (print " ")
(print (lerp 0.0 10.0 0.25)) (print " ")
(print (lerp 0.0 10.0 1.0)) (print " ")
(print (lerp 2.0 -2.0 0.5))
(println "")
;; The RNG ranges, off a fixed seed, so the numbers are the sequence and not
;; just "something in range". An empty range answers lo and must not divide.
(rand-seed 7)
(dotimes [i 5]
(when (> i 0) (print-str " "))
(print-i64 (i64 (rand-i32-range 10 20))))
(newline)
(print-i64 (i64 (rand-i32-range 5 5))) (print-str " ")
(print-i64 (i64 (rand-i32-range 5 -5)))
(newline)
(when (> i 0) (print " "))
(print (rand-i32-range 10 20)))
(println "")
(print (rand-i32-range 5 5)) (print " ")
(print (rand-i32-range 5 -5))
(println "")
(rand-seed 7)
(dotimes [i 3]
(when (> i 0) (print-str " "))
(print-f64 (f64 (rand-f32-range 0.0 1.0))))
(newline)
(when (> i 0) (print " "))
(print (rand-f32-range 0.0 1.0)))
(println "")
0)

2
test/programs/unit-main.flan
View File

@ -1,4 +1,4 @@
;;;; The short entry point: both the parameter and the i32 status are optional,
;;;; and an omitted return type means Unit, so the process exits 0.
(defn main []
(print-line "ok"))
(println "ok"))

66
test/programs/utf8.flan
View File

@ -52,17 +52,17 @@
;; rather than just failing.
(defn show-dec [s [u8]]
(let [r (decode-rune s)]
(print-i64 (i64 (.code r))) (print-str "/")
(print-i64 (i64 (.width r))) (print-str "/")
(print-str (if (.ok r) "t" "f"))
(print-str " ")))
(print (.code r)) (print "/")
(print (.width r)) (print "/")
(print (if (.ok r) "t" "f"))
(print " ")))
(defn show-bool [b bool]
(print-str (if b "t" "f")))
(print (if b "t" "f")))
(defn show-opt [o (Option i32)]
(print-i64 (i64 (match o (Some v) v None -1)))
(print-str " "))
(print (match o (Some v) v None -1))
(print " "))
;; Encode into the scratch buffer and decode straight back out of it. A round
;; trip is the only check that catches an encoder and a decoder that are
@ -75,17 +75,17 @@
(if (and (.ok r) (= (.width r) w)) (.code r) -1))))
(defn show-i32 [x i32]
(print-i64 (i64 x))
(print-str " "))
(print x)
(print " "))
(defn show-split [s [u8] sep u8]
(let [it (split-on-byte s sep)
going true]
(while going
(match (split-next! (addr it))
(Some f) (do (print-str "[") (print-bytes f) (print-str "]"))
(Some f) (do (print "[") (print f) (print "]"))
None (set going false)))
(print-str " ")))
(print " ")))
(defn main [] i32
;; Valid, one of each width. The empty slice is width 0 — the only input
@ -96,7 +96,7 @@
(show-dec (bytes "é")) ; 233/2/t
(show-dec (bytes "日")) ; 26085/3/t
(show-dec (slice emoji 0 4)) ; 128512/4/t
(newline)
(println "")
;; Malformed. Every one is 0/1/f: width 1 so a scan makes progress.
(show-dec (slice lone-cont 0 1)) ; a continuation byte leading
@ -108,7 +108,7 @@
(show-dec (slice surrogate 0 3)) ; U+D800
(show-dec (slice above-max 0 4)) ; U+110000
(show-dec (slice lead-f5 0 4)) ; 0xf5 leads nothing
(newline)
(println "")
;; Truncated: a valid character cut short by the end of the slice, at both
;; possible cut points, and the interior of one taken on its own.
@ -116,23 +116,23 @@
(show-dec (slice (bytes "日") 0 2)) ; lead plus one continuation
(show-dec (slice (bytes "日") 1 3)) ; starts mid-character
(show-dec (slice (bytes "é") 1 2)) ; a lone continuation from a literal
(newline)
(println "")
;; rune-start? is what a caller scans backwards with.
(show-bool (rune-start? (at (bytes "日") 0)))
(show-bool (rune-start? (at (bytes "日") 1)))
(show-bool (rune-start? \A))
(newline)
(println "")
;; Counting. The empty string is 0 and not 1; the mixed string is 8 runes
;; in 13 bytes, which is the whole distinction; and a malformed byte counts
;; as one, so a count never disagrees with what a renderer would draw.
(print-i64 (i64 (rune-count (bytes "")))) (print-str " ")
(print-i64 (i64 (rune-count (bytes "abc")))) (print-str " ")
(print-i64 (i64 (rune-count (bytes "héllo 日本")))) (print-str " ")
(print-i64 (i64 (len (bytes "héllo 日本")))) (print-str " ")
(print-i64 (i64 (rune-count (slice bad-tail 0 3))))
(newline)
(print (rune-count (bytes ""))) (print " ")
(print (rune-count (bytes "abc"))) (print " ")
(print (rune-count (bytes "héllo 日本"))) (print " ")
(print (len (bytes "héllo 日本"))) (print " ")
(print (rune-count (slice bad-tail 0 3)))
(println "")
(show-bool (valid-utf8? (bytes "")))
(show-bool (valid-utf8? (bytes "héllo 日本")))
@ -140,7 +140,7 @@
(show-bool (valid-utf8? (slice overlong2 0 2)))
(show-bool (valid-utf8? (slice bad-tail 0 3)))
(show-bool (valid-utf8? (slice emoji 0 4)))
(newline)
(println "")
;; rune-at: on a boundary, off a boundary, and out of range. Off a boundary
;; is None rather than a replacement character, which is where this is
@ -150,7 +150,7 @@
(show-opt (rune-at (bytes "日本") 1)) ; -1, mid-character
(show-opt (rune-at (bytes "日本") 6)) ; -1, past the end
(show-opt (rune-at (bytes "") 0)) ; -1
(newline)
(println "")
;; rune-size, at every boundary and on both sides of it.
(show-opt (rune-size -1))
@ -167,7 +167,7 @@
(show-opt (rune-size 0x10000))
(show-opt (rune-size 0x10ffff))
(show-opt (rune-size 0x110000))
(newline)
(println "")
;; Round trips, one per width and at the boundaries.
(show-i32 (round-trip 0))
@ -179,7 +179,7 @@
(show-i32 (round-trip 0xffff))
(show-i32 (round-trip 0x10000))
(show-i32 (round-trip 0x10ffff))
(newline)
(println "")
;; Refused by encode-rune!, and nothing is written when it refuses.
(show-opt (encode-rune! (slice scratch 0 4) 0xd800)) ; -1, surrogate
@ -188,7 +188,7 @@
(show-opt (encode-rune! (slice scratch 0 2) 0x65e5)) ; -1, buffer short
(show-opt (encode-rune! (slice scratch 0 0) 0x41)) ; -1, no room at all
(show-opt (encode-rune! (slice scratch 0 1) 0x41)) ; 1, exactly enough
(newline)
(println "")
;; "Nothing is written when it refuses" is a claim about the buffer, not
;; about the return value, and the None cases above do not test it: an
@ -201,7 +201,7 @@
(show-i32 (i32 (at scratch 0))) ; 65 still
(show-opt (encode-rune! (slice scratch 0 4) 0xd800)) ; -1, surrogate
(show-i32 (i32 (at scratch 0))) ; 65 still
(newline)
(println "")
;; Splitting. n separators give n+1 fields, always: an interior empty field
;; survives, a leading and a trailing one do too, and an input with no
@ -215,7 +215,7 @@
(show-split (bytes ",") \,) ; [][]
(show-split (bytes ",a") \,) ; [][a]
(show-split (bytes "a,") \,) ; [a][]
(newline)
(println "")
;; A field is a slice of the input, so trim and parse-i64 work straight off
;; one with nothing copied in between — which is the entire reason the
@ -227,8 +227,8 @@
(match (split-next! (addr it))
(Some f) (set total (+ total (match (parse-i64 (trim f)) (Some v) v None 0)))
None (set going false)))
(print-i64 total)
(newline))
(print total)
(println ""))
;; ASCII case. The boundary bytes on both sides of each range are what a
;; wrong mask gets wrong: '@' and '[' sit either side of A-Z, and '`' and
@ -245,13 +245,13 @@
(show-i32 (i32 (upper-ascii \`))) ; 96, just below 'a'
(show-i32 (i32 (upper-ascii \{))) ; 123, just above 'z'
(show-i32 (i32 (lower-ascii \5))) ; digits are untouched
(newline)
(println "")
;; A non-ASCII byte must pass through both untouched, which is the claim
;; that "ASCII only" is a rule and not an oversight.
(show-i32 (i32 (lower-ascii (at (bytes "é") 0))))
(show-i32 (i32 (upper-ascii (at (bytes "é") 0))))
(newline)
(println "")
(show-bool (bytes-ci=? (bytes "Hello") (bytes "hELLO"))) ; t
(show-bool (bytes-ci=? (bytes "Hello") (bytes "hello!"))) ; f length first
@ -261,5 +261,5 @@
;; fold written as a bit-xor would call these two equal. They are not.
(show-bool (bytes-ci=? (bytes "@") (bytes "`"))) ; f
(show-bool (bytes-ci=? (bytes "é") (bytes "é"))) ; t bytes match
(newline)
(println "")
0)

6
test/programs/values.flan
View File

@ -8,14 +8,14 @@
(let [a (P {:x 1})]
(let [b a] ; a copy, not an alias
(set (.x a) 99)
(print-i64 (i64 (.x b))) (newline))) ; 1
(print (.x b)) (println ""))) ; 1
(set (at arr 0) 5)
(let [c arr] ; fixed arrays are values too
(set (at arr 0) 77)
(print-i64 (i64 (at c 0))) (newline)) ; 5
(print (at c 0)) (println "")) ; 5
(let [s (bytes "hello")]
(let [v (slice s 1 3)] ; a view into the same bytes
(print-bytes v) (newline))) ; el
(print v) (println ""))) ; el
0)

6
test/test_acceptance.ml
View File

@ -544,7 +544,7 @@ let () =
and not raylib, deliberately — a program that imports raylib links
libraylib on every target, and this one is the version meant to run on
wasm32 too. The hash is reproducible only because rand-f32 is ours. *)
let sand_out = "-2851001042534928384\n" in
let sand_out = "15595743031174623232\n" in
outputs "sand, headless" "programs/sand-headless.flan" sand_out;
outputs ~opt:"-O0" "sand, headless, -O0" "programs/sand-headless.flan" sand_out;
@ -1497,8 +1497,8 @@ ERR@7 unexpected token: not the kind the caller was reading
(defn main [] i32\n\
\ (set (at arr 2) 9)\n\
\ (let [s (slice arr 0 4)]\n\
\ (print-i64 (i64 (pick s 2))) (newline)\n\
\ (print-i64 (i64 (run))) (newline)\n\
\ (print (pick s 2)) (println \"\")\n\
\ (print (run)) (println \"\")\n\
\ 0))\n"
in
let decls = Parse.program (Reader.read_all ~file:"<verify>" src) in

2
test/test_flan.ml
View File

@ -627,7 +627,7 @@ let () =
rejects_check "a keyword needs an enum"
"(defn g [x i32]) (defn f [] (g :space))" ~needle:"is expected here";
rejects_check "a keyword with no expectation"
"(defn f [] (print-i64 (i64 :space)))" ~needle:"no keyword type";
"(defn f [] (print (i64 :space)))" ~needle:"no keyword type";
rejects_check "a keyword that is not a member"
"(defenum Key [space 32]) (defn g [k Key]) (defn f [] (g :spcae))"
~needle:"has no member :spcae";

2
test/test_repl.ml
View File

@ -105,7 +105,7 @@ let () =
(* A Unit expression is almost always a call made for its effect, so it
has to be *evaluated* and then reported as (). Emitting the literal
without running it made the prompt answer while nothing happened. *)
value "a call made for its effect" "(print-line \"printed\")" "()";
value "a call made for its effect" "(println \"printed\")" "()";
(* The one that proves it ran inside the process: the program increments
[ticks] every frame, so two evaluations of it must disagree. A copy

6
test/test_session.ml
View File

@ -76,9 +76,9 @@ let () =
if c.Session.fns <> [ "bump" ] then
fail "redefining bump reported %s" (String.concat " " c.Session.fns);
(* The prelude is in the checked program and in no accumulated AST, so a
session that derived [known] from declarations would call print-line
session that derived [known] from declarations would call rand-seed
through a registry cell nobody ever publishes. *)
if not (has c.Session.ir "@\"flan.cell.print-line\" = external global ptr") then
if not (has c.Session.ir "@\"flan.cell.rand-seed\" = external global ptr") then
fail "the prelude was treated as new";
if has c.Session.ir "flan_dev_cell" then
fail "a name the host has went through the registry";
@ -248,7 +248,7 @@ let () =
pointing into a mapping the agent then drops — and since the next thunk can
be mapped at the same address, the result is silent garbage rather than a
fault. A module carrying any string constant keeps its mapping. *)
let str = Session.eval_expr t "(print-line \"tuned\")" in
let str = Session.eval_expr t "(println \"tuned\")" in
if not (has str.Session.ir ".str.0") then
fail "the fixture stopped carrying a string constant, so it proves nothing";
if has str.Session.ir "@flan_reload_transient" then