Merge branch 'docs-web' into dev-loop

web/examples/arrays.flan

@@ -0,0 +1,23 @@
+(defconst rows 3)
+(defconst cols 4)
+
+;; A fixed array is a value: inline storage, copies on assignment.
+(defconst palette [4 u32] [0xE6B800FF 0x3B6E8CFF 0xA83232FF 0xCC6B1FFF])
+
+;; No initialiser means all-bytes-zero, so this is BSS and costs nothing.
+(defvar grid [rows [cols i32]])
+
+(defn main []
+  (set (at grid 1 2) 7)
+  (print-i64 (i64 (at grid 1 2))) (newline)    ; 7
+  (print-i64 (i64 (len palette))) (newline)    ; 4
+
+  ;; A slice is ptr+len and non-owning: it views the array, it does not copy it.
+  (let [row (slice (at grid 1) 0 cols)]
+    (set (at row 0) 5)
+    (print-i64 (i64 (at grid 1 0))) (newline)  ; 5 — the same storage
+    (print-i64 (sum-i32 row)) (newline))       ; 12
+
+  ;; (zeroed) is a memset, not an allocation.
+  (set grid (zeroed))
+  (print-i64 (i64 (at grid 1 2))) (newline))   ; 0

web/examples/arrays.out

@@ -0,0 +1,6 @@
+7
+4
+5
+12
+0
+exit 0

web/examples/boom.flan

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

web/examples/boom.out

@@ -0,0 +1,2 @@
+unhandled Missing
+exit 134

web/examples/bounds.flan

@@ -0,0 +1,10 @@
+(defconst xs [3 i32] [1 2 3])
+
+;; (at xs 7) with a literal index does not reach the backend at all: check.ml
+;; rejects it. This one goes through a local, so it is the runtime check that
+;; catches it — the same message, and the program stops where it happened.
+(defn main []
+  (let [i 7]
+    (print-line "before")
+    (print-i64 (i64 (at xs i)))
+    (print-line "unreachable")))

web/examples/bounds.out

@@ -0,0 +1,3 @@
+before
+bounds.flan:9:28: index 7 is out of bounds for length 3
+exit 134

web/examples/breakdemo.flan

@@ -0,0 +1,15 @@
+(import agent "vendor:agent")
+
+(defstruct Missing [id i32])
+
+(defn load [n i32] i32
+  (restart-case
+    (do (error (Missing {:id n}))
+        0)
+    (use-placeholder [] -1)
+    (retry           [] 7)))
+
+(defn main []
+  (agent/start "/tmp/flan-breakdemo.sock")
+  (print-i64 (i64 (load 1)))
+  (newline))

web/examples/breakdemo.out

@@ -0,0 +1,4 @@
+
+flan: unhandled Missing — stopped, not dead.
+  restart: retry
+  restart: use-placeholder

web/examples/check.sh

