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

Sweep every field label from the colon spelling to the dot

Browse Source 
The script is in tools/ rather than thrown away, because two lanes are
writing Flan in the old spelling right now and their files need the same
pass at merge.

It works on forms, not on text: a keyword becomes a dot only where it sits
in a field-label position inside a brace, so an enum member in value
position, a map key inside an EDN string and a type-position {K V} are all
left alone. :keys keeps its colon -- it names no field.
This commit is contained in:
Joseph Ferano 2026-09-12 14:47:54 +07:00
parent 9669ff23d0
commit 9a820d86cd
52 changed files with 550 additions and 312 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
calc-me.flan
View File

@ -105,7 +105,7 @@
;; ── Whole input, or nothing. Trailing junk is an error, not ignored. ──
(defn evaluate [src [u8]] (Option f64)
(let [c (Cursor {:src src})] ; pos omitted: zeroed
(let [c (Cursor {.src src})] ; pos omitted: zeroed
(let [v (some (parse-expr (addr c) 1))]
(skip-spaces (addr c))
(if (= (peek (addr c)) 0)

2
conditions-play.flan
View File

@ -15,7 +15,7 @@
;;; Two frames under the restart-case, so a transfer has something to cross.
(defn probe [n i32] i32
(signal (AssetMissing {:id n}))
(signal (AssetMissing {.id n}))
100)
(defn middle [n i32] i32

6
examples/core-delta-time.flan
View File

@ -41,9 +41,9 @@
(defer (rl/close-window))
(set current-fps 60)
(set delta-circle (rl/Vector2 {:x 0.0 :y (/ (f32 screen-height) 3.0)}))
(set frame-circle (rl/Vector2 {:x 0.0
:y (* (f32 screen-height) (/ 2.0 3.0))}))
(set delta-circle (rl/Vector2 {.x 0.0 .y (/ (f32 screen-height) 3.0)}))
(set frame-circle (rl/Vector2 {.x 0.0
.y (* (f32 screen-height) (/ 2.0 3.0))}))
(rl/set-target-fps current-fps)

16
examples/core-input-gamepad.flan
View File

@ -92,7 +92,7 @@
(defn draw-pad-background []
(rl/draw-rectangle-rounded
(rl/Rectangle {:x 175.0 :y 110.0 :width 460.0 :height 220.0})
(rl/Rectangle {.x 175.0 .y 110.0 .width 460.0 .height 220.0})
0.3 16 rl/darkgray)
;; The three middle buttons and the four face buttons, as outlines. The
@ -113,10 +113,10 @@
(rl/draw-rectangle 217 176 84 25 rl/black)
(rl/draw-rectangle-rounded
(rl/Rectangle {:x 215.0 :y 98.0 :width 100.0 :height 10.0})
(rl/Rectangle {.x 215.0 .y 98.0 .width 100.0 .height 10.0})
0.5 16 rl/darkgray)
(rl/draw-rectangle-rounded
(rl/Rectangle {:x 495.0 :y 98.0 :width 100.0 :height 10.0})
(rl/Rectangle {.x 495.0 .y 98.0 .width 100.0 .height 10.0})
0.5 16 rl/darkgray))
(defn draw-pad-buttons []
@ -146,11 +146,11 @@
(when (rl/gamepad-button-down? gamepad :left-trigger-1)
(rl/draw-rectangle-rounded
(rl/Rectangle {:x 215.0 :y 98.0 :width 100.0 :height 10.0})
(rl/Rectangle {.x 215.0 .y 98.0 .width 100.0 .height 10.0})
0.5 16 rl/red))
(when (rl/gamepad-button-down? gamepad :right-trigger-1)
(rl/draw-rectangle-rounded
(rl/Rectangle {:x 495.0 :y 98.0 :width 100.0 :height 10.0})
(rl/Rectangle {.x 495.0 .y 98.0 .width 100.0 .height 10.0})
0.5 16 rl/red)))
(defn draw-stick [cx i32 cy i32 ax f32 ay f32 thumb-down bool]
@ -178,9 +178,9 @@
(when (rl/key-pressed? :right) (set gamepad (+ gamepad 1)))
(let [axis-count (min 6 (rl/get-gamepad-axis-count gamepad))
vibrate-rect (rl/Rectangle {:x 10.0
:y (+ 90.0 (* 20.0 (f32 axis-count)))
:width 75.0 :height 24.0})]
vibrate-rect (rl/Rectangle {.x 10.0
.y (+ 90.0 (* 20.0 (f32 axis-count)))
.width 75.0 .height 24.0})]
;; Draw
(rl/begin-drawing)

58
examples/core-input-gestures-testbed.flan
View File

@ -179,7 +179,7 @@
(rl/draw-circle (+ last-x 80) (+ last-y 16) 10.0
(if (= last-gesture :tap) rl/blue rl/lightgray))
;; segments 0 lets raylib pick the count from the radius.
(rl/draw-ring (rl/Vector2 {:x (f32 (+ last-x 103)) :y (f32 (+ last-y 16))})
(rl/draw-ring (rl/Vector2 {.x (f32 (+ last-x 103)) .y (f32 (+ last-y 16))})
6.0 11.0 0.0 360.0 0
(if (= last-gesture :drag) rl/lime rl/lightgray))
(rl/draw-circle (+ last-x 80) (+ last-y 43) 10.0
@ -191,21 +191,21 @@
;; for pinch-in. Counter-clockwise winding, or raylib culls them.
(let [out-c (if (= last-gesture :pinch-out) rl/orange rl/lightgray)
in-c (if (= last-gesture :pinch-in) rl/violet rl/lightgray)]
(rl/draw-triangle (rl/Vector2 {:x (f32 (+ last-x 122)) :y (f32 (+ last-y 16))})
(rl/Vector2 {:x (f32 (+ last-x 137)) :y (f32 (+ last-y 26))})
(rl/Vector2 {:x (f32 (+ last-x 137)) :y (f32 (+ last-y 6))})
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 122)) .y (f32 (+ last-y 16))})
(rl/Vector2 {.x (f32 (+ last-x 137)) .y (f32 (+ last-y 26))})
(rl/Vector2 {.x (f32 (+ last-x 137)) .y (f32 (+ last-y 6))})
out-c)
(rl/draw-triangle (rl/Vector2 {:x (f32 (+ last-x 147)) :y (f32 (+ last-y 6))})
(rl/Vector2 {:x (f32 (+ last-x 147)) :y (f32 (+ last-y 26))})
(rl/Vector2 {:x (f32 (+ last-x 162)) :y (f32 (+ last-y 16))})
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 147)) .y (f32 (+ last-y 6))})
(rl/Vector2 {.x (f32 (+ last-x 147)) .y (f32 (+ last-y 26))})
(rl/Vector2 {.x (f32 (+ last-x 162)) .y (f32 (+ last-y 16))})
out-c)
(rl/draw-triangle (rl/Vector2 {:x (f32 (+ last-x 125)) :y (f32 (+ last-y 33))})
(rl/Vector2 {:x (f32 (+ last-x 125)) :y (f32 (+ last-y 53))})
(rl/Vector2 {:x (f32 (+ last-x 140)) :y (f32 (+ last-y 43))})
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 125)) .y (f32 (+ last-y 33))})
(rl/Vector2 {.x (f32 (+ last-x 125)) .y (f32 (+ last-y 53))})
(rl/Vector2 {.x (f32 (+ last-x 140)) .y (f32 (+ last-y 43))})
in-c)
(rl/draw-triangle (rl/Vector2 {:x (f32 (+ last-x 144)) :y (f32 (+ last-y 43))})
(rl/Vector2 {:x (f32 (+ last-x 159)) :y (f32 (+ last-y 53))})
(rl/Vector2 {:x (f32 (+ last-x 159)) :y (f32 (+ last-y 33))})
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 144)) .y (f32 (+ last-y 43))})
(rl/Vector2 {.x (f32 (+ last-x 159)) .y (f32 (+ last-y 53))})
(rl/Vector2 {.x (f32 (+ last-x 159)) .y (f32 (+ last-y 33))})
in-c))
;; Four pips, one per simultaneous touch raylib reports.
@ -223,8 +223,8 @@
(if (= i 0) gesture-color rl/lightgray))))
;; The two mode buttons. Maroon means the mode that button controls is on.
(let [b1 (rl/Rectangle {:x 53.0 :y 7.0 :width 48.0 :height 26.0})
b2 (rl/Rectangle {:x 108.0 :y 7.0 :width 36.0 :height 26.0})]
(let [b1 (rl/Rectangle {.x 53.0 .y 7.0 .width 48.0 .height 26.0})
b2 (rl/Rectangle {.x 108.0 .y 7.0 .width 36.0 .height 26.0})]
(rl/draw-rectangle-rec b1 (if (or (= log-mode 1) (= log-mode 3))
rl/maroon rl/gray))
(rl/draw-text "Hide" 60 10 10 rl/white)
@ -242,16 +242,16 @@
(d/draw-f32 current-angle 2 (+ (i32 prot-x) 55) (+ (i32 prot-y) 92) 20
gesture-color)
(rl/draw-circle-v (rl/Vector2 {:x prot-x :y prot-y}) 80.0 rl/white)
(rl/draw-line-ex (rl/Vector2 {:x (- prot-x 90.0) :y prot-y})
(rl/Vector2 {:x (+ prot-x 90.0) :y prot-y}) 3.0 rl/lightgray)
(rl/draw-line-ex (rl/Vector2 {:x prot-x :y (- prot-y 90.0)})
(rl/Vector2 {:x prot-x :y (+ prot-y 90.0)}) 3.0 rl/lightgray)
(rl/draw-line-ex (rl/Vector2 {:x (- prot-x 80.0) :y (- prot-y 45.0)})
(rl/Vector2 {:x (+ prot-x 80.0) :y (+ prot-y 45.0)}) 3.0
(rl/draw-circle-v (rl/Vector2 {.x prot-x .y prot-y}) 80.0 rl/white)
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 90.0) .y prot-y})
(rl/Vector2 {.x (+ prot-x 90.0) .y prot-y}) 3.0 rl/lightgray)
(rl/draw-line-ex (rl/Vector2 {.x prot-x .y (- prot-y 90.0)})
(rl/Vector2 {.x prot-x .y (+ prot-y 90.0)}) 3.0 rl/lightgray)
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 80.0) .y (- prot-y 45.0)})
(rl/Vector2 {.x (+ prot-x 80.0) .y (+ prot-y 45.0)}) 3.0
rl/green)
(rl/draw-line-ex (rl/Vector2 {:x (- prot-x 80.0) :y (+ prot-y 45.0)})
(rl/Vector2 {:x (+ prot-x 80.0) :y (- prot-y 45.0)}) 3.0
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 80.0) .y (+ prot-y 45.0)})
(rl/Vector2 {.x (+ prot-x 80.0) .y (- prot-y 45.0)}) 3.0
rl/green)
(rl/draw-text "0" (+ (i32 prot-x) 96) (- (i32 prot-y) 9) 20 rl/black)
@ -267,9 +267,9 @@
;; against cos feeding y is what rotates it the way the dial is labelled.
(unless (= current-angle 0.0)
(let [rad (/ (* (+ current-angle 90.0) pi) 180.0)]
(rl/draw-line-ex (rl/Vector2 {:x prot-x :y prot-y})
(rl/Vector2 {:x (+ (* angle-length (sin-f32 rad)) prot-x)
:y (+ (* angle-length (cos-f32 rad)) prot-y)})
(rl/draw-line-ex (rl/Vector2 {.x prot-x .y prot-y})
(rl/Vector2 {.x (+ (* angle-length (sin-f32 rad)) prot-x)
.y (+ (* angle-length (cos-f32 rad)) prot-y)})
3.0 gesture-color))))
(defn main []
@ -285,8 +285,8 @@
(rl/set-target-fps 60)
(let [b1 (rl/Rectangle {:x 53.0 :y 7.0 :width 48.0 :height 26.0})
b2 (rl/Rectangle {:x 108.0 :y 7.0 :width 36.0 :height 26.0})]
(let [b1 (rl/Rectangle {.x 53.0 .y 7.0 .width 48.0 .height 26.0})
b2 (rl/Rectangle {.x 108.0 .y 7.0 .width 36.0 .height 26.0})]
(until (rl/window-should-close?)
;; Update
(let [g (rl/get-gesture-detected)

6
examples/core-input-gestures.flan
View File

@ -59,9 +59,9 @@
(rl/set-target-fps 60)
(let [touch-area (rl/Rectangle {:x 220.0 :y 10.0
:width (- (f32 screen-width) 230.0)
:height (- (f32 screen-height) 20.0)})]
(let [touch-area (rl/Rectangle {.x 220.0 .y 10.0
.width (- (f32 screen-width) 230.0)
.height (- (f32 screen-height) 20.0)})]
(until (rl/window-should-close?)
;; Update
(set last-gesture current-gesture)

4
examples/core-input-keys.flan
View File

@ -26,8 +26,8 @@
"raylib [core] example - input keys")
(defer (rl/close-window))
(set ball (rl/Vector2 {:x (f32 (/ screen-width 2))
:y (f32 (/ screen-height 2))}))
(set ball (rl/Vector2 {.x (f32 (/ screen-width 2))
.y (f32 (/ screen-height 2))}))
(rl/set-target-fps 60)

44
examples/core-input-virtual-controls.flan
View File

@ -58,10 +58,10 @@
;; it on each axis. The C computes these at run time from padPosition; they are
;; written out here because a defconst is compile-time and the numbers are.
(defconst button-positions [button-max rl/Vector2]
[(rl/Vector2 {:x 100.0 :y 305.0}) ; up
(rl/Vector2 {:x 55.0 :y 350.0}) ; left
(rl/Vector2 {:x 145.0 :y 350.0}) ; right
(rl/Vector2 {:x 100.0 :y 395.0})]) ; down
[(rl/Vector2 {.x 100.0 .y 305.0}) ; up
(rl/Vector2 {.x 55.0 .y 350.0}) ; left
(rl/Vector2 {.x 145.0 .y 350.0}) ; right
(rl/Vector2 {.x 100.0 .y 395.0})]) ; down
(defconst player-speed f32 75.0)
@ -70,8 +70,8 @@
(defvar player rl/Vector2)
(defn reset-player []
(set player (rl/Vector2 {:x (/ (f32 screen-width) 2.0)
:y (/ (f32 screen-height) 2.0)})))
(set player (rl/Vector2 {.x (/ (f32 screen-width) 2.0)
.y (/ (f32 screen-height) 2.0)})))
(defn abs-f32 [v f32] f32
(max v (- 0.0 v)))
@ -130,24 +130,24 @@
;; [4 [3 rl/Vector2]]: a fixed array of fixed arrays of a struct, which is the
;; deepest shape any of these ten examples asks for and which works.
(defconst arrow-tris [button-max [3 rl/Vector2]]
[[(rl/Vector2 {:x 100.0 :y 293.0})
(rl/Vector2 {:x 91.0 :y 314.0})
(rl/Vector2 {:x 109.0 :y 314.0})]
[(rl/Vector2 {:x 64.0 :y 341.0})
(rl/Vector2 {:x 43.0 :y 350.0})
(rl/Vector2 {:x 64.0 :y 359.0})]
[(rl/Vector2 {:x 157.0 :y 350.0})
(rl/Vector2 {:x 136.0 :y 341.0})
(rl/Vector2 {:x 136.0 :y 359.0})]
[(rl/Vector2 {:x 91.0 :y 386.0})
(rl/Vector2 {:x 100.0 :y 407.0})
(rl/Vector2 {:x 109.0 :y 386.0})]])
[[(rl/Vector2 {.x 100.0 .y 293.0})
(rl/Vector2 {.x 91.0 .y 314.0})
(rl/Vector2 {.x 109.0 .y 314.0})]
[(rl/Vector2 {.x 64.0 .y 341.0})
(rl/Vector2 {.x 43.0 .y 350.0})
(rl/Vector2 {.x 64.0 .y 359.0})]
[(rl/Vector2 {.x 157.0 .y 350.0})
(rl/Vector2 {.x 136.0 .y 341.0})
(rl/Vector2 {.x 136.0 .y 359.0})]
[(rl/Vector2 {.x 91.0 .y 386.0})
(rl/Vector2 {.x 100.0 .y 407.0})
(rl/Vector2 {.x 109.0 .y 386.0})]])
(defconst label-colors [button-max rl/Color]
[(rl/Color {:r 253 :g 249 :b 0 :a 255}) ; yellow, up
(rl/Color {:r 0 :g 121 :b 241 :a 255}) ; blue, left
(rl/Color {:r 230 :g 41 :b 55 :a 255}) ; red, right
(rl/Color {:r 0 :g 228 :b 48 :a 255})]) ; green, down
[(rl/Color {.r 253 .g 249 .b 0 .a 255}) ; yellow, up
(rl/Color {.r 0 .g 121 .b 241 .a 255}) ; blue, left
(rl/Color {.r 230 .g 41 .b 55 .a 255}) ; red, right
(rl/Color {.r 0 .g 228 .b 48 .a 255})]) ; green, down
(defn main []
(rl/init-window screen-width screen-height

2
lib/ast.ml
View File

@ -46,7 +46,7 @@ and expr_kind =
| Field of expr * string (* (.pos c) — auto-derefs one level *)
| Call of expr * expr list
| Match of expr * arm list
| Struct of string * (string * expr) list (* (Cursor {:src s}) *)
| Struct of string * (string * expr) list (* (Cursor {.src s}) *)
| Arr of expr list (* [0xE6B800FF ...] — a fixed array value *)
(* These bind names or alter control flow, so none of them can be a call. *)
| Fn of string list * expr list (* (fn [x y] ...) — non-escaping *)

2
lib/check.ml
View File

@ -2486,7 +2486,7 @@ and named_call ctx ~want loc name args =
if Hashtbl.mem ctx.env.structs name || Hashtbl.mem ctx.env.unions name
then
fail loc
"%s is a type — a struct value is written (%s {:field value ...})"
"%s is a type — a struct value is written (%s {.field value ...})"
name name
else if String.contains name '/' then
unimplemented loc

3
lib/form.ml
View File

@ -17,7 +17,8 @@ and value =
| Byte of int (* \space \0 \( (0..255) *)
| List of t list (* (f x) *)
| Vec of t list (* [1 2 3] and every binding/type bracket *)
| Map of t list (* {:key v} in value position, {K V} in type position *)
| Map of t list (* {.field v} a struct value, {K V} a type. The
colon spelling is left for map literals. *)
let make v loc = { v; loc }

28
lib/prelude.ml
View File

@ -526,10 +526,10 @@ let source = {flan|
(defn decode-rune [s [u8]] Rune
(when (= (len s) 0)
(return (Rune {:code 0 :width 0 :ok false})))
(return (Rune {.code 0 .width 0 .ok false})))
(let [b0 (at s 0)]
(when (< b0 0x80)
(return (Rune {:code (i32 b0) :width 1 :ok true})))
(return (Rune {.code (i32 b0) .width 1 .ok true})))
;; size 0 means "this byte cannot lead"; lo/hi are the *second* byte's
;; accepted range, which is the only place the overlong and surrogate
;; rules live. Bytes three and four are always 0x80..0xbf.
@ -548,34 +548,34 @@ let source = {flan|
(= b0 0xf4) (do (set size 4) (set hi (u8 0x8f)))
:else (set size 0))
(when (= size 0)
(return (Rune {:code 0 :width 1 :ok false})))
(return (Rune {.code 0 .width 1 .ok false})))
;; A sequence cut off by the end of the slice. Width 1, so a caller
;; scanning a buffer boundary makes progress instead of stalling.
(when (> size (len s))
(return (Rune {:code 0 :width 1 :ok false})))
(return (Rune {.code 0 .width 1 .ok false})))
(let [b1 (at s 1)]
(when (or (< b1 lo) (> b1 hi))
(return (Rune {:code 0 :width 1 :ok false})))
(return (Rune {.code 0 .width 1 .ok false})))
(when (= size 2)
(return (Rune {:code (bit-or (<< (i32 (bit-and b0 0x1f)) 6)
(return (Rune {.code (bit-or (<< (i32 (bit-and b0 0x1f)) 6)
(i32 (bit-and b1 0x3f)))
:width 2 :ok true})))
.width 2 .ok true})))
(let [b2 (at s 2)]
(when (or (< b2 0x80) (> b2 0xbf))
(return (Rune {:code 0 :width 1 :ok false})))
(return (Rune {.code 0 .width 1 .ok false})))
(when (= size 3)
(return (Rune {:code (bit-or (bit-or (<< (i32 (bit-and b0 0x0f)) 12)
(return (Rune {.code (bit-or (bit-or (<< (i32 (bit-and b0 0x0f)) 12)
(<< (i32 (bit-and b1 0x3f)) 6))
(i32 (bit-and b2 0x3f)))
:width 3 :ok true})))
.width 3 .ok true})))
(let [b3 (at s 3)]
(when (or (< b3 0x80) (> b3 0xbf))
(return (Rune {:code 0 :width 1 :ok false})))
(Rune {:code (bit-or (bit-or (<< (i32 (bit-and b0 0x07)) 18)
(return (Rune {.code 0 .width 1 .ok false})))
(Rune {.code (bit-or (bit-or (<< (i32 (bit-and b0 0x07)) 18)
(bit-or (<< (i32 (bit-and b1 0x3f)) 12)
(<< (i32 (bit-and b2 0x3f)) 6)))
(i32 (bit-and b3 0x3f)))
:width 4 :ok true})))))))
.width 4 .ok true})))))))
;; Decode at a byte offset. None when the offset is not on a rune boundary or
;; the bytes there are malformed, which is stricter than Odin's rune_at — that
@ -683,7 +683,7 @@ let source = {flan|
(defstruct Split [rest [u8] sep u8 more bool])
(defn split-on-byte [s [u8] sep u8] Split
(Split {:rest s :sep sep :more true}))
(Split {.rest s .sep sep .more true}))
(defn split-next! [it (Ptr Split)] (Option [u8])
(when (not (.more it))

112
sand.flan
View File

@ -101,7 +101,7 @@
;; over a mutable scan position, which is what a while loop is.
(defn settle [row i32 col i32]
(let [vel (+ gravity (at velocity row col))
some-point (rl/Vector2 {:x 15.0 :y 12})
some-point (rl/Vector2 {.x 15.0 .y 12})
y (min (- rows 1) (+ row (i32 vel)))]
(while (> y row)
(when (empty-at? y col)
@ -217,18 +217,18 @@
(let [m (rl/get-mouse-position)
frame (f32 (if (rl/mouse-button-down? :left) 8.0 0.0))]
(rl/draw-texture-rec brush
(rl/Rectangle {:x frame :y 0.0 :width 8.0 :height 8.0})
(rl/Vector2 {:x (- (.x m) 4.0) :y (- (.y m) 4.0)})
(rl/Rectangle {.x frame .y 0.0 .width 8.0 .height 8.0})
(rl/Vector2 {.x (- (.x m) 4.0) .y (- (.y m) 4.0)})
rl/white)
(rl/draw-texture brush 20 50 rl/white)
(rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0})
(rl/draw-texture-v brush (rl/Vector2 {.x 44.0 .y 50.0})
(rl/get-color (at colors current-color)))
(rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white)))
(rl/draw-texture-ex brush (rl/Vector2 {.x 72.0 .y 46.0}) 0.0 2.0 rl/white)))
;; The mirrored one beside them, scaled up so the flip is visible rather
;; than eight pixels wide. If the two badges look the same, either the flip
;; did nothing or the upload took the unedited buffer.
(when brush-mirrored-ok
(rl/draw-texture-ex brush-mirrored (rl/Vector2 {:x 110.0 :y 46.0})
(rl/draw-texture-ex brush-mirrored (rl/Vector2 {.x 110.0 .y 46.0})
0.0 2.0 rl/white)))
;; ── Sound ──────────────────────────────────────────────────────────
@ -281,9 +281,9 @@
(unless audio-ok
(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
:data (addr (at tone-pcm 0))})]
(let [w (rl/Wave {.frame-count (u32 tone-frames) .sample-rate (u32 tone-rate)
.sample-size 16 .channels 1
.data (addr (at tone-pcm 0))})]
(when audio-ok
(set tone (rl/load-sound-from-wave w))
(set tone-ok (rl/sound-valid? tone))
@ -376,16 +376,16 @@
;; A fresh (Camera2D {}) has a zoom of 0, which is singular: both conversions
;; hand back NaN and nothing draws. 1.0 is the identity.
(defn reset-view []
(set view (rl/Camera2D {:offset (rl/Vector2 {:x 0.0 :y 0.0})
:target (rl/Vector2 {:x 0.0 :y 0.0})
:rotation 0.0
:zoom 1.0})))
(set view (rl/Camera2D {.offset (rl/Vector2 {.x 0.0 .y 0.0})
.target (rl/Vector2 {.x 0.0 .y 0.0})
.rotation 0.0
.zoom 1.0})))
(defn set-view [target-x f32 target-y f32 zoom f32]
(set view (rl/Camera2D {:offset (.offset view)
:target (rl/Vector2 {:x target-x :y target-y})
:rotation (.rotation view)
:zoom zoom})))
(set view (rl/Camera2D {.offset (.offset view)
.target (rl/Vector2 {.x target-x .y target-y})
.rotation (.rotation view)
.zoom zoom})))
;; Panning is world units per second and zooming is a factor per second, so
;; neither changes with the frame rate. That is the whole of what
@ -482,12 +482,12 @@
(rl/draw-circle-lines-v p (+ r (f32 6.0)) tint)
;; A crosshair: two thin lines and one thick one, which is three separate
;; raylib calls with three different shapes of argument.
(rl/draw-line-v (rl/Vector2 {:x (- x r) :y y})
(rl/Vector2 {:x (+ x r) :y y}) tint)
(rl/draw-line-v (rl/Vector2 {:x x :y (- y r)})
(rl/Vector2 {:x x :y (+ y r)}) tint)
(rl/draw-line-ex (rl/Vector2 {:x (- x (f32 4.0)) :y y})
(rl/Vector2 {:x (+ x (f32 4.0)) :y y}) (f32 3.0) rl/white)
(rl/draw-line-v (rl/Vector2 {.x (- x r) .y y})
(rl/Vector2 {.x (+ x r) .y y}) tint)
(rl/draw-line-v (rl/Vector2 {.x x .y (- y r)})
(rl/Vector2 {.x x .y (+ y r)}) tint)
(rl/draw-line-ex (rl/Vector2 {.x (- x (f32 4.0)) .y y})
(rl/Vector2 {.x (+ x (f32 4.0)) .y y}) (f32 3.0) rl/white)
;; The exact world point: a filled dot, and one pixel of white on top of
;; it. Both are the Vector2 forms, so they land where the ring's centre
;; is and not somewhere an integer cast put them.
@ -496,16 +496,16 @@
;; A pointer above the cursor. Counter-clockwise, because raylib culls the
;; other winding and draws nothing — which looks exactly like a broken
;; binding and is why the outline is drawn over it as a control.
(let [tip (rl/Vector2 {:x x :y (- y (+ r (f32 26.0)))})
left (rl/Vector2 {:x (- x (f32 12.0)) :y (- y (+ r (f32 6.0)))})
rght (rl/Vector2 {:x (+ x (f32 12.0)) :y (- y (+ r (f32 6.0)))})]
(let [tip (rl/Vector2 {.x x .y (- y (+ r (f32 26.0)))})
left (rl/Vector2 {.x (- x (f32 12.0)) .y (- y (+ r (f32 6.0)))})
rght (rl/Vector2 {.x (+ x (f32 12.0)) .y (- y (+ r (f32 6.0)))})]
(rl/draw-triangle tip left rght tint)
(rl/draw-triangle-lines tip left rght rl/white))
;; And the world's own edge, so panning has something to pan against.
(rl/draw-rectangle-lines-ex
(rl/Rectangle {:x 0.0 :y 0.0
:width (f32 screen-width)
:height (f32 screen-height)})
(rl/Rectangle {.x 0.0 .y 0.0
.width (f32 screen-width)
.height (f32 screen-height)})
(f32 2.0) (rl/get-color 0x303030FF))))
;; Drawn outside the camera, in screen pixels, so it stays put while the world
@ -532,8 +532,8 @@
h 72
x 24
y (- (rl/get-screen-height) (+ h 24))
panel (rl/Rectangle {:x (f32 (- x 12)) :y (f32 (- y 12))
:width (f32 (+ w 24)) :height (f32 (+ h 24))})]
panel (rl/Rectangle {.x (f32 (- x 12)) .y (f32 (- y 12))
.width (f32 (+ w 24)) .height (f32 (+ h 24))})]
(rl/draw-rectangle-rounded panel (f32 0.2) 8 (rl/get-color 0x101018E0))
;; Both outline forms, one inside the other: the plain one has no
;; thickness in raylib 5.5 and the -ex one is where thickness went.
@ -541,7 +541,7 @@
(rl/draw-rectangle-rounded-lines-ex panel (f32 0.2) 8 (f32 2.0)
(rl/get-color 0x6060A0FF))
(if hud-font-ok
(rl/draw-text-ex hud-font title (rl/Vector2 {:x (f32 x) :y (f32 y)})
(rl/draw-text-ex hud-font title (rl/Vector2 {.x (f32 x) .y (f32 y)})
30.0 4.0 rl/white)
(rl/draw-text title x y 30 rl/white))
(rl/draw-text keys x (+ y 40) 20 (rl/get-color 0xA0A0B0FF))
@ -565,8 +565,8 @@
(let [cp (+ 48 current-color)]
(when (> (rl/get-glyph-index hud-font cp) 0)
(rl/draw-text-codepoint hud-font cp
(rl/Vector2 {:x (f32 (- sw 24))
:y (f32 (- sh 96))})
(rl/Vector2 {.x (f32 (- sw 24))
.y (f32 (- sh 96))})
30.0 rl/white))))
;; A zoom read-out with no number in it, because there is no string
@ -577,11 +577,11 @@
(let [bx (f32 (- sw 220))
by (f32 (- sh 60))
fill (* (f32 200.0) (min (f32 1.0) (/ (.zoom view) (f32 8.0))))]
(rl/draw-rectangle-rec (rl/Rectangle {:x bx :y by :width (f32 200.0)
:height (f32 10.0)})
(rl/draw-rectangle-rec (rl/Rectangle {.x bx .y by .width (f32 200.0)
.height (f32 10.0)})
(rl/get-color 0x202028FF))
(rl/draw-rectangle-v (rl/Vector2 {:x bx :y by})
(rl/Vector2 {:x fill :y (f32 10.0)})
(rl/draw-rectangle-v (rl/Vector2 {.x bx .y by})
(rl/Vector2 {.x fill .y (f32 10.0)})
(rl/get-color 0x6060A0FF))
(rl/draw-rectangle-lines (- sw 220) (- sh 60) 200 10
(rl/get-color 0x8080C0FF))
@ -600,7 +600,7 @@
(rl/draw-ellipse ex ey (f32 26.0) (f32 12.0) (rl/get-color 0x303040FF))
(rl/draw-ellipse-lines ex ey (f32 26.0) (f32 12.0)
(rl/get-color 0x8080C0FF))
(rl/draw-ring-lines (rl/Vector2 {:x (f32 ex) :y (f32 ey)})
(rl/draw-ring-lines (rl/Vector2 {.x (f32 ex) .y (f32 ey)})
(f32 30.0) (f32 34.0) spin (+ spin (f32 270.0)) 32
rl/white)))))
@ -628,19 +628,19 @@
;; separates "centred stick" from "no pad" — both of which are a dot in
;; the middle otherwise.
(rl/draw-circle-lines (i32 ox) (i32 oy) r (rl/get-color 0x6060A0FF))
(let [p (rl/Vector2 {:x (+ ox (* (rl/get-gamepad-axis-movement 0 :left-x) r))
:y (+ oy (* (rl/get-gamepad-axis-movement 0 :left-y) r))})]
(let [p (rl/Vector2 {.x (+ ox (* (rl/get-gamepad-axis-movement 0 :left-x) r))
.y (+ oy (* (rl/get-gamepad-axis-movement 0 :left-y) r))})]
(rl/draw-circle-v p (f32 5.0) rl/white))
;; The two triggers as bars of different lengths, so exchanging them is
;; visible. They rest at -1 and not at 0, which raylib does not
;; normalise and neither does this — hence the +1.
(let [lt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :left-trigger))
rt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :right-trigger))]
(rl/draw-rectangle-v (rl/Vector2 {:x (+ ox (f32 46.0)) :y (- oy (f32 12.0))})
(rl/Vector2 {:x (* lt (f32 30.0)) :y (f32 8.0)})
(rl/draw-rectangle-v (rl/Vector2 {.x (+ ox (f32 46.0)) .y (- oy (f32 12.0))})
(rl/Vector2 {.x (* lt (f32 30.0)) .y (f32 8.0)})
(rl/get-color 0x8080C0FF))
(rl/draw-rectangle-v (rl/Vector2 {:x (+ ox (f32 46.0)) :y (+ oy (f32 4.0))})
(rl/Vector2 {:x (* rt (f32 50.0)) :y (f32 8.0)})
(rl/draw-rectangle-v (rl/Vector2 {.x (+ ox (f32 46.0)) .y (+ oy (f32 4.0))})
(rl/Vector2 {.x (* rt (f32 50.0)) .y (f32 8.0)})
(rl/get-color 0x8080C0FF)))
;; One pip per axis the pad reports, and one per face button that is
;; NOT up — gamepad-button-up? rather than -down? so the negative form
@ -661,8 +661,8 @@
(rl/draw-circle-lines-v (rl/get-touch-position i) (f32 18.0)
(rl/get-color 0xA0A0FFFF))
(rl/draw-pixel (rl/get-touch-x) (rl/get-touch-y) rl/white)
(rl/draw-pixel-v (rl/Vector2 {:x (f32 (rl/get-touch-point-id i))
:y (f32 4.0)})
(rl/draw-pixel-v (rl/Vector2 {.x (f32 (rl/get-touch-point-id i))
.y (f32 4.0)})
rl/white))
;; And the gesture, if any: a bar as long as the hold has lasted, and the
@ -673,14 +673,14 @@
8 rl/white)
(when (rl/gesture-detected? :drag)
(let [d (rl/get-gesture-drag-vector)]
(rl/draw-line-v (rl/Vector2 {:x ox :y oy})
(rl/Vector2 {:x (+ ox (* (.x d) (f32 200.0)))
:y (+ oy (* (.y d) (f32 200.0)))})
(rl/draw-line-v (rl/Vector2 {.x ox .y oy})
(rl/Vector2 {.x (+ ox (* (.x d) (f32 200.0)))
.y (+ oy (* (.y d) (f32 200.0)))})
(rl/get-color 0xFFC000FF))))
(when (rl/gesture-detected? :pinch-in)
(let [q (rl/get-gesture-pinch-vector)]
(rl/draw-circle-v (rl/Vector2 {:x (+ ox (* (.x q) (f32 200.0)))
:y (+ oy (* (.y q) (f32 200.0)))})
(rl/draw-circle-v (rl/Vector2 {.x (+ ox (* (.x q) (f32 200.0)))
.y (+ oy (* (.y q) (f32 200.0)))})
(f32 4.0) rl/white))))))
(defn draw-world []
@ -706,10 +706,10 @@
;; screen and nothing else changes.
(if scene-ok
(rl/draw-texture-rec (.texture scene)
(rl/Rectangle {:x 0.0 :y 0.0
:width (f32 screen-width)
:height (f32 (- 0 screen-height))})
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Rectangle {.x 0.0 .y 0.0
.width (f32 screen-width)
.height (f32 (- 0 screen-height))})
(rl/Vector2 {.x 0.0 .y 0.0})
rl/white)
(draw-world))
;; And everything after it is in screen pixels again.

