Emit wasm

NEXT.md

@@ -24,7 +24,7 @@ reader ✅ → parse ✅ → check ✅ → emit ✅ → clang ✅
 | `runtime/flan_rt.c` | the whole host ABI: argv, stdout, exit, 4 conversions |
 | `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run` |
 | `test/test_flan.ml` | reader, parser and checker |
-| `test/test_acceptance.ml` | 20 expression/result pairs + 3 whole programs |
+| `test/test_acceptance.ml` | 20 expression/result pairs + 3 whole programs + the traps |
 | `test/programs/*.flan` | the milestone-2 surface calc-me does not reach |
 
 ```
@@ -86,16 +86,65 @@ nothing marshals. Two consequences carry the semantics:
 Non-local exit is lowered explicitly: `return` and `some` are branches to a
 `ret`, never platform unwinding, so wasm32 needs no exception proposal.
 
+## Bounds checks — done
+
+`at` and `slice` no longer emit a bare `getelementptr`. A failure is a branch
+to a `noreturn cold` call and then `unreachable` — the same explicit shape as
+`return` and `some`, so wasm32 needs nothing extra for it either. The message
+carries the source location, because `Tast.expr` keeps a `Loc.t` and a language
+that threads locations through the whole frontend should not trap anonymously:
+
+```
+$ flan run test/programs/bounds.flan 2
+test/programs/bounds.flan:25:29: slice [2 1) is out of bounds for length 5   (exit 134)
+```
+
+Three check sites, and the third is the one with the trap in it:
+
+- **`at` on `[n T]`** — the bound is static, so LLVM folds the check away for a
+  literal index. A literal that is *out* of bounds still only traps at runtime;
+  rejecting it in `check.ml` is a separate job.
+- **`at` on a slice or string** — the bound is the runtime len.
+- **`slice`** — *two* comparisons, `lo <= hi` and `hi <= len`, both non-strict
+  because a slice ending at len (or an empty one at `lo = len`) is legal and
+  its one-past-the-end gep is defined. `lo <= hi` is not redundant: without it
+  a reversed range yields `hi - lo` as a huge unsigned length, which is a worse
+  hole than the missing check was.
+
+All comparisons are unsigned. Indices are i32 sign-extended to i64 for the gep,
+so a negative one arrives as a huge unsigned value and one test catches both
+directions; the runtime still prints the signed value in the message.
+
+`Build.opts.checks` is on by default and **is not tied to `opts.opt`** — dev
+traps, release does not, and that is a release decision rather than an
+optimisation one. Keeping them separate is what lets the acceptance table go on
+running the same programs at `-O0` and `-O2` with identical checks. The CLI
+flag is `--no-bounds-checks`, on `build` and `emit`.
+
+The write path is its own case. `(set (at arr n) …)` lowers through
+`place`/`Pindex`, not through `At`, so a refactor that split them would break
+the write check silently — the test covers both.
+
+`test/programs/bounds.flan` is one program with one case per argument, because
+a trap ends the process. The acceptance test asserts the exit code, that the
+message names the file, and the reason — but not line and column, so editing
+the program does not break the test that reads it. It runs at both `-O0` and
+`-O2`, and one more case checks the IR directly: `--no-bounds-checks` emits no
+`call` to either failure function. (The two `declare`s stay in the header
+unconditionally; LLVM drops the unused ones.)
+
 ## Next
 
 1. **wasm32.** The backend is there (`llc` lists `wasm32`) and
    `Build.opts.target` already plumbs `--target`, but there is **no wasi
    sysroot on this machine** — `clang --target=wasm32-wasi` cannot find
-   `stdio.h`. Install `wasi-sdk`/`wasi-libc`, then run the same acceptance
-   table on both targets in CI. That is milestone 3's real remaining work.
-2. **Bounds checks.** `at` and `slice` emit a bare `getelementptr`. Dev builds
-   should trap; release should not.
-3. **Then milestone 4** — sand.flan: fixed 2-D arrays (done), `dotimes`,
+   `stdio.h`. Install `wasi-sdk`/`wasi-libc` (`dnf search wasi` for the Fedora
+   package name), then run the same acceptance table on both targets in CI.
+   That is milestone 3's real remaining work. The bounds work above was written
+   to survive the port — no unwinding, and `exit(134)` rather than `abort()`,
+   so the same trap assertion should hold on wasm32 — but that is intent, not a
+   tested result: nothing here has ever been built for wasm32.
+2. **Then milestone 4** — sand.flan: fixed 2-D arrays (done), `dotimes`,
    `defer`, and typed raylib FFI with keyword→enum coercion.
 
 ## Watch for

bin/main.ml

@@ -23,6 +23,10 @@ let summarise (d : Flan.Ast.decl) =
       (match fn.ret with None -> "Unit" | Some _ -> "explicit")
       (List.length fn.fbody)
 
+(* Bounds checks are on unless a build asks for them off — the release
+   decision, not the optimisation level (NEXT.md, Bounds checks). *)
+let no_checks_flag = "--no-bounds-checks"
+
 let () =
   match Array.to_list Sys.argv with
   | _ :: "read" :: files when files <> [] ->
@@ -63,28 +67,35 @@ let () =
                   (Flan.Types.to_string f.ret) (Array.length f.slots))
              p.fns))
       files
-  | _ :: "emit" :: files when files <> [] ->
+  | _ :: "emit" :: args when List.exists (fun a -> a <> no_checks_flag) args ->
+    let checks = not (List.mem no_checks_flag args) in
+    let files = List.filter (fun a -> a <> no_checks_flag) args in
     List.iter
       (fun path ->
          with_errors path (fun () ->
            Flan.Reader.read_file path
            |> Flan.Parse.program
            |> Flan.Check.program
-           |> Flan.Emit.program
+           |> Flan.Emit.program ~checks
            |> print_string))
       files
   | _ :: "build" :: path :: rest ->
+    let checks = not (List.mem no_checks_flag rest) in
     let out =
-      match rest with
+      match List.filter (fun a -> a <> no_checks_flag) rest with
       | [ "-o"; o ] -> o
       | [] -> Filename.remove_extension (Filename.basename path)
-      | _ -> prerr_endline "usage: flan build <file.flan> [-o out]"; exit 2
+      | _ ->
+        prerr_endline
+          "usage: flan build <file.flan> [-o out] [--no-bounds-checks]";
+        exit 2
     in
     with_errors path (fun () ->
       Flan.Reader.read_file path
       |> Flan.Parse.program
       |> Flan.Check.program
-      |> fun p -> ignore (Flan.Build.executable p ~out))
+      |> fun p ->
+      ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks } p ~out))
   | _ :: "run" :: path :: args ->
     with_errors path (fun () ->
       let exe =
@@ -104,6 +115,6 @@ let () =
   | _ ->
     prerr_endline
       "usage: flan (read|parse|check|emit) <file.flan>...\n\
-      \       flan build <file.flan> [-o out]\n\
+      \       flan build <file.flan> [-o out] [--no-bounds-checks]\n\
       \       flan run <file.flan> [args...]";
     exit 2

lib/build.ml

@@ -29,15 +29,20 @@ type opts = {
   target : string option;   (* None is the host; "wasm32-wasi" is the other *)
   opt    : string;
   keep   : bool;            (* leave the .ll behind *)
+  checks : bool;            (* bounds-check [at] and [slice] *)
 }
 
-let default = { target = None; opt = "-O2"; keep = false }
+(* Checks are deliberately independent of [opt]: the acceptance table runs the
+   same programs at -O0 and -O2 to compare the emitted IR against what mem2reg
+   makes of it, and that comparison is only meaningful if both emit the same
+   checks. Dropping them is a release decision, not an optimisation one. *)
+let default = { target = None; opt = "-O2"; keep = false; checks = true }
 
 let executable ?(opts = default) (p : Tast.program) ~out =
   let dir = workdir () in
   let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
   let rt = Filename.concat dir "flan_rt.c" in
-  write ll (Emit.program p);
+  write ll (Emit.program ~checks:opts.checks p);
   write rt Runtime_src.source;
   let cmd =
     String.concat " "

lib/emit.ml

@@ -80,6 +80,7 @@ type m = {
   strs    : Buffer.t;                        (* string literal constants *)
   structs : (string, Tast.structure) Hashtbl.t;
   globals : (string, Types.t) Hashtbl.t;
+  checks  : bool;                            (* emit bounds checks *)
   mutable nstr : int;
 }
 
@@ -141,14 +142,67 @@ let escape s =
     s;
   Buffer.contents b
 
-let string_const m s =
+(* The constant itself, as the pointer and length a caller needs separately —
+   a bounds message crosses to C as ptr+len like any other slice. *)
+let string_bytes m s =
   let id = Printf.sprintf "@\".str.%d\"" m.nstr in
   m.nstr <- m.nstr + 1;
   Buffer.add_string m.strs
     (Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\"\n"
        id (String.length s) (escape s));
+  id, String.length s
+
+let string_const m s =
+  let id, n = string_bytes m s in
   (* The value alone: LLVM takes the type from the operand's context. *)
-  Printf.sprintf "{ ptr %s, i64 %d }" id (String.length s)
+  Printf.sprintf "{ ptr %s, i64 %d }" id n
+
+(* ── Bounds checks ───────────────────────────────────────────────────── *)
+
+(* A failure is a branch to a [noreturn] call and then [unreachable] — the same
+   explicit shape as [return] and [some], so wasm32 needs no unwinding for it
+   either. Whether to check is its own flag, not the optimisation level: dev
+   builds trap, release builds do not (NEXT.md), and the acceptance table runs
+   at both -O0 and -O2 with the checks on either way.
+
+   Indices are i32 in Flan and sign-extended to i64 for the gep, so a negative
+   one arrives here as a huge unsigned value: an unsigned comparison catches
+   the negative and the too-large case in a single test. *)
+let fail_block f (loc : Loc.t) ok emit_call =
+  let good = fresh_label f "inb" and bad = fresh_label f "oob" in
+  term f "br i1 %s, label %%%s, label %%%s" ok good bad;
+  label f bad;
+  let id, n = string_bytes f.md (Loc.to_string loc) in
+  emit_call id n;
+  term f "unreachable";
+  label f good
+
+(* [at] is strict: the last valid index is len - 1. *)
+let check_at f loc idx len =
+  if f.md.checks then begin
+    let ok = fresh f in
+    ins f "%s = icmp ult i64 %s, %s" ok idx len;
+    fail_block f loc ok (fun id n ->
+      ins f "call void @flan_bounds_fail(ptr %s, i64 %d, i64 %s, i64 %s)"
+        id n idx len)
+  end
+
+(* [slice] is not: a slice ending at len — or an empty one at lo = len — is
+   legal, and its one-past-the-end gep is defined. [lo <= hi] is not redundant
+   with it, because a reversed range would otherwise yield hi - lo as a huge
+   unsigned length, which is a worse hole than the missing check. *)
+let check_slice f loc lo hi len =
+  if f.md.checks then begin
+    let a = fresh f in
+    ins f "%s = icmp ule i64 %s, %s" a lo hi;
+    let b = fresh f in
+    ins f "%s = icmp ule i64 %s, %s" b hi len;
+    let ok = fresh f in
+    ins f "%s = and i1 %s, %s" ok a b;
+    fail_block f loc ok (fun id n ->
+      ins f "call void @flan_slice_fail(ptr %s, i64 %d, i64 %s, i64 %s, i64 %s)"
+        id n lo hi len)
+  end
 
 (* ── Expressions ───────────────────────────────────────────────────── *)
 
@@ -254,7 +308,9 @@ and element_addr f (target : Tast.expr) idx =
       let i64 = fresh f in
       ins f "%s = sext %s %s to i64" i64 (ll i.Tast.ty) iv;
       (match ty with
-       | Types.Array (_, elem) ->
+       | Types.Array (n, elem) ->
+         (* The bound is static; LLVM folds the check away for a literal index. *)
+         check_at f i.Tast.loc i64 (Int64.to_string n);
          let p = fresh f in
          ins f "%s = getelementptr inbounds %s, ptr %s, i64 0, i64 %s"
            p (ll ty) ptr i64;
@@ -264,6 +320,9 @@ and element_addr f (target : Tast.expr) idx =
          let s = load f ptr ty in
          let base = fresh f in
          ins f "%s = extractvalue %%slice %s, 0" base s;
+         let len = fresh f in
+         ins f "%s = extractvalue %%slice %s, 1" len s;
+         check_at f i.Tast.loc i64 len;
          let p = fresh f in
          ins f "%s = getelementptr inbounds %s, ptr %s, i64 %s" p (ll elem) base i64;
          go p elem rest
@@ -424,7 +483,6 @@ and emit_unwrap f ty v =
 (* ── Primitives ────────────────────────────────────────────────────── *)
 
 and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
-  ignore e;
   match p, args with
   | (Tast.Add | Tast.Sub | Tast.Mul | Tast.Div | Tast.Rem), [ x; y ] ->
     let a = value f x in
@@ -480,10 +538,15 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
     let hiv = value f hi in
     let lo64 = fresh f in
     ins f "%s = sext i32 %s to i64" lo64 lov;
+    let hi64 = fresh f in
+    ins f "%s = sext i32 %s to i64" hi64 hiv;
+    (* The source is read once, and the check goes between reading it and the
+       gep: the length it is checked against must be the one the gep uses. *)
     let base =
       match target.Tast.ty with
-      | Types.Array (_, _) ->
+      | Types.Array (n, _) ->
         let a = addr f target in
+        check_slice f e.Tast.loc lo64 hi64 (Int64.to_string n);
         let p = fresh f in
         ins f "%s = getelementptr inbounds %s, ptr %s, i64 0, i64 %s"
           p (ll target.Tast.ty) a lo64;
@@ -492,6 +555,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
         let v = value f target in
         let q = fresh f in
         ins f "%s = extractvalue %%slice %s, 0" q v;
+        let n = fresh f in
+        ins f "%s = extractvalue %%slice %s, 1" n v;
+        check_slice f e.Tast.loc lo64 hi64 n;
         let p = fresh f in
         ins f "%s = getelementptr inbounds %s, ptr %s, i64 %s" p (ll elem) q lo64;
         p
@@ -499,19 +565,20 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
         let v = value f target in
         let q = fresh f in
         ins f "%s = extractvalue %%slice %s, 0" q v;
+        let n = fresh f in
+        ins f "%s = extractvalue %%slice %s, 1" n v;
+        check_slice f e.Tast.loc lo64 hi64 n;
         let p = fresh f in
         ins f "%s = getelementptr inbounds i8, ptr %s, i64 %s" p q lo64;
         p
       | t -> failwith ("slice of " ^ Types.to_string t)
     in
     let d = fresh f in
-    ins f "%s = sub i32 %s, %s" d hiv lov;
-    let n = fresh f in
-    ins f "%s = sext i32 %s to i64" n d;
+    ins f "%s = sub i64 %s, %s" d hi64 lo64;
     let a = fresh f in
     ins f "%s = insertvalue %%slice zeroinitializer, ptr %s, 0" a base;
     let b = fresh f in
-    ins f "%s = insertvalue %%slice %s, i64 %s, 1" b a n;
+    ins f "%s = insertvalue %%slice %s, i64 %s, 1" b a d;
     b
   (* string and [u8] have the same layout, so bytes is the identity — a view,
      no copy (plan.org, Milestone-2 primitives). *)
@@ -668,6 +735,8 @@ declare double @flan_bytes_to_f64(ptr, i64)
 declare i64 @flan_bytes_to_i64(ptr, i64)
 declare void @flan_f64_to_bytes(double, ptr)
 declare void @flan_i64_to_bytes(i64, ptr)
+declare void @flan_bounds_fail(ptr, i64, i64, i64) noreturn cold
+declare void @flan_slice_fail(ptr, i64, i64, i64, i64) noreturn cold
 |}
 
 (* C's main, adapting to whichever of the four shapes Flan's main has: argv and
@@ -695,10 +764,13 @@ let emit_main m (fn : Tast.fn) =
   Buffer.add_string b ")\n  unreachable\n}\n";
   Buffer.add_string m.out (Buffer.contents b)
 
-let program (p : Tast.program) : string =
+(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
+   [slice], a release build is told to drop them. *)
+let program ?(checks = true) (p : Tast.program) : string =
   let m = {
     out = Buffer.create 8192; strs = Buffer.create 512;
-    structs = Hashtbl.create 16; globals = Hashtbl.create 16; nstr = 0;
+    structs = Hashtbl.create 16; globals = Hashtbl.create 16;
+    checks; nstr = 0;
   } in
   List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s)
     p.Tast.structs;

runtime/flan_rt.c

@@ -84,3 +84,38 @@ void flan_i64_to_bytes(int64_t x, flan_slice *out) {
   out->ptr = (const uint8_t *)scratch;
   out->len = n < 0 ? 0 : (int64_t)n;
 }
+
+/* Bounds failures. The emitted code branches here and then falls off the end
+ * with `unreachable`, so these must not return — the same explicit shape as
+ * every other non-local exit, which is what keeps wasm32 free of unwinding.
+ *
+ * The location is passed as ptr+len because that is what a Flan string already
+ * is; nothing here allocates. Exit 134 is abort()'s status without abort()'s
+ * signal, so the same assertion should hold once wasm32 builds.
+ *
+ * stdout is flushed *before* the message: stderr is unbuffered and a
+ * redirected stdout is not, so without this the error appears above the output
+ * that led to it. */
+
+static _Noreturn void rt_die(void) {
+  fflush(stdout);
+  fflush(stderr);
+  exit(134);
+}
+
+_Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen,
+                                int64_t idx, int64_t len) {
+  fflush(stdout);
+  fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n",
+          (int)loclen, (const char *)loc, (long long)idx, (long long)len);
+  rt_die();
+}
+
+_Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen,
+                               int64_t lo, int64_t hi, int64_t len) {
+  fflush(stdout);
+  fprintf(stderr, "%.*s: slice [%lld %lld) is out of bounds for length %lld\n",
+          (int)loclen, (const char *)loc, (long long)lo, (long long)hi,
+          (long long)len);
+  rt_die();
+}

test/programs/bounds.flan

@@ -0,0 +1,31 @@
+;;;; Bounds checks, NEXT.md item 2. One program, one case per argument, so a
+;;;; trap is observable: the checked build exits 134 with the source location
+;;;; on stderr, the unchecked one runs off the end and is not asserted on.
+;;;;
+;;;; The selector is also the index wherever it can be, which is what keeps the
+;;;; index dynamic — a literal would let the checker reject it outright one day
+;;;; (that is a separate job) and lets LLVM fold the branch away here.
+(defvar arr [3 i32])
+
+(defn main [args [string]] i32
+  (let [n (i32 (bytes->i64 (bytes (at args 1))))
+        s (bytes "hello")]                     ; len 5
+    (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 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
+      ;; 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
+
+      :else (print-line "?"))
+    0))

test/test_acceptance.ml

@@ -23,15 +23,21 @@ let run exe arg =
   Sys.remove out;
   (code, text)
 
-let compile ?(opt = "-O2") path =
+let compile ?(opt = "-O2") ?(checks = true) path =
   let exe =
     Filename.concat scratch
       ("flan-t-" ^ Filename.remove_extension (Filename.basename path))
   in
   let p = Reader.read_file path |> Parse.program |> Check.program in
-  ignore (Build.executable ~opts:{ Build.default with opt } p ~out:exe);
+  ignore (Build.executable ~opts:{ Build.default with opt; checks } p ~out:exe);
   exe
 
+(* No Str, and the reader is hand-written for the same reason. *)
+let contains hay needle =
+  let n = String.length needle and h = String.length hay in
+  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
+  go 0
+
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1" with
   | 0 ->
@@ -106,6 +112,71 @@ let () =
     outputs ~opt:"-O0" "value semantics, -O0" "programs/values.flan" values_out;
     outputs ~opt:"-O0" "machine surface, -O0" "programs/machine.flan" machine_out;
 
+    (* Bounds checks, NEXT.md item 2. A trap has no result — it has a nonzero
+       exit and a message on stderr — so it needs a case shape the table above
+       does not have. What is asserted is the *reason*: the location, and which
+       index against which length. The line and column are not pinned, because
+       editing the program should not break the test that reads it. *)
+    let bounds ?opt () =
+      let exe = compile ?opt "programs/bounds.flan" in
+      let traps name arg reason =
+        let code, text = run exe (Some arg) in
+        if code <> 134
+           || not (contains text "programs/bounds.flan:")
+           || not (contains text reason)
+        then begin
+          incr failures;
+          Printf.printf
+            "FAIL  %s\n        got: %S (exit %d)\n     wanted: %S (exit 134)\n"
+            name text code reason
+        end
+      in
+      (* Both edges are in bounds and must not trap: the last index of a fixed
+         array, a slice ending exactly at len, and an empty slice at len. *)
+      let code, text = run exe (Some "0") in
+      if text <> "0ello\n" || code <> 0 then begin
+        incr failures;
+        Printf.printf "FAIL  in-bounds edges\n        got: %S (exit %d)\n" text code
+      end;
+      traps "at past a fixed array" "3"
+        "index 3 is out of bounds for length 3";
+      (* Negative indices sext to a huge unsigned, so the one unsigned
+         comparison catches them; the message still reports the signed value. *)
+      traps "at with a negative index" "-1"
+        "index -1 is out of bounds for length 3";
+      traps "at past a slice" "9"
+        "index 9 is out of bounds for length 5";
+      (* A different lowering — place/Pindex, not At — so it is its own case. *)
+      traps "set past a fixed array" "7"
+        "index 7 is out of bounds for length 3";
+      traps "slice with hi past len" "4"
+        "slice [4 9) is out of bounds for length 5";
+      (* Without the lo <= hi test this one would not trap: it would build a
+         slice of length hi - lo as a huge unsigned, which is worse. *)
+      traps "slice with a reversed range" "2"
+        "slice [2 1) is out of bounds for length 5";
+      (try Sys.remove exe with Sys_error _ -> ())
+    in
+    bounds ();
+    bounds ~opt:"-O0" ();
+
+    (* The release build drops them — the calls, that is; the two declarations
+       stay in the header and LLVM discards the unused ones. Asserted on the IR
+       rather than by running an unchecked out-of-bounds program, which has no
+       defined behaviour to assert on. *)
+    let p =
+      Reader.read_file "programs/bounds.flan" |> Parse.program |> Check.program
+    in
+    if not (contains (Emit.program p) "call void @flan_bounds_fail(") then begin
+      incr failures;
+      print_endline "FAIL  checks on: no bounds call emitted"
+    end;
+    let off = Emit.program ~checks:false p in
+    if contains off "call void @flan_bounds_fail(" || contains off "call void @flan_slice_fail(" then begin
+      incr failures;
+      print_endline "FAIL  --no-bounds-checks: a check survived"
+    end;
+
     if !failures = 0 then print_endline "acceptance: all tests passed"
     else begin
       Printf.printf "\n%d failure(s)\n" !failures;