@@ -0,0 +1,58 @@
+#!/bin/sh
+# Every Flan program shown on index.html is in this directory, and this script
+# runs all of them and compares what they print against the .out file beside
+# them. An example that does not compile is worse than no example, so the page
+# quotes only what this script has been green on.
+#
+#   $ dune build && sh web/examples/check.sh
+#
+# FLAN overrides the compiler; the default is the one dune just built.
+here=$(cd "$(dirname "$0")" && pwd)
+root=$(cd "$here/../.." && pwd)
+FLAN=${FLAN:-$root/_build/default/bin/main.exe}
+tmp=${TMPDIR:-/tmp}/flan-web-check.$$
+
+cd "$here" || exit 1
+fail=0
+ok()   { echo "ok    $1"; }
+bad()  { echo "FAIL  $1"; fail=1; }
+
+for f in *.flan; do
+  # Two programs are not run by `flan run`; each is checked its own way below.
+  [ "$f" = shimdemo.flan ] && continue    # calls raylib
+  [ "$f" = breakdemo.flan ] && continue   # stops and waits, on purpose
+  got=$( { "$FLAN" run "$f"; echo "exit $?"; } 2>&1 )
+  if [ "$got" = "$(cat "${f%.flan}.out")" ]; then ok "$f"; else
+    bad "$f"
+    printf '%s\n' "$got" | diff -u "${f%.flan}.out" - || true
+  fi
+done
+
+# shimdemo.flan is the declare-c example: what it demonstrates is the C the
+# compiler writes, so it is checked by generating that rather than by running.
+if "$FLAN" shim shimdemo.flan | grep -q 'GetMousePosition(void)'; then
+  ok "shimdemo.flan (flan shim)"
+else
+  bad "shimdemo.flan (flan shim)"
+fi
+
+# breakdemo.flan is the break loop: an unhandled error stops the program and
+# waits for someone to pick a restart, so it never exits on its own. It needs
+# a --dev build (the hook lives in vendor/agent) and it is killed after a few
+# seconds; what is checked is the banner it printed before it stopped.
+if command -v timeout >/dev/null 2>&1; then
+  if "$FLAN" build breakdemo.flan --dev -o "$tmp" >/dev/null 2>&1; then
+    got=$(timeout 5 "$tmp" 2>&1)
+    rm -f "$tmp"
+    if [ "$got" = "$(cat breakdemo.out)" ]; then ok "breakdemo.flan (break loop)"; else
+      bad "breakdemo.flan (break loop)"
+      printf '%s\n' "$got" | diff -u breakdemo.out - || true
+    fi
+  else
+    bad "breakdemo.flan (build --dev)"
+  fi
+else
+  echo "skip  breakdemo.flan (no timeout(1))"
+fi
+
+exit $fail

web/examples/conds.flan

@@ -0,0 +1,16 @@
+(defstruct AssetMissing [id i32])
+
+(defvar seen i64)
+
+(defn load-all []
+  (signal (AssetMissing {:id 1}))     ; Unit — the caller carries on
+  (signal (AssetMissing {:id 2})))
+
+(defn main []
+  (load-all)                          ; no handler: a no-op
+  (print-i64 seen) (newline)          ; 0
+
+  ;; A handler that returns normally accumulates and lets the signaller run on.
+  (handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))]
+    (load-all))
+  (print-i64 seen) (newline))         ; 3

web/examples/conds.out

@@ -0,0 +1,3 @@
+0
+3
+exit 0

web/examples/control.flan

@@ -0,0 +1,30 @@
+(defconst nums [5 i32] [1 3 8 9 10])
+
+(defn classify [n i32] string
+  (cond
+    (< n 0)  "negative"
+    (= n 0)  "zero"
+    :else    "positive"))
+
+(defn countdown [n i32]
+  (let [i n]
+    (while (> i 0)
+      (print-i64 (i64 i))
+      (print-str " ")
+      (set i (- i 1)))
+    (newline)))
+
+(defn first-even [s [i32]] (Option i32)
+  (dotimes [i (len s)]
+    (when (= 0 (% (at s i) 2))
+      (return (Some (at s i)))))
+  None)
+
+(defn main []
+  (print-line (classify -3))
+  (countdown 4)
+  (unless false
+    (print-line "unless runs when the test is false"))
+  (match (first-even (slice nums 0 (len nums)))
+    (Some n) (do (print-i64 (i64 n)) (newline))
+    None     (print-line "none")))

web/examples/control.out

@@ -0,0 +1,5 @@
+negative
+4 3 2 1 
+unless runs when the test is false
+8
+exit 0

web/examples/defer.flan

@@ -0,0 +1,11 @@
+(defn work [n i32] i32
+  (defer (print-line "second"))
+  (defer (print-line "first"))     ; innermost-first at exit
+  (when (< n 0)
+    (return 0))                    ; runs both defers above it
+  (print-line "body")
+  n)
+
+(defn main []
+  (print-i64 (i64 (work 3)))
+  (newline))

web/examples/defer.out

@@ -0,0 +1,5 @@
+body
+first
+second
+3
+exit 0

web/examples/enums.flan