8
syntax-sketch.flan
View File

@ -100,8 +100,8 @@
(let [text (try (read-file path))
table (try (parse-toml text))
port (try (ok-or (get table "port")
(MissingKey {:key "port"})))]
(Ok (Config {:port port}))))
(MissingKey {.key "port"})))]
(Ok (Config {.port port}))))
;; errdefer runs only on the Result failure path — NOT on a restart transfer
;; (spec-conditions.md §5). Pairs with explicit allocation.
@ -109,7 +109,7 @@
(let [buf (alloc-image context/allocator)]
(errdefer (free buf))
(try (decode-png path buf))
(Ok (Atlas {:image buf}))))
(Ok (Atlas {.image buf}))))
;; ── Conditions: handlers run on the signalling frame, nothing unwinds ─
;; load-texture cannot know the right recovery — an editor wants a placeholder,
@ -125,7 +125,7 @@
(if (file-exists? path)
(rl/load-texture path)
(restart-case
(do (signal (AssetMissing {:path path}))
(do (signal (AssetMissing {.path path}))
(abort "unhandled AssetMissing"))
(use-placeholder [] placeholder-texture)
(retry [] (load-texture path)))))

2
test/programs/agent-longname.flan
View File

@ -11,5 +11,5 @@
(defn main [] i32
;; The path is overridden by FLAN_AGENT_SOCKET; a program has to name one.
(agent/start "/tmp/flan-longname.sock")
(error (MissingYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY {:id 1}))
(error (MissingYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY {.id 1}))
0)