@@ -0,0 +1,14 @@
+(defenum Key
+  [space 32  escape 256  left 263  right 262])
+
+(defn key-name [k Key] string
+  (cond
+    (= k :space)  "space"
+    (= k :escape) "escape"
+    :else         "an arrow"))
+
+(defn main []
+  ;; :space resolves against the parameter's enum at compile time.
+  ;; A typo is an error here, not a wrong number later.
+  (print-line (key-name :space))
+  (print-line (key-name :left)))

web/examples/enums.out

@@ -0,0 +1,3 @@
+space
+an arrow
+exit 0

web/examples/ffi.flan

@@ -0,0 +1,6 @@
+;; A plain `declare` names a C symbol in a signature Flan can already spell:
+;; no aggregate crosses, so no wrapper is generated.
+(declare cos-f64 [x f64] f64 "cos")
+
+(defn main []
+  (print-f64 (cos-f64 0.0)) (newline))

web/examples/ffi.out

@@ -0,0 +1,2 @@
+1
+exit 0

web/examples/geom/len.flan

@@ -0,0 +1,4 @@
+;; geom/len.flan — a second file in the same directory shares one top-level
+;; scope: it does not import vec.flan, and the order of the two does not matter.
+(defn length [v V2] f32
+  (sqrt-f32 (+ (* (.x v) (.x v)) (* (.y v) (.y v)))))

web/examples/geom/vec.flan

@@ -0,0 +1,5 @@
+;; geom/vec.flan — no package declaration: the name comes from the directory.
+(defstruct V2 [x f32  y f32])
+
+(defn add [a V2  b V2] V2
+  (V2 {:x (+ (.x a) (.x b))  :y (+ (.y a) (.y b))}))

web/examples/globals.flan

@@ -0,0 +1,12 @@
+(defconst cell-size 5)                 ; a compile-time constant
+(defconst gravity f32 0.05)            ; with its type named
+(defvar current-color i32)             ; zeroed storage
+(defconst rows 3)
+(defconst cols 4)
+(defvar grid [rows [cols u32]])        ; BSS, rows*cols*4 bytes
+
+(defn main []
+  (print-i64 (i64 cell-size)) (newline)
+  (print-f64 (f64 gravity)) (newline)
+  (print-i64 (i64 current-color)) (newline)
+  (print-i64 (i64 (at grid 2 3))) (newline))

web/examples/globals.out

@@ -0,0 +1,5 @@
+5
+0.05
+0
+0
+exit 0

web/examples/hello.flan

@@ -0,0 +1,2 @@
+(defn main []
+  (print-line "hello from flan"))

web/examples/hello.out

@@ -0,0 +1,2 @@
+hello from flan
+exit 0

web/examples/numbers.flan

@@ -0,0 +1,8 @@
+(defn main [] i32
+  (let [n 40                       ; i32, inferred
+        big (i64 n)                ; every widening is written
+        x 1.5]                     ; f64
+    (print-i64 (+ big 2)) (newline)
+    (print-f64 (* x 2.5)) (newline)
+    (print-i64 (i64 (bit-xor (<< 1 8) 255))) (newline)
+    0))

web/examples/numbers.out

@@ -0,0 +1,4 @@
+42
+3.75
+511
+exit 0

web/examples/option.flan

@@ -0,0 +1,13 @@
+(defconst nums [4 i32] [4 8 15 16])
+
+;; `some` unwraps Some and early-returns None from *this* function.
+(defn doubled-first [s [i32]] (Option i32)
+  (Some (* 2 (some (index-of-i32 s 15)))))
+
+(defn main []
+  (match (doubled-first (slice nums 0 4))
+    (Some i) (do (print-i64 (i64 i)) (newline))   ; 4
+    None     (print-line "not found"))
+  (match (index-of-i32 (slice nums 0 4) 99)
+    (Some i) (do (print-i64 (i64 i)) (newline))
+    None     (print-line "not found")))

web/examples/option.out

@@ -0,0 +1,3 @@
+4
+not found
+exit 0

web/examples/pkg.flan