4
test/programs/break.flan
View File

@ -10,7 +10,7 @@
(defn fetch [n i32] i32
(restart-case
(do (error (Missing {:id n})) 0)
(do (error (Missing {.id n})) 0)
(use-placeholder [] -1)
(retry [] 7)))
@ -21,7 +21,7 @@
;;; file that by-name lookup cannot produce.
(defn shadowed [n i32] i32
(restart-case
(+ (restart-case (do (error (Missing {:id n})) 0)
(+ (restart-case (do (error (Missing {.id n})) 0)
(retry [] 5))
100)
(retry [] 900)))

2
test/programs/cleanup.flan
View File

@ -26,7 +26,7 @@
;;; and (6) a handler-bind with two clauses has to pop both, innermost-first.
;;; If either leaks, the stack keeps a frame pointing into a function that has
;;; gone, and the next signal calls into it.
(defn deep [] i32 (signal (Missing {:id 1})) 0)
(defn deep [] i32 (signal (Missing {.id 1})) 0)
(defn leaky [] i32
(restart-case

8
test/programs/conditions.flan
View File

@ -13,9 +13,9 @@
;;; Signals twice and keeps going both times — that is the whole of §1.
(defn load-all []
(signal (AssetMissing {:id 1}))
(signal (AssetMissing {:id 2}))
(signal (Corrupt {:id 3})))
(signal (AssetMissing {.id 1}))
(signal (AssetMissing {.id 2}))
(signal (Corrupt {.id 3})))
(defn main [] i32
;; No handler: a no-op, not an abort and not a message (§2).
@ -36,7 +36,7 @@
;; 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}))))
(signal (Corrupt {.id 0}))))
(print other) (println "") ; 3 + 1000 + 100 = 1103
;; And the stack is back to what it was: no handler, no effect.

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

@ -16,7 +16,7 @@
bump))
(defn main [] i32
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
(let [c (Cell {.alive true .heat 3.25 .id 7 .name "grain"})]
(let [r (tick (addr c) 41)]
(print r) (println "")
(print (.heat c)) (println "")

2
test/programs/debug.flan
View File

@ -21,7 +21,7 @@
bump))
(defn main [] i32
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
(let [c (Cell {.alive true .heat 3.25 .id 7 .name "grain"})]
(let [r (tick (addr c) 41)]
(print r) (println "")
(print (.heat c)) (println "")

22
test/programs/destructure.flan
View File

@ -20,7 +20,7 @@
(defn make-point [] Point
(set calls (+ calls 1))
(Point {:x 3 :y 4}))
(Point {.x 3 .y 4}))
(defn show2 [label string a i32 b i32]
(print label)
@ -32,24 +32,24 @@
(defn main [] i32
;; :keys, the common case: one name per field, spelled as the field is.
(let [{:keys [x y]} (Point {:x 1 :y 2})]
(let [{:keys [x y]} (Point {.x 1 .y 2})]
(show2 "keys" x y))
;; The pair form, which is what renames and what nests — a :keys entry is a
;; field name and never a pattern.
(let [{a :x b :y} (Point {:x 10 :y 20})]
(let [{a .x b .y} (Point {.x 10 .y 20})]
(show2 "pairs" a b))
(let [l (Line {:a (Point {:x 5 :y 6}) :b (Point {:x 7 :y 8})})]
(let [{{:keys [x y]} :b} l]
(let [l (Line {.a (Point {.x 5 .y 6}) .b (Point {.x 7 .y 8})})]
(let [{{:keys [x y]} .b} l]
(show2 "nested" x y))
;; A pattern may shadow the very name it destructures, because the value is
;; read into a temporary before any of the names are bound.
(let [{l :a} l]
(let [{l .a} l]
(show2 "shadow" (.x l) (.y l))))
;; A later binding sees an earlier pattern's names, as in any let.
(let [{:keys [x]} (Point {:x 100 :y 0})
(let [{:keys [x]} (Point {.x 100 .y 0})
doubled (* x 2)]
(show2 "sequential" x doubled))
@ -81,15 +81,15 @@
(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})]
[{:keys [x]} {y :y}] ps]
(let [ps [(Point {.x 1 .y 2}) (Point {.x 3 .y 4})]
[{:keys [x]} {y .y}] ps]
(show2 "nested-in-array" x y))
;; A tail of something wider than a machine word. The corpus slices arrays of
;; i32, u8 and f32 and nothing else, so this is the one place the desugared
;; (slice xs n (len xs)) has to get a struct's stride right rather than a
;; scalar's.
(let [ps [(Point {:x 1 :y 2}) (Point {:x 3 :y 4}) (Point {:x 5 :y 6})]
(let [ps [(Point {.x 1 .y 2}) (Point {.x 3 .y 4}) (Point {.x 5 .y 6})]
[first & others] ps]
(print "struct-tail ")
(print (.x first)) (print " ")
@ -100,7 +100,7 @@
;; 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)]
{a .x b .y} (make-point)]
(print "calls ")
(print calls) (print " ")
(print (+ x (+ y (+ a b))))

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

@ -14,7 +14,7 @@
(defn fetch [n i32] i32
(restart-case
(do (error (Missing {:id n})) 0)
(do (error (Missing {.id n})) 0)
(use-placeholder [] -1)
(retry [] 7)))

4
test/programs/dev-locals.flan
View File

@ -12,11 +12,11 @@
(defstruct Boom [why i32])
(defn look [n i64 label string] i64
(let [p (Point {:x 1.5 :y 2.5})
(let [p (Point {.x 1.5 .y 2.5})
xs [10 20 30]
flag (> n 0)]
(restart-case
(do (error (Boom {:why 7}))
(do (error (Boom {.why 7}))
;; Never reached before the break, so [after] is a slot with nothing
;; in it: the frame records a null for it and this is what "not bound
;; yet" has to mean.

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

@ -12,7 +12,7 @@
(defstruct Missing [id i32])
(defn probe [] i64
(signal (Missing {:id 1}))
(signal (Missing {.id 1}))
0)
(defn step [] i64

2
test/programs/edn.flan
View File

@ -82,7 +82,7 @@
;; rather than being returned, which is why this can be a straight line of
;; assignments with one test at the end.
(defn read-enemy [c (Ptr edn/Cursor)] Enemy
(let [e (Enemy {:hp 0 :speed 0.0 :boss? false})]
(let [e (Enemy {.hp 0 .speed 0.0 .boss? false})]
(edn/expect c edn/tok-map-open)
(while (edn/ok? c)
(let [k (edn/next c)]

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

@ -22,6 +22,6 @@
(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})]
(let [s (S {.k :hi})]
(println (if (= (.k s) :hi) "field eq yes" "field eq no")))
0)

2
test/programs/error.flan
View File

@ -10,5 +10,5 @@
;; 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] (println "handler ran"))]
(error (AssetMissing {:id 1})))
(error (AssetMissing {.id 1})))
0)

4
test/programs/machine.flan
View File

@ -31,10 +31,10 @@
(set total (sum-grid))
(print total) (println "") ; 12
(print (at pal 2)) (println "") ; 30
(let [p (P {:x 1 :y 2})] ; :y omitted is zeroed
(let [p (P {.x 1 .y 2})] ; :y omitted is zeroed
(bump (addr p))
(print (.x p)) (println "") ; 2
(let [l (Line {:a p})]
(let [l (Line {.a p})]
(print (.y (.a l))) (println ""))) ; 2
(print (/ 7 2)) (println "") ; 3 integer divide
(print (/ (f64 7) 2.0)) (println "") ; 3.5 float divide

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

@ -17,7 +17,7 @@
;;; And the one that must keep working: a lowercase qualified name in the same
;;; position is an expression, not a type.
(defn local [] Local (Local {:n 5}))
(defn local [] Local (Local {.n 5}))
(defn main [] i32
(let [c (fresh (bytes "[1 2]"))

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

@ -133,8 +133,8 @@
;; Nothing raylib made: four integers Flan chose and a buffer Flan owns. So
;; every number below is raylib reading THIS struct, and there is no
;; raylib-produced struct anywhere for a permutation to hide inside.
(let [src (rl/Wave {:frame-count 8 :sample-rate 8000 :sample-size 16
:channels 1 :data (addr (at pcm 0))})]
(let [src (rl/Wave {.frame-count 8 .sample-rate 8000 .sample-size 16
.channels 1 .data (addr (at pcm 0))})]
(show-bool "valid" (rl/wave-valid? src))
(show-wave "source" src)

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

@ -37,10 +37,10 @@
;; The camera below is chosen so that no field is silently unpinned — offset
;; and target differ, zoom is 2.0 and not the identity 1.0, and every
;; component is a distinct dyadic value that prints exactly.
(defconst cam (rl/Camera2D {:offset (rl/Vector2 {:x 100.0 :y 50.0})
:target (rl/Vector2 {:x 8.0 :y 4.0})
:rotation 0.0
:zoom 2.0}))
(defconst cam (rl/Camera2D {.offset (rl/Vector2 {.x 100.0 .y 50.0})
.target (rl/Vector2 {.x 8.0 .y 4.0})
.rotation 0.0
.zoom 2.0}))
;; Absolute values, not a round trip: screen (140,90) is world (28,24) because
;; ((140-100)/2)+8 = 28 and ((90-50)/2)+4 = 24. Swap offset and target in the
@ -90,17 +90,17 @@
;; 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
;; different pair of fields, so swapping any two fields changes the answer.
(show-rect (rl/get-collision-rec (rl/Rectangle {:x 0.0 :y 0.0 :width 10.0 :height 4.0})
(rl/Rectangle {:x 6.0 :y 1.0 :width 10.0 :height 10.0})))
(show-rect (rl/get-collision-rec (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})
(rl/Rectangle {.x 6.0 .y 1.0 .width 10.0 .height 10.0})))
;; Texture2D, as far as a machine with no GPU can go. raylib keeps the
;; shapes texture without touching GL, and substitutes a default when
;; `texture.id`, `source.width` or `source.height` is zero — that guard is
;; the only asymmetry a headless test gets.
(let [rect (rl/Rectangle {:x 3.5 :y 7.25 :width 11.5 :height 13.75})]
(let [rect (rl/Rectangle {.x 3.5 .y 7.25 .width 11.5 .height 13.75})]
;; (A) Valid, five distinct values: they come back, so the struct crosses
;; intact in both directions and raylib stored it rather than defaulting.
(rl/set-shapes-texture (rl/Texture2D {:id 7 :width 13 :height 17 :mipmaps 2 :format 4}) rect)
(rl/set-shapes-texture (rl/Texture2D {.id 7 .width 13 .height 17 .mipmaps 2 .format 4}) rect)
(show-texture (rl/get-shapes-texture))
(show-rect (rl/get-shapes-texture-rectangle))
@ -108,7 +108,7 @@
;; back. The 7 is the only distinct field in it, so this pins `format` as
;; the last field, and the substitution happening at all pins `id` as the
;; field the guard reads.
(rl/set-shapes-texture (rl/Texture2D {:id 0 :width 13 :height 17 :mipmaps 2 :format 4}) rect)
(rl/set-shapes-texture (rl/Texture2D {.id 0 .width 13 .height 17 .mipmaps 2 .format 4}) rect)
(show-texture (rl/get-shapes-texture))
;; (C) width zero, id positive: still stored, because the guard does not
@ -120,24 +120,24 @@
;; without a GL context reads width, height or mipmaps, so their order
;; among themselves is not pinned by this test. A swap there shows up as a
;; visibly wrong sprite in the interactive run, and nowhere else.
(rl/set-shapes-texture (rl/Texture2D {:id 7 :width 0 :height 17 :mipmaps 2 :format 4}) rect)
(rl/set-shapes-texture (rl/Texture2D {.id 7 .width 0 .height 17 .mipmaps 2 .format 4}) rect)
(show-texture (rl/get-shapes-texture)))
;; Camera2D, each direction on its own. See the note above show-v for why
;; this is not a round trip.
(show-v (rl/get-screen-to-world-2d (rl/Vector2 {:x 140.0 :y 90.0}) cam))
(show-v (rl/get-world-to-screen-2d (rl/Vector2 {:x 28.0 :y 24.0}) cam))
(show-v (rl/get-screen-to-world-2d (rl/Vector2 {.x 140.0 .y 90.0}) cam))
(show-v (rl/get-world-to-screen-2d (rl/Vector2 {.x 28.0 .y 24.0}) cam))
;; And the rotated camera, which is what pins Vector2's own two fields.
(let [spun (rl/Camera2D {:offset (rl/Vector2 {:x 100.0 :y 50.0})
:target (rl/Vector2 {:x 8.0 :y 4.0})
:rotation 90.0
:zoom 2.0})]
(let [spun (rl/Camera2D {.offset (rl/Vector2 {.x 100.0 .y 50.0})
.target (rl/Vector2 {.x 8.0 .y 4.0})
.rotation 90.0
.zoom 2.0})]
(show-near "rotated screen-to-world"
(rl/get-screen-to-world-2d (rl/Vector2 {:x 140.0 :y 90.0}) spun)
(rl/get-screen-to-world-2d (rl/Vector2 {.x 140.0 .y 90.0}) spun)
28.0 -16.0)
(show-near "rotated world-to-screen"
(rl/get-world-to-screen-2d (rl/Vector2 {:x 28.0 :y 24.0}) spun)
(rl/get-world-to-screen-2d (rl/Vector2 {.x 28.0 .y 24.0}) spun)
60.0 90.0))
;; ── Collision, which is the best material a headless test gets ──────
@ -146,25 +146,25 @@
;; so a wrong field order gives a wrong answer rather than the same struct
;; back. Each case below is paired with one that must come out the other
;; way, because a predicate that always said yes would pass a single case.
(let [r (rl/Rectangle {:x 0.0 :y 0.0 :width 10.0 :height 4.0})]
(let [r (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})]
;; Inside on both axes, then outside on y only. Swap width and height and
;; both of these flip, which is what makes the pair worth more than either.
(show-bool "point in rect" (rl/collision-point-rec? (rl/Vector2 {:x 5.0 :y 3.0}) r))
(show-bool "point below rect" (rl/collision-point-rec? (rl/Vector2 {:x 5.0 :y 5.0}) r))
(show-bool "point in rect" (rl/collision-point-rec? (rl/Vector2 {.x 5.0 .y 3.0}) r))
(show-bool "point below rect" (rl/collision-point-rec? (rl/Vector2 {.x 5.0 .y 5.0}) r))
;; Overlapping by one unit, then clear of it. Pins x against width.
(show-bool "rects overlap"
(rl/collision-recs? r (rl/Rectangle {:x 9.0 :y 1.0 :width 10.0 :height 10.0})))
(rl/collision-recs? r (rl/Rectangle {.x 9.0 .y 1.0 .width 10.0 .height 10.0})))
(show-bool "rects apart"
(rl/collision-recs? r (rl/Rectangle {:x 11.0 :y 1.0 :width 10.0 :height 10.0}))))
(rl/collision-recs? r (rl/Rectangle {.x 11.0 .y 1.0 .width 10.0 .height 10.0}))))
;; Centres five apart with radii summing to six, then seven apart. The radius
;; is a scalar beside two Vector2s, so this pins it against their fields.
(show-bool "circles touch"
(rl/collision-circles? (rl/Vector2 {:x 0.0 :y 0.0}) 3.0
(rl/Vector2 {:x 5.0 :y 0.0}) 3.0))
(rl/collision-circles? (rl/Vector2 {.x 0.0 .y 0.0}) 3.0
(rl/Vector2 {.x 5.0 .y 0.0}) 3.0))
(show-bool "circles clear"
(rl/collision-circles? (rl/Vector2 {:x 0.0 :y 0.0}) 3.0
(rl/Vector2 {:x 7.0 :y 0.0}) 3.0))
(rl/collision-circles? (rl/Vector2 {.x 0.0 .y 0.0}) 3.0
(rl/Vector2 {.x 7.0 .y 0.0}) 3.0))
;; The one that answers with a number rather than a yes: a horizontal segment
;; at y = 7 crossed by a vertical one at x = 3, so the answer is (3 7).
@ -187,86 +187,86 @@
;;
;; What this section *does* pin is Rectangle, completely — swapping width and
;; height turns three of the four predicates below the wrong way.
(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}))
(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 (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
;; nonsense, and until something calls it nothing says so.
(let [r (rl/Rectangle {:x 0.0 :y 0.0 :width 10.0 :height 4.0})]
(let [r (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})]
;; Circle against rect: just touching at the right edge, then clear of it.
(show-bool "circle meets rect"
(rl/collision-circle-rec? (rl/Vector2 {:x 12.0 :y 2.0}) 3.0 r))
(rl/collision-circle-rec? (rl/Vector2 {.x 12.0 .y 2.0}) 3.0 r))
(show-bool "circle clears rect"
(rl/collision-circle-rec? (rl/Vector2 {:x 14.0 :y 2.0}) 3.0 r)))
(rl/collision-circle-rec? (rl/Vector2 {.x 14.0 .y 2.0}) 3.0 r)))
;; Circle against a segment, which is the one that pins the radius against
;; the two endpoints rather than against a single centre.
(show-bool "circle meets line"
(rl/collision-circle-line? (rl/Vector2 {:x 5.0 :y 2.0}) 3.0
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 10.0 :y 0.0})))
(rl/collision-circle-line? (rl/Vector2 {.x 5.0 .y 2.0}) 3.0
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 10.0 .y 0.0})))
(show-bool "circle clears line"
(rl/collision-circle-line? (rl/Vector2 {:x 5.0 :y 4.0}) 3.0
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 10.0 :y 0.0})))
(rl/collision-circle-line? (rl/Vector2 {.x 5.0 .y 4.0}) 3.0
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 10.0 .y 0.0})))
(show-bool "point in circle"
(rl/collision-point-circle? (rl/Vector2 {:x 2.0 :y 0.0})
(rl/Vector2 {:x 0.0 :y 0.0}) 3.0))
(rl/collision-point-circle? (rl/Vector2 {.x 2.0 .y 0.0})
(rl/Vector2 {.x 0.0 .y 0.0}) 3.0))
(show-bool "point outside circle"
(rl/collision-point-circle? (rl/Vector2 {:x 4.0 :y 0.0})
(rl/Vector2 {:x 0.0 :y 0.0}) 3.0))
(rl/collision-point-circle? (rl/Vector2 {.x 4.0 .y 0.0})
(rl/Vector2 {.x 0.0 .y 0.0}) 3.0))
;; A right triangle with the square corner at the origin. The inside point is
;; inside for one vertex order and not the other, so this is one of the few
;; here that notices which vertex is which.
(show-bool "point in triangle"
(rl/collision-point-triangle? (rl/Vector2 {:x 1.0 :y 1.0})
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 8.0 :y 0.0})
(rl/Vector2 {:x 0.0 :y 6.0})))
(rl/collision-point-triangle? (rl/Vector2 {.x 1.0 .y 1.0})
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 8.0 .y 0.0})
(rl/Vector2 {.x 0.0 .y 6.0})))
(show-bool "point outside triangle"
(rl/collision-point-triangle? (rl/Vector2 {:x 7.0 :y 5.0})
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 8.0 :y 0.0})
(rl/Vector2 {:x 0.0 :y 6.0})))
(rl/collision-point-triangle? (rl/Vector2 {.x 7.0 .y 5.0})
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 8.0 .y 0.0})
(rl/Vector2 {.x 0.0 .y 6.0})))
;; On the segment, then beside it. The threshold is the last argument, so a
;; wrapper that lost it among the four coordinates answers with whatever was
;; in that register.
(show-bool "point on line"
(rl/collision-point-line? (rl/Vector2 {:x 5.0 :y 0.0})
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 10.0 :y 0.0}) 1))
(rl/collision-point-line? (rl/Vector2 {.x 5.0 .y 0.0})
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 10.0 .y 0.0}) 1))
(show-bool "point off line"
(rl/collision-point-line? (rl/Vector2 {:x 5.0 :y 4.0})
(rl/Vector2 {:x 0.0 :y 0.0})
(rl/Vector2 {:x 10.0 :y 0.0}) 1))
(rl/collision-point-line? (rl/Vector2 {.x 5.0 .y 4.0})
(rl/Vector2 {.x 0.0 .y 0.0})
(rl/Vector2 {.x 10.0 .y 0.0}) 1))
;; The only one that crosses a *slice*, so it is the only one where ptr+len
;; has to arrive as raylib's pointer-and-count. A wrong length reads past the
;; array or stops short, and either way the square stops being a square.
(let [square [(rl/Vector2 {:x 0.0 :y 0.0}) (rl/Vector2 {:x 8.0 :y 0.0})
(rl/Vector2 {:x 8.0 :y 8.0}) (rl/Vector2 {:x 0.0 :y 8.0})]]
(let [square [(rl/Vector2 {.x 0.0 .y 0.0}) (rl/Vector2 {.x 8.0 .y 0.0})
(rl/Vector2 {.x 8.0 .y 8.0}) (rl/Vector2 {.x 0.0 .y 8.0})]]
(show-bool "point in poly"
(rl/collision-point-poly? (rl/Vector2 {:x 4.0 :y 4.0}) (slice square 0 4)))
(rl/collision-point-poly? (rl/Vector2 {.x 4.0 .y 4.0}) (slice square 0 4)))
(show-bool "point outside poly"
(rl/collision-point-poly? (rl/Vector2 {:x 12.0 :y 4.0}) (slice square 0 4)))
(rl/collision-point-poly? (rl/Vector2 {.x 12.0 .y 4.0}) (slice square 0 4)))
;; The same point against the same array, three corners instead of four:
;; inside the square, outside the triangle the first three make. This is
;; the case that proves the *length* crosses — everything above would pass
;; with a hardcoded count, or with the pointer alone.
(show-bool "in square, four corners"
(rl/collision-point-poly? (rl/Vector2 {:x 2.0 :y 6.0}) (slice square 0 4)))
(rl/collision-point-poly? (rl/Vector2 {.x 2.0 .y 6.0}) (slice square 0 4)))
(show-bool "out of triangle, three"
(rl/collision-point-poly? (rl/Vector2 {:x 2.0 :y 6.0}) (slice square 0 3))))
(rl/collision-point-poly? (rl/Vector2 {.x 2.0 .y 6.0}) (slice square 0 3))))
;; Parallel, so they never meet: None rather than a point nobody wrote.
(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}))
(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 (println "no crossing"))

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