@@ -0,0 +1,9 @@
+;; pkg.flan — the directory is the package, and everything it declares
+;; arrives qualified by the alias this import chose.
+(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}))]
+    (print-f64 (f64 (g/length v)))
+    (newline)))

web/examples/pkg.out

@@ -0,0 +1,2 @@
+5
+exit 0

web/examples/places.flan

@@ -0,0 +1,20 @@
+(defstruct Enemy [hp i32  name string])
+
+(defvar spawned i32)
+(defconst room-size 4)
+(defvar room [room-size i32])
+
+;; `set` takes a fixed list of forms, not an extensible setf.
+(defn main []
+  (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
+
+    (print-i64 (i64 (.hp e))) (newline)
+    (print-line (.name e))
+    (print-i64 (i64 (at room 2))) (newline)
+    (print-i64 (i64 spawned)) (newline)))

web/examples/places.out

@@ -0,0 +1,5 @@
+3
+wisp
+5
+1
+exit 0

web/examples/quotes.sh

@@ -0,0 +1,90 @@
+#!/bin/sh
+# The blocks on index.html that are not programs in this directory are quoted
+# from somewhere: a repository file, or the output of a command. Each one is
+# re-derived here and looked for in the page, so a quote cannot go stale
+# quietly. check.sh covers the runnable blocks; this covers the rest.
+#
+#   $ dune build && sh web/examples/quotes.sh
+here=$(cd "$(dirname "$0")" && pwd)
+root=$(cd "$here/../.." && pwd)
+FLAN=${FLAN:-$root/_build/default/bin/main.exe}
+page=$here/../index.html
+fail=0
+
+# The page is compared with its whitespace collapsed, so that a long compiler
+# message may be wrapped in the HTML and still be recognised as the same text.
+flat=$(sed -e 's/&lt;/</g' -e 's/&gt;/>/g' -e 's/&amp;/\&/g' "$page" | tr '\n' ' ' | tr -s ' ')
+
+want() {
+  # An empty needle would match anything — `case $x in **)` is always true — so
+  # every check whose text comes from a grep would go green the moment the line
+  # it greps for was renamed. That is the one failure this script exists to
+  # catch, so the empty case is a failure and not a match.
+  if [ -z "$2" ]; then
+    echo "FAIL  $1"
+    echo "      nothing to compare against — whatever this quotes has moved"
+    fail=1
+    return
+  fi
+  needle=$(printf '%s' "$2" | tr '\n' ' ' | tr -s ' ')
+  case $flat in
+    *"$needle"*) echo "ok    $1" ;;
+    *) echo "FAIL  $1"; echo "      not on the page: $2"; fail=1 ;;
+  esac
+}
+
+# The usage text, from the binary itself.
+want "flan usage" "$("$FLAN" 2>&1 | sed -n 2p)"
+
+# calc-me, the first acceptance program, still answers what the page says.
+want "calc-me" "$("$FLAN" run "$root/calc-me.flan" '1 + 2 * (3 - 0.5) / 2')"
+
+# The sand hash. The page shows it twice — native and wasm32 — and the claim is
+# that the two agree; only the native half is cheap enough to check here.
+want "sand hash" "$("$FLAN" run "$root/test/programs/sand-headless.flan")"
+
+# The two cross-target refusals, in the compiler's own words.
+want "run --target" "$("$FLAN" run "$here/hello.flan" --target=wasm32-wasi 2>&1)"
+
+# The refusal and diagnostic messages quoted in the prose and in the
+# "Not implemented yet" table.
+for pair in \
+  'vec:(defvar xs (Vec i32))' \
+  'map:(defvar m (Map string i32))' \
+  'result:(defn f [] (Result i32 i32) None)' \
+  'handle:(defvar h (Handle i32))' \
+  'fnty:(defn f [g (Fn [i32] i32)] i32 (g 1))' \
+  'quoted:(defn f [] i32 (quote a))' \
+  'deferblock:(defn f [] i32 (let [x 1] (defer (print-line "a")) x))' \
+  'i64index:(defconst xs [3 i32] [1 2 3]) (defn main [] i32 (let [i (i64 1)] (at xs i)))'
+do
+  name=${pair%%:*}; src=${pair#*:}
+  printf '%s\n' "$src" > "$here/.q.flan"
+  msg=$("$FLAN" check "$here/.q.flan" 2>&1 | sed 's/^[^ ]*: //')
+  want "message: $name" "$msg"
+done
+rm -f "$here/.q.flan"
+
+# The cell and the transfer channel, from a real --dev emit of hello.flan.
+ir=$("$FLAN" emit --dev "$here/hello.flan" 2>/dev/null)
+want "cell global"   "$(printf '%s\n' "$ir" | grep '^@"flan.cell.print-line"')"
+want "cell load"     "$(printf '%s\n' "$ir" | grep 'load ptr, ptr @"flan.cell.print-line"')"
+want "xfer channel"  "$(printf '%s\n' "$ir" | grep 'define {} @"flan.main"')"
+
+# The generated C, from flan shim.
+want "shim wrapper" "$("$FLAN" shim "$here/shimdemo.flan" | grep 'GetMousePosition();')"
+
+# Lines quoted verbatim from repository files.
+want "raylib binding" "$(grep -F 'unload-texture' "$root/vendor/raylib/raylib.flan")"
+want "agent declare"  "$(grep -F 'flan_agent_poll' "$root/vendor/agent/agent.flan" | head -1)"
+want "conditions.org" "$(grep -F 'Innermost frame offering the name wins' "$root/conditions.org")"
+want "renderer"       "$(grep -F ':r 17 :g 34 :b 51 :a 68' "$root/NEXT.md")"
+
+# The Emacs bindings, from the keymap rather than from any prose about it.
+for k in "C-c C-c" "C-c C-k" "C-x C-e" "C-c C-b" "C-c C-v" "C-c C-x"; do
+  grep -qF "(kbd \"$k\")" "$root/emacs/flan-mode.el" || {
+    echo "FAIL  keybinding $k is not in flan-mode.el"; fail=1; continue; }
+  want "keybinding $k" "<kbd>$k</kbd>"
+done
+
+exit $fail

web/examples/restart.flan

@@ -0,0 +1,24 @@
+(defstruct AssetMissing [id i32])
+
+(defvar cleanups i64)
+
+(defn load [n i32] i32
+  (signal (AssetMissing {:id n}))
+  100)
+
+(defn middle [n i32] i32
+  (defer (set cleanups (+ cleanups 1)))   ; runs on the transfer too
+  (+ (load n) 1))
+
+(defn fetch [n i32] i32
+  (restart-case (middle n)                ; its value if nothing transfers
+    (use-placeholder [] -1)
+    (retry           [] 7)))
+
+(defn main []
+  (print-i64 (i64 (fetch 1))) (newline)   ; 101 — nothing handled it
+
+  (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
+    (print-i64 (i64 (fetch 2))) (newline)) ; -1
+
+  (print-i64 cleanups) (newline))         ; 2 — the defer ran both times

web/examples/restart.out

@@ -0,0 +1,4 @@
+101
+-1
+2
+exit 0

web/examples/shimdemo.flan

@@ -0,0 +1,7 @@
+(defstruct Vector2 [x f32  y f32])
+
+(declare-c get-mouse-position [] Vector2 "GetMousePosition")
+
+(defn main []
+  (print-f64 (f64 (.x (get-mouse-position))))
+  (newline))

web/examples/structs.flan

@@ -0,0 +1,17 @@
+(defstruct Cursor
+  [src [u8]      ; a non-owning slice
+   pos i32])     ; no initialiser means zeroed
+
+(defn peek [c (Ptr Cursor)] u8
+  (if (< (.pos c) (len (.src c)))
+    (at (.src c) (.pos c))
+    0))
+
+(defn advance [c (Ptr Cursor)]
+  (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
+    (print-i64 (i64 (peek (addr c)))) (newline)
+    (advance (addr c))
+    (print-i64 (i64 (peek (addr c)))) (newline)))

web/examples/structs.out

@@ -0,0 +1,3 @@
+104
+105
+exit 0