@ -68,17 +68,17 @@
(defvar glyphs [3 rl/GlyphInfo])
(defn build-glyphs []
(set (at glyph-recs 0) (rl/Rectangle {:x 0.0 :y 0.0 :width 5.0 :height 10.0}))
(set (at glyph-recs 1) (rl/Rectangle {:x 5.0 :y 0.0 :width 7.0 :height 10.0}))
(set (at glyph-recs 2) (rl/Rectangle {:x 12.0 :y 0.0 :width 9.0 :height 10.0}))
(set (at glyph-recs 0) (rl/Rectangle {.x 0.0 .y 0.0 .width 5.0 .height 10.0}))
(set (at glyph-recs 1) (rl/Rectangle {.x 5.0 .y 0.0 .width 7.0 .height 10.0}))
(set (at glyph-recs 2) (rl/Rectangle {.x 12.0 .y 0.0 .width 9.0 .height 10.0}))
;; 65 66 67 are A B C. Advances 11 and 13 for the first two; C's advance is
;; 0 on purpose, which is what sends raylib down the other branch.
(set (at glyphs 0) (rl/GlyphInfo {:value 65 :offset-x 1 :offset-y 0
:advance-x 11 :image (rl/Image {})}))
(set (at glyphs 1) (rl/GlyphInfo {:value 66 :offset-x 2 :offset-y 0
:advance-x 13 :image (rl/Image {})}))
(set (at glyphs 2) (rl/GlyphInfo {:value 67 :offset-x 3 :offset-y 0
:advance-x 0 :image (rl/Image {})})))
(set (at glyphs 0) (rl/GlyphInfo {.value 65 .offset-x 1 .offset-y 0
.advance-x 11 .image (rl/Image {})}))
(set (at glyphs 1) (rl/GlyphInfo {.value 66 .offset-x 2 .offset-y 0
.advance-x 13 .image (rl/Image {})}))
(set (at glyphs 2) (rl/GlyphInfo {.value 67 .offset-x 3 .offset-y 0
.advance-x 0 .image (rl/Image {})})))
(defn show-bool [name string b bool]
(print name) (print " ")
@ -116,11 +116,11 @@
;; therefore parses rl/Font as an expression and fails with "unknown name".
;; That is a parser limit and not something this file wanted; it applies to
;; rl/Vector2 just as much as to rl/Font.
(let [f (rl/Font {:base-size 10 :glyph-count 3 :glyph-padding 2
:texture (rl/Texture2D {:id 1 :width 32 :height 16
:mipmaps 1 :format 7})
:recs (addr (at glyph-recs 0))
:glyphs (addr (at glyphs 0))})]
(let [f (rl/Font {.base-size 10 .glyph-count 3 .glyph-padding 2
.texture (rl/Texture2D {.id 1 .width 32 .height 16
.mipmaps 1 .format 7})
.recs (addr (at glyph-recs 0))
.glyphs (addr (at glyphs 0))})]
;; font-valid? reads the texture id and both array pointers, so it is a
;; null check on the three things everything below dereferences.
(show-bool "valid" (rl/font-valid? f))

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

@ -26,9 +26,9 @@
;; transposed read pass, and that is exactly the trap the collision cases fell
;; into.
(defconst bg (rl/Color {:r 10 :g 20 :b 30 :a 255}))
(defconst mark-a (rl/Color {:r 200 :g 0 :b 0 :a 255}))
(defconst mark-b (rl/Color {:r 0 :g 200 :b 0 :a 255}))
(defconst bg (rl/Color {.r 10 .g 20 .b 30 .a 255}))
(defconst mark-a (rl/Color {.r 200 .g 0 .b 0 .a 255}))
(defconst mark-b (rl/Color {.r 0 .g 200 .b 0 .a 255}))
;; Where the export goes and comes back from. The two optimisation levels
;; write identical bytes, so sharing one path between runs is harmless.
@ -151,7 +151,7 @@
;; the Rectangle and the result is 1 x 2 with the mark gone.
(let [img (rl/gen-image-color 6 3 bg)]
(rl/image-draw-pixel (addr img) 5 0 mark-a)
(rl/image-crop (addr img) (rl/Rectangle {:x 4.0 :y 0.0 :width 2.0 :height 1.0}))
(rl/image-crop (addr img) (rl/Rectangle {.x 4.0 .y 0.0 .width 2.0 .height 1.0}))
(show-image "cropped" img)
(show-pixel "cropped at 1,0" img 1 0)
(show-pixel "cropped at 0,0" img 0 0)

2
test/programs/reach-walk.flan
View File

@ -29,7 +29,7 @@
;;; Signals with nothing to return, so the clause body is the only way past.
(defn missing [] i32
(error (Nope {:id 1})))
(error (Nope {.id 1})))
(defn pick [] i32
(restart-case (missing)

4
test/programs/restarts.flan
View File

@ -16,7 +16,7 @@
;;; The signalling end. Two frames below the restart-case, so the transfer has
;;; something to cross.
(defn load [n i32] i32
(signal (AssetMissing {:id n}))
(signal (AssetMissing {.id n}))
100)
;;; §5: this defer runs whether the call below returns or transfers, and it
@ -46,7 +46,7 @@
;;; signalling version needs does not exist here.
(defn strict [n i32] i32
(restart-case
(do (error (AssetMissing {:id n}))
(do (error (AssetMissing {.id n}))
;; unreachable — error is Never, so nothing after it runs
0)
(use-placeholder [] -2)))

2
test/programs/values.flan
View File

@ -5,7 +5,7 @@
(defvar arr [3 i32])
(defn main [] i32
(let [a (P {:x 1})]
(let [a (P {.x 1})]
(let [b a] ; a copy, not an alias
(set (.x a) 99)
(print (.x b)) (println ""))) ; 1

4
test/programs/vec.flan
View File

@ -76,8 +76,8 @@
;; A second element type over the same runtime, and a struct element, so
;; that size_of and align_of are doing work rather than both being 4.
(let [ps (vec-new Point)]
(push ps (Point {:x 1 :y 2}))
(push ps (Point {:x 3 :y 4}))
(push ps (Point {.x 1 .y 2}))
(push ps (Point {.x 3 .y 4}))
(println (len ps)) ; 2
(println (.y (at ps 1))) ; 4
(free ps))

2
test/programs/virtual-controls-headless.flan
View File

@ -48,7 +48,7 @@
(while (<= y sweep-y1)
(let [x sweep-x0]
(while (<= x sweep-x1)
(let [p (rl/Vector2 {:x (f32 x) :y (f32 y)})]
(let [p (rl/Vector2 {.x (f32 x) .y (f32 y)})]
(vc/move-player (vc/nearest-button p) dt))
(set x (+ x sweep-step))))
(set y (+ y sweep-step))))

12
test/test_acceptance.ml
View File

@ -150,15 +150,15 @@ let () =
let println_out =
"plain string\nplain bytes\n42\n-7\n5\n18446744073709551615\n3.5\n\
-0.25\ntrue\nfalse\n()\n:green\n:red\n<ptr>\n(some 0)\nnone\n\
(Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y -2}) :tags [ 0 42 0]})\n\
(Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y -2}) .tags [ 0 42 0]})\n\
[ 0 0 9 0]\n[ 0 0 0 0 0 0 0 0 ...]\n[ 0 9 0]\n\
(D1 {:d (D2 {:d (D3 {:d (D4 {:d (D5 {:n ...})})})})})\n[ 0 0]\n\
(D1 {.d (D2 {.d (D3 {.d (D4 {.d (D5 {.n ...})})})})})\n[ 0 0]\n\
[ 0 0]\n[ 9 0]\n"
(* The escape buffer is 1024 and the input is 1100 x's, so this is the
truncation: the ellipsis goes *inside* the quotes, and the count is
spelled out rather than pasted so that a change to the buffer or to
the reserve shows up here as a number and not as a wall of x. *)
^ "(Long {:s \"" ^ String.make 1014 'x' ^ "...\"})\n"
^ "(Long {.s \"" ^ String.make 1014 'x' ^ "...\"})\n"
^ "abc\n"
in
outputs "println, every arm" "programs/println.flan" println_out;
@ -1749,7 +1749,7 @@ ERR@7 unexpected token: not the kind the caller was reading
in
let cell = "(defstruct Cell [alive bool heat f64 id i32 name string])\n" in
let cell' = "(defstruct Cell [name string id i32 alive bool heat f64])\n" in
let body = "(defn main [] i32 (let [c (Cell {:id 1})] (i32 (.id c))))\n" in
let body = "(defn main [] i32 (let [c (Cell {.id 1})] (i32 (.id c))))\n" in
layout_case "DWARF offsets agree with LLVM: a mixed struct" (cell ^ body)
"Cell" [ "alive"; "heat"; "id"; "name" ];
(* The same struct, permuted. If the offsets came from anywhere but the
@ -1759,7 +1759,7 @@ ERR@7 unexpected token: not the kind the caller was reading
layout_case "DWARF offsets agree with LLVM: nesting and fixed arrays"
("(defstruct P [x i32 y i32])\n\
(defstruct Board [tag u8 cells [4 P] here P edge (Ptr P) seen (Option i64)])\n\
(defn main [] i32 (let [b (Board {:tag 1})] (i32 (.tag b))))\n")
(defn main [] i32 (let [b (Board {.tag 1})] (i32 (.tag b))))\n")
"Board" [ "tag"; "cells"; "here"; "edge"; "seen" ];
(* Permuting the fields must actually move them. Asserting that the two
@ -1903,7 +1903,7 @@ ERR@7 unexpected token: not the kind the caller was reading
(defn pick [xs [i32] i i32] i32 (at xs i))\n\
(defn fetch [n i32] i32\n\
\ (restart-case\n\
\ (do (error (Missing {:id n})) 0)\n\
\ (do (error (Missing {.id n})) 0)\n\
\ (use-value [v i32 s string] (do (print s) v))\n\
\ (use-placeholder [] -1)))\n\
(defn run [] i32\n\

8
test/test_dev.ml
View File

@ -650,7 +650,7 @@ let () =
its loop, so a body that errors stops it — and take the exit. *)
(match
ask
"(:op \"eval\" :code \"(defn step [] i64 (restart-case (do (error (Missing {:id 9})) 0) (use-placeholder [] -1)))\" :file \"/tmp/buf.flan\")"
"(:op \"eval\" :code \"(defn step [] i64 (restart-case (do (error (Missing {.id 9})) 0) (use-placeholder [] -1)))\" :file \"/tmp/buf.flan\")"
with
| r when status r <> "ok" ->
fail "installing a body that errors: %s"
@ -775,7 +775,7 @@ let () =
let want =
[ ("n", "i64", "3");
("label", "string", "\"hello\"");
("p", "Point", "(Point {:x 1.5 :y 2.5})");
("p", "Point", "(Point {.x 1.5 .y 2.5})");
("xs", "[3 i32]", "[ 10 20 30]");
("flag", "bool", "true") ]
in
@ -815,7 +815,7 @@ let () =
holding [p]'s value and nothing would say so. *)
let r =
ask
"(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {:x 9.0 :y 9.0}) ys [1 2 3] mark (< n 0)] (restart-case (do (error (Boom {:why 7})) (let [after (i64 99)] after)) (carry-on [] 5))))\" :file \"/tmp/buf.flan\")"
"(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {.x 9.0 .y 9.0}) ys [1 2 3] mark (< n 0)] (restart-case (do (error (Boom {.why 7})) (let [after (i64 99)] after)) (carry-on [] 5))))\" :file \"/tmp/buf.flan\")"
in
if status r <> "ok" then
fail "installing a renamed body while stopped: %s"
@ -1038,7 +1038,7 @@ let () =
in
let r =
request c
"(:op \"eval\" :code \"(defn step [] i64 (error (Missing {:id 3})))\" :file \"/tmp/disasm.flan\")"
"(:op \"eval\" :code \"(defn step [] i64 (error (Missing {.id 3})))\" :file \"/tmp/disasm.flan\")"
in
if status r <> "ok" then
fail "installing a body that errors: %s"

40
test/test_flan.ml
View File

@ -113,11 +113,11 @@ let () =
(* ── Sequences ─────────────────────────────────────────────────── *)
reads "list" "(+ 1 2)" "(+ 1 2)";
reads "vector" "[1 2 3]" "[1 2 3]";
reads "map literal" "{:src src :pos 0}" "{:src src :pos 0}";
reads "map literal" "{.src src .pos 0}" "{.src src .pos 0}";
reads "type notation" "[4 f32]" "[4 f32]";
reads "nested type" "[rows [cols u32]]" "[rows [cols u32]]";
reads "commas as space" "[1, 2, 3]" "[1 2 3]";
reads "nested" "(a (b [c {:d e}]))" "(a (b [c {:d e}]))";
reads "nested" "(a (b [c {.d e}]))" "(a (b [c {.d e}]))";
(* ── Trivia ────────────────────────────────────────────────────── *)
reads "line comment" "; nope\n42" "42";
@ -173,8 +173,8 @@ let () =
| _ -> []
in
let corpus =
"(invoke-restart 'skip-form) (a 'b [c 'd] {:e 'f}) '(g 'h) \
`(i ~j ~@k) `(l `(m ~n)) [`o ~p] {:q `r} (f a~b x`y)"
"(invoke-restart 'skip-form) (a 'b [c 'd] {.e 'f}) '(g 'h) \
`(i ~j ~@k) `(l `(m ~n)) [`o ~p] {.q `r} (f a~b x`y)"
in
check "no sigils leak into names"
(bad_names (Form.make (Form.List (read corpus))
@ -314,7 +314,7 @@ let () =
(match (parse1 "(.pos c)").e with
| Field ({ e = Var "c"; _ }, "pos") -> ()
| _ -> check "field access" false);
(match (parse1 "(Cursor {:src s :pos 0})").e with
(match (parse1 "(Cursor {.src s .pos 0})").e with
| Struct ("Cursor", [ ("src", _); ("pos", _) ]) -> ()
| _ -> check "struct literal" false);
(match (parse1 "[1 2 3]").e with
@ -611,12 +611,12 @@ let () =
(* ── Structs, fields and auto-deref ────────────────────────────── *)
let cursor = "(defstruct Cursor [src [u8] pos i32]) " in
accepts "struct literal, omitted field zeroed"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {:src s}))");
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.src s}))");
rejects_check "unknown field"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {:nope s}))")
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.nope s}))")
~needle:"has no field nope";
rejects_check "field given twice"
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {:pos 0 :pos 1}))")
(cursor ^ "(defn f [s [u8]] Cursor (Cursor {.pos 0 .pos 1}))")
~needle:"given twice";
accepts "field through a pointer auto-derefs"
(cursor ^ "(defn f [c (Ptr Cursor)] i32 (.pos c))");
@ -634,7 +634,7 @@ let () =
"(defconst k 1) (defn f [] (set k 2))" ~needle:"is a constant";
accepts "addr of a local gives a pointer"
(cursor ^ "(defn g [c (Ptr Cursor)] i32 (.pos c)) \
(defn f [s [u8]] i32 (let [c (Cursor {:src s})] (g (addr c))))");
(defn f [s [u8]] i32 (let [c (Cursor {.src s})] (g (addr c))))");
rejects_check "addr of a non-place"
"(defn f [] (addr (+ 1 2)))" ~needle:"addr takes the address of a place";
@ -818,7 +818,7 @@ let () =
accepts "handler-bind over a struct condition"
"(defstruct C [id i32]) (defvar n i64)\n\
(defn f [] (handler-bind [(C [c] (set n 1))] (signal (C {:id 2}))))";
(defn f [] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2}))))";
(* Matching is by type and there is no hierarchy, so a condition has to be a
struct — an integer would have nothing to match against. *)
rejects_check "signalling a non-struct"
@ -830,18 +830,18 @@ let () =
usable as a restart-case body's fall-through. *)
accepts "error in value position"
"(defstruct C [id i32])\n\
(defn f [] i32 (error (C {:id 1})))";
(defn f [] i32 (error (C {.id 1})))";
(* And signal is not: it is Unit, whatever it finds. *)
rejects_check "signal in value position"
"(defstruct C [id i32])\n\
(defn f [] i32 (signal (C {:id 1})))" ~needle:"expected i32";
(defn f [] i32 (signal (C {.id 1})))" ~needle:"expected i32";
(* A handler is lifted into a function of its own, so the establishing
function's locals are not there. Capturing them is a closure, which is
milestone 5 — until then it is refused for the reason it is refused for
rather than as an unknown name. *)
rejects_check "a handler capturing a local"
"(defstruct C [id i32])\n\
(defn f [] (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {:id 2})))))"
(defn f [] (let [n 0] (handler-bind [(C [c] (set n 1))] (signal (C {.id 2})))))"
~needle:"a handler cannot see n";
(* The frames are popped on the way out of the body, so an early exit would
leave them on the stack pointing into a function that has gone. *)
@ -860,7 +860,7 @@ let () =
accepts "restart-case with a clause that transfers into it"
"(defstruct C [id i32])\n\
(defn g [] i32 (signal (C {:id 1})) 0)\n\
(defn g [] i32 (signal (C {.id 1})) 0)\n\
(defn f [] i32 (restart-case (g) (skip [] 7)))\n\
(defn h [] i32 (handler-bind [(C [c] (invoke-restart 'skip))] (f)))";
(* §3: the body and every clause yield the whole form, so they have to agree
@ -926,17 +926,17 @@ let () =
accepts "struct pattern with :keys"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x y]} p] (+ x y)))");
accepts "struct pattern with a name/:field pair"
(pt ^ "(defn f [p Point] i32 (let [{a :x b :y} p] (+ a b)))");
(pt ^ "(defn f [p Point] i32 (let [{a .x b .y} p] (+ a b)))");
accepts "a nested struct pattern"
(line ^ "(defn f [l Line] i32 (let [{{:keys [x y]} :a} l] (+ x y)))");
(line ^ "(defn f [l Line] i32 (let [{{:keys [x y]} .a} l] (+ x y)))");
(* A later binding sees an earlier pattern's names, as in any let. *)
accepts "a binding after a pattern sees its names"
(pt ^ "(defn f [p Point] i32 (let [{:keys [x]} p y (+ x 1)] y))");
(* Shadowing works because the value goes into a temporary first. *)
accepts "a pattern may shadow the name it destructures"
(line ^ "(defn f [a Line] i32 (let [{a :a} a] (.x a)))");
(line ^ "(defn f [a Line] i32 (let [{a .a} a] (.x a)))");
accepts "a pattern over a call"
(pt ^ "(defn mk [] Point (Point {:x 1 :y 2}))\n\
(pt ^ "(defn mk [] Point (Point {.x 1 .y 2}))\n\
(defn f [] i32 (let [{:keys [x y]} (mk)] (+ x y)))");
rejects_check "a field the struct does not have"
@ -952,7 +952,7 @@ let () =
(pt ^ "(defn f [p Point] i32 (let [{} p] 0))")
~needle:"an empty struct pattern {} binds nothing";
rejects_check "a field name with no pattern before it"
(pt ^ "(defn f [p Point] i32 (let [{:x} p] 0))")
(pt ^ "(defn f [p Point] i32 (let [{.x} p] 0))")
~needle:"has no :field";
rejects_check "a pattern with no field name after it"
(pt ^ "(defn f [p Point] i32 (let [{a b} p] 0))")
@ -981,7 +981,7 @@ let () =
"(defn f [] i32 (let [xs [1 2] [a b & r] xs] (+ a (+ b (len r)))))";
accepts "a struct pattern nested in an array pattern"
(pt ^ "(defn f [ps [2 Point]] i32 \
(let [[{:keys [x]} {y :y}] ps] (+ x y)))");
(let [[{:keys [x]} {y .y}] ps] (+ x y)))");
rejects_check "an array pattern that names too few elements"
"(defn f [] i32 (let [xs [1 2 3] [a b] xs] (+ a b)))"

4
test/test_repl.ml
View File

@ -96,9 +96,9 @@ let () =
this would otherwise come back as -1. *)
value "u64 at its maximum" "big" "18446744073709551615";
(* A struct, nested, with a fixed array inside it. *)
value "a struct" "(.pos b)" "(V {:x 1.5 :y 0})";
value "a struct" "(.pos b)" "(V {.x 1.5 .y 0})";
value "a nested struct" "b"
"(Blob {:id 7 :name \"sandy \\\"quoted\\\"\" :pos (V {:x 1.5 :y 0}) :tags [ 0 42 0]})";
"(Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y 0}) .tags [ 0 42 0]})";
value "a fixed array" "arr" "[ 0 0 9 0]";
(* A slice's length is not known until it runs, so this one renders
through a loop rather than by unrolling. *)

237
tools/colon-to-dot.py Executable file
View File

@ -0,0 +1,237 @@
#!/usr/bin/env python3
"""Rewrite struct field labels from the colon spelling to the dot spelling.
`{:x 1.0 :y 2.0}` becomes `{.x 1.0 .y 2.0}`, and the destructuring pair
`{inner :field}` becomes `{inner .field}`. `:keys` is left alone: it names no
field, it is an instruction to the compiler, so the dot keeps exactly one
meaning -- "this names a field".
Only keywords that sit in a *field-label* position inside a brace form are
touched. Enum members, map keys and every keyword inside a string literal or a
comment are left as they are. The lexing rules here mirror lib/reader.ml.
Re-runnable: converting an already-converted file is a no-op, so this can be
run again over files a parallel branch wrote in the old spelling.
tools/colon-to-dot.py <file-or-dir>... # rewrite .flan in place
tools/colon-to-dot.py --check <file-or-dir>... # report, change nothing
tools/colon-to-dot.py --in-strings <file.ml>... # Flan inside "..." literals
tools/colon-to-dot.py --raw-ml <file.ml>... # Flan in a {flan|...|flan} block
A directory is walked for `.flan` files only. An `.ml` file is converted when it
is named on the command line, which is how the Flan source embedded in
`lib/prelude.ml` and in the tests gets swept; it is deliberately not automatic,
because an OCaml record written `{ v: value }` would look like a field label to
the scan. Read the diff when sweeping `.ml`.
"""
import sys, os
DELIM = set('()[]{}";`~ \t\n\r,')
OPENERS = {'(': ')', '[': ']', '{': '}'}
CLOSERS = {')', ']', '}'}
class Atom:
def __init__(self, start, end, text):
self.start, self.end, self.text = start, end, text
self.tok = start # never moves; `start` may slide onto a quote sigil
def label(self):
"""The keyword name if this atom is a `:kw`, else None."""
t = self.text
return t[1:] if len(t) > 1 and t[0] == ':' else None
class Seq:
def __init__(self, open_char, start):
self.open_char, self.start = open_char, start
self.end = start
self.items = []
def label(self):
return None
def lex_forms(src, i, end, stop=None):
"""Read forms from src[i:end] until `stop` (a closing char) or exhaustion.
Returns (items, next_index). A quote/quasiquote/unquote prefix is folded
into the form it applies to, so a quoted value stays one element.
"""
items = []
n = end
pending_prefix = None # start offset of a sigil awaiting its form
def push(node):
nonlocal pending_prefix
if pending_prefix is not None:
node.start = pending_prefix
pending_prefix = None
items.append(node)
while i < n:
c = src[i]
if c in ' \t\n\r,':
i += 1
elif c == ';': # line comment
while i < n and src[i] != '\n':
i += 1
elif c == '"': # string literal
j = i + 1
while j < n and src[j] != '"':
j += 2 if src[j] == '\\' else 1
j = min(j + 1, n)
push(Atom(i, j, src[i:j]))
i = j
elif c == '\\': # character literal
j = i + 1
if j < n:
j += 1 # always one char
while j < n and src[j] not in DELIM:
j += 1
push(Atom(i, j, src[i:j]))
i = j
elif c in "'`~": # quote sugar
if pending_prefix is None:
pending_prefix = i
i += 2 if (c == '~' and i + 1 < n and src[i + 1] == '@') else 1
elif c in OPENERS:
node = Seq(c, i)
node.items, i = lex_forms(src, i + 1, n, OPENERS[c])
node.end = i
push(node)
elif c in CLOSERS:
return items, i + 1
else: # symbol or keyword
j = i
while j < n and src[j] not in DELIM:
j += 1
if j == i:
j = i + 1
push(Atom(i, j, src[i:j]))
i = j
return items, n
def collect(node, out):
"""Walk the form tree, recording the offsets of every colon to rewrite."""
if isinstance(node, Seq):
if node.open_char == '{':
items = node.items
k = 0
while k < len(items):
a = items[k]
b = items[k + 1] if k + 1 < len(items) else None
a_label = a.label()
b_label = b.label() if b is not None else None
if a_label == 'keys':
pass # a directive, not a field
elif a_label is not None:
out.append(a.tok) # {:field value}
elif b_label is not None and b_label != 'keys':
out.append(b.tok) # {pattern :field}
k += 2
for it in node.items:
collect(it, out)
def convert(src):
items, _ = lex_forms(src, 0, len(src))
out = []
for it in items:
collect(it, out)
if not out:
return src, 0
chars = list(src)
for off in out:
assert chars[off] == ':', "expected ':' at offset %d" % off
chars[off] = '.'
return ''.join(chars), len(out)
def convert_in_ocaml_strings(src):
"""Convert Flan source that sits inside ordinary OCaml `"..."` literals.
The tests hold their Flan snippets that way, so the plain scan skips right
over them. Each literal's raw text is scanned on its own, with `\\"` masked
to a same-length filler first so an escaped quote cannot be mistaken for the
start of a Flan string. Masking preserves length, so offsets map back 1:1.
"""
chars = list(src)
total = 0
i, n = 0, len(src)
while i < n:
c = src[i]
if c == '"':
j = i + 1
while j < n and src[j] != '"':
j += 2 if src[j] == '\\' else 1
body = src[i + 1:j]
masked = body.replace('\\"', '\\x')
_, offs = _offsets(masked)
for off in offs:
pos = i + 1 + off
if chars[pos] == ':':
chars[pos] = '.'
total += 1
i = j + 1
elif c == '(' and i + 1 < n and src[i + 1] == '*': # OCaml comment
i += 2
else:
i += 1
return ''.join(chars), total
def _offsets(src):
items, _ = lex_forms(src, 0, len(src))
out = []
for it in items:
collect(it, out)
return src, out
def walk(paths):
for p in paths:
if os.path.isdir(p):
for root, dirs, files in os.walk(p):
dirs[:] = [d for d in dirs
if d not in ('_build', '.git', 'vendor', 'node_modules')]
for f in sorted(files):
if f.endswith('.flan'):
yield os.path.join(root, f)
else:
yield p
def main(argv):
check = '--check' in argv
in_strings = '--in-strings' in argv
allow_raw_ml = '--raw-ml' in argv
paths = [a for a in argv[1:] if not a.startswith('--')] or ['.']
total_files = total_sites = 0
for path in walk(paths):
if path.endswith('.ml') and not in_strings and not allow_raw_ml:
sys.stderr.write(
"%s: an .ml file needs --in-strings (its Flan is inside OCaml "
"string literals), or --raw-ml if the Flan is in a {flan|...|flan} "
"block. A plain scan would read OCaml's `::` as a field label.\n"
% path)
return 2
with open(path, encoding='utf-8') as fh:
src = fh.read()
new, n = convert_in_ocaml_strings(src) if in_strings else convert(src)
if n:
total_files += 1
total_sites += n
print("%s: %d" % (path, n))
if not check:
with open(path, 'w', encoding='utf-8') as fh:
fh.write(new)
verb = "would convert" if check else "converted"
print("%s %d field labels across %d files" % (verb, total_sites, total_files))
return 1 if (check and total_sites) else 0
if __name__ == '__main__':
sys.exit(main(sys.argv))

2
web/examples/boom.flan
View File

@ -2,7 +2,7 @@
(defn load [n i32] i32
(restart-case
(do (error (Missing {:id n})) ; Never — only a transfer gets past
(do (error (Missing {.id n})) ; Never — only a transfer gets past
0)
(use-placeholder [] -1)
(retry [] 7)))

2
web/examples/breakdemo.flan
View File

@ -4,7 +4,7 @@
(defn load [n i32] i32
(restart-case
(do (error (Missing {:id n}))
(do (error (Missing {.id n}))
0)
(use-placeholder [] -1)
(retry [] 7)))

4
web/examples/conds.flan
View File

@ -3,8 +3,8 @@
(defvar seen i64)
(defn load-all []
(signal (AssetMissing {:id 1})) ; Unit — the caller carries on
(signal (AssetMissing {:id 2})))
(signal (AssetMissing {.id 1})) ; Unit — the caller carries on
(signal (AssetMissing {.id 2})))
(defn main []
(load-all) ; no handler: a no-op

2
web/examples/geom/vec.flan
View File

@ -2,4 +2,4 @@
(defstruct V2 [x f32 y f32])
(defn add [a V2 b V2] V2
(V2 {:x (+ (.x a) (.x b)) :y (+ (.y a) (.y b))}))
(V2 {.x (+ (.x a) (.x b)) .y (+ (.y a) (.y b))}))

4
web/examples/pkg.flan
View File

@ -3,7 +3,7 @@
(import g "geom")
(defn main []
(let [v (g/add (g/V2 {:x 3.0 :y 0.0})
(g/V2 {:x 0.0 :y 4.0}))]
(let [v (g/add (g/V2 {.x 3.0 .y 0.0})
(g/V2 {.x 0.0 .y 4.0}))]
(print (g/length v))
(println "")))

4
web/examples/places.flan
View File

@ -6,13 +6,13 @@
;; `set` takes a fixed list of forms, not an extensible setf.
(defn main []
(let [e (Enemy {:hp 10 :name "slime"})
(let [e (Enemy {.hp 10 .name "slime"})
p (addr e)]
(set spawned (+ spawned 1)) ; a local or a defvar
(set (.hp e) 7) ; a struct field
(set (.hp p) 8) ; through a (Ptr Enemy) — derefs one level
(set (at room 2) 5) ; a fixed array or slice element
(set (deref p) (Enemy {:hp 3 :name "wisp"})) ; a whole-object store
(set (deref p) (Enemy {.hp 3 .name "wisp"})) ; a whole-object store
(print (.hp e)) (println "")
(println (.name e))

2
web/examples/printing.flan
View File

@ -7,7 +7,7 @@
(defn main []
(println 42) ; an i32, uncast
(println 1.5)
(println (Enemy {:hp 3 :name "wisp" :key :left}))
(println (Enemy {.hp 3 .name "wisp" .key :left}))
(println (look-up :space))
(println (look-up :left))
(print "no newline: ") (println true))

2
web/examples/restart.flan
View File

@ -3,7 +3,7 @@
(defvar cleanups i64)
(defn load [n i32] i32
(signal (AssetMissing {:id n}))
(signal (AssetMissing {.id n}))
100)
(defn middle [n i32] i32

2
web/examples/structs.flan
View File

@ -11,7 +11,7 @@
(set (.pos c) (+ (.pos c) 1))) ; field access derefs one level
(defn main []
(let [c (Cursor {:src (bytes "hi")})] ; pos omitted, so pos is 0
(let [c (Cursor {.src (bytes "hi")})] ; pos omitted, so pos is 0
(print (peek (addr c))) (println "")
(advance (addr c))
(print (peek (addr c))) (println "")))