Add AST and forms->AST parser

Second stage of the milestone-2 frontend. calc-me.flan (12 decls) and
sand.flan (20 decls) both parse end to end, and both are test deps so a
regression fails `dune test` rather than surfacing at the CLI.

Three silent-misparse bugs fixed along the way -- all cases that read
cleanly and meant something else:

- dotimes/defer/some/try/fn fell through to Call, discarding their
  binding and control-flow meaning. Now special forms. Forms from later
  milestones (handler-bind, restart-case, loop/recur, defmacro, signal,
  with-allocator, errdefer, await) are rejected outright rather than
  parsed as calls.
- (Some 1) in first body position was read as a return type, because
  (Option f64) and (Some 1) are identical s-expressions and the
  heuristic was capitalisation. Now decided by the set of names actually
  declared as types, collected in a pre-pass -- exact, and
  order-independent so a type declared below its user still resolves.
- Array literals in value position were rejected outright.

Also adds NEXT.md with the handoff for the checker.

NEXT.md

@@ -0,0 +1,64 @@
+# Where this is
+
+Milestone 2 of the build sequence in `plan.org`: *run `calc-me.flan` on the
+interpreter*. Two of four stages exist.
+
+```
+reader ✅ → parse ✅ → check ⬜ → interpret ⬜
+```
+
+| File | What it does |
+|---|---|
+| `lib/loc.ml` | source locations + `Loc.Error`, the frontend's one exception |
+| `lib/form.ml` | reader output: `Sym Kw Int Float Str Byte List Vec Map` |
+| `lib/reader.ml` | hand-written S-expression reader, no menhir/ocamllex |
+| `lib/ast.ml` | AST: `texpr`, `expr`, `place`, `pattern`, `decl` |
+| `lib/parse.ml` | forms → AST; special forms, desugaring, declarations |
+| `bin/main.ml` | `flan read <file>` and `flan parse <file>` |
+| `test/test_flan.ml` | 110+ assertions; `calc-me.flan` and `sand.flan` are deps |
+
+`dune build && dune test` is green. `flan parse calc-me.flan` and
+`flan parse sand.flan` both succeed.
+
+## Next: `lib/types.ml` and the checker
+
+1. **Type representation.** Resolve `Ast.texpr` into a real type. Needs the
+   declared-type environment `Parse.declared_types` already computes — that
+   pre-pass exists and should be reused rather than rebuilt.
+2. **Top-level environment.** Two passes, because top-level names are
+   order-independent (`plan.org`, Modules): collect all signatures, then check
+   bodies.
+3. **Check `calc-me.flan`.** It needs: `i32`/`u8`/`f64`/`bool`, structs, `[u8]`
+   slices, `(Ptr T)` with one level of auto-deref on `.field`, `(Option T)` with
+   `Some`/`None`, `Unwrap (Usome, _)` as early-return-None, `while`, `return`,
+   `set` on the five places, `match` on `Option`, and the milestone-2 primitive
+   list in `plan.org`.
+4. **Then the interpreter** over the typed IR.
+
+## Watch for
+
+The two bugs found so far were both *silent misparses* — code that read fine and
+meant something else:
+
+- `'skip-form` became a symbol named `'skip-form`
+- `dotimes`/`defer`/`some` fell through to `Call`, discarding their binding and
+  control-flow meaning
+- `(Some 1)` in first body position was eaten as a return type
+
+The rule that catches this class: **anything that binds a name, alters control
+flow, or is not yet implemented must be recognised explicitly and rejected if
+unsupported — never allowed to fall through to a generic case.** `parse.ml`
+rejects `handler-bind`, `restart-case`, `loop`/`recur`, `defmacro`, `signal`,
+`with-allocator`, `errdefer` and `await` for exactly this reason. Keep doing that
+in the checker.
+
+## Open decisions that touch the checker
+
+None block milestone 2. `plan.org` tags each open decision with the milestone it
+is due by; #1 (host language) is now settled as OCaml.
+
+## Untracked on purpose
+
+`old-ocaml/` — the pre-rewrite menhir/ocamllex frontend, kept as reference and
+excluded from the build by the root `dune` file. Its contents are also in git
+history at `2c232dd`.

bin/main.ml

@@ -1,18 +1,45 @@
-(* flan — milestone 2 driver. Right now: read a file and print the forms back,
+(* flan — milestone 2 driver. *)
-   which is the first thing worth having and the first thing worth testing. *)
+
+let with_errors path f =
+  try f () with
+  | Flan.Loc.Error (loc, msg) ->
+    Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg;
+    ignore path;
+    exit 1
+
+let summarise (d : Flan.Ast.decl) =
+  let open Flan.Ast in
+  match d.d with
+  | Package n -> Printf.sprintf "package %s" n
+  | Import (a, p) -> Printf.sprintf "import %s %S" a p
+  | Defalias (n, _) -> Printf.sprintf "defalias %s" n
+  | Defstruct (n, fs) -> Printf.sprintf "defstruct %s (%d fields)" n (List.length fs)
+  | Defunion (n, vs) -> Printf.sprintf "defunion %s (%d cases)" n (List.length vs)
+  | Defvar (n, _, _) -> Printf.sprintf "defvar %s" n
+  | Defconst (n, _, _) -> Printf.sprintf "defconst %s" n
+  | Defn fn ->
+    Printf.sprintf "defn %s (%d params, %s return, %d body forms)"
+      fn.name (List.length fn.params)
+      (match fn.ret with None -> "Unit" | Some _ -> "explicit")
+      (List.length fn.fbody)
 
 let () =
   match Array.to_list Sys.argv with
   | _ :: "read" :: files when files <> [] ->
     List.iter
       (fun path ->
-         try
+         with_errors path (fun () ->
            Flan.Reader.read_file path
-           |> List.iter (fun f -> print_endline (Flan.Form.to_string f))
+           |> List.iter (fun f -> print_endline (Flan.Form.to_string f))))
-         with Flan.Loc.Error (loc, msg) ->
+      files
-           Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg;
+  | _ :: "parse" :: files when files <> [] ->
-           exit 1)
+    List.iter
+      (fun path ->
+         with_errors path (fun () ->
+           Flan.Reader.read_file path
+           |> Flan.Parse.program
+           |> List.iter (fun d -> print_endline (summarise d))))
       files
   | _ ->
-    prerr_endline "usage: flan read <file.flan>...";
+    prerr_endline "usage: flan (read|parse) <file.flan>...";
     exit 2

dune

@@ -0,0 +1,3 @@
+; old-ocaml/ is kept as reference only — the pre-rewrite menhir/ocamllex
+; frontend. Not built, not part of this project.
+(dirs :standard \ old-ocaml)

lib/ast.ml

@@ -0,0 +1,103 @@
+(** The AST: syntax with special forms recognised, before typing.
+
+    Sugar is gone by this point. [when], [unless], [cond] and [and]/[or] are
+    desugared into [If] and [Do]; they are compiler special forms until macros
+    arrive at milestone 5, so there is nothing to preserve for a macroexpander
+    to see yet.
+
+    Types here are *surface* type expressions, not resolved types. [Ptr] and
+    [Option] are still just names; the checker resolves them. *)
+
+(* ── Type expressions ──────────────────────────────────────────────── *)
+
+type texpr = { t : texpr_kind; tloc : Loc.t }
+
+and texpr_kind =
+  | Tname  of string                  (* i32  bool  Cursor  string *)
+  | Tslice of texpr                   (* [u8]                      ptr+len *)
+  | Tarray of len * texpr             (* [4 f32]  [rows [cols u32]]        *)
+  | Tmap   of texpr * texpr           (* {string i32}                      *)
+  | Tapp   of string * texpr list     (* (Ptr Cursor)  (Option f64)        *)
+  | Tfn    of texpr list * texpr      (* (Fn [a a] bool)                   *)
+
+(* An array length is an integer or a compile-time constant's name. *)
+and len =
+  | Lint  of int64
+  | Lname of string
+
+(* ── Expressions ───────────────────────────────────────────────────── *)
+
+type expr = { e : expr_kind; loc : Loc.t }
+
+and expr_kind =
+  | Int    of int64
+  | Float  of float
+  | Byte   of int
+  | Str    of string
+  | Kw     of string                  (* :space — coerced at typed call sites *)
+  | Quote  of string                  (* 'skip-form — restart names *)
+  | Var    of string
+  | Do     of expr list
+  | Let    of binding list * expr list
+  | If     of expr * expr * expr option
+  | While  of expr * expr list
+  | Return of expr option
+  | Set    of place * expr
+  | 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}) *)
+  | 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 *)
+  | Dotimes of string * expr * expr list      (* (dotimes [i n] ...)           *)
+  | Defer   of expr list                      (* runs on scope exit            *)
+  | Unwrap  of unwrap * expr                  (* (some x) / (try x)            *)
+
+(* Two unwrap operators, because they are two different things — plan.org. *)
+and unwrap = Usome | Utry
+
+and binding = { bname : string; bty : texpr option; bval : expr; bloc : Loc.t }
+
+(* The fixed list of assignable forms — spec-memory.md. Not setf. *)
+and place =
+  | Pvar   of string
+  | Pfield of expr * string           (* (set (.hp e) v)      *)
+  | Pindex of expr * expr list        (* (set (at grid r c) v) *)
+  | Pkey   of expr * expr             (* (set (get m k) v)     *)
+  | Pderef of expr                    (* (set (deref p) v)     *)
+
+and arm = { pat : pattern; body : expr list; aloc : Loc.t }
+
+and pattern =
+  | Pctor of string * string list     (* (Some e)  (Rect w h)  None *)
+  | Pwild                             (* _  :else *)
+
+(* ── Declarations ──────────────────────────────────────────────────── *)
+
+type field = { fname : string; fty : texpr; floc : Loc.t }
+
+type fn = {
+  name    : string;
+  params  : field list;
+  ret     : texpr option;             (* None means Unit *)
+  fbody   : expr list;
+  nloc    : Loc.t;
+}
+
+type decl = { d : decl_kind; dloc : Loc.t }
+
+and decl_kind =
+  | Package  of string
+  | Import   of string * string       (* alias, path *)
+  | Defalias of string * texpr
+  | Defstruct of string * field list
+  | Defunion of string * variant list
+  | Defn     of fn
+  (* value is optional: ZII. `uninit` opts out and is recorded as Uninit. *)
+  | Defvar   of string * texpr option * init
+  | Defconst of string * texpr option * expr
+
+and variant = { vname : string; vfields : field list; vloc : Loc.t }
+
+and init = Zeroed | Uninit | Init of expr

lib/parse.ml

@@ -0,0 +1,414 @@
+(** Forms → AST. Recognises special forms, desugars sugar, reports malformed
+    syntax with the location of the offending form.
+
+    Everything not recognised here is a call, which is how a Lisp should work:
+    [at], [len], [push], [abort] and the rest are ordinary functions resolved
+    by the checker, not syntax. *)
+
+open Form
+
+let fail (f : Form.t) fmt = Loc.fail f.loc fmt
+
+let sym (f : Form.t) =
+  match f.v with
+  | Sym s -> s
+  | _ -> fail f "expected a name, found %s" (Form.to_string f)
+
+(* Primitive type names are lowercase but concrete; every other lowercase name
+   in type position is a type variable (plan.org, Types). *)
+let primitives =
+  [ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64";
+    "f32"; "f64"; "bool"; "string"; "Unit"; "Never" ]
+
+let is_primitive s = List.mem s primitives
+
+module Names = Set.Make (String)
+
+(* Type constructors the language provides. User types are collected by a
+   pre-pass over the file's declarations — see [program]. *)
+let builtin_types =
+  Names.of_list (primitives @ [ "Ptr"; "Option"; "Result"; "Vec"; "Map";
+                                "Handle"; "Fn" ])
+
+(* ── Type expressions ──────────────────────────────────────────────── *)
+
+let rec texpr (f : Form.t) : Ast.texpr =
+  let mk t = { Ast.t; tloc = f.loc } in
+  match f.v with
+  | Sym s -> mk (Ast.Tname s)
+  | Vec [ elem ] -> mk (Ast.Tslice (texpr elem))
+  | Vec [ n; elem ] -> mk (Ast.Tarray (len n, texpr elem))
+  | Vec _ ->
+    fail f "a type in brackets is [T] for a slice or [n T] for a fixed array"
+  | Map [ k; v ] -> mk (Ast.Tmap (texpr k, texpr v))
+  | Map _ -> fail f "a map type is {K V}"
+  | List ({ v = Sym "Fn"; _ } :: rest) ->
+    (match rest with
+     | [ { v = Vec params; _ }; ret ] ->
+       mk (Ast.Tfn (List.map texpr params, texpr ret))
+     | _ -> fail f "a function type is (Fn [T ...] R)")
+  | List ({ v = Sym name; _ } :: args) when args <> [] ->
+    mk (Ast.Tapp (name, List.map texpr args))
+  | _ -> fail f "expected a type, found %s" (Form.to_string f)
+
+and len (f : Form.t) : Ast.len =
+  match f.v with
+  | Int n -> Ast.Lint n
+  | Sym s -> Ast.Lname s
+  | _ -> fail f "an array length is an integer or a constant's name"
+
+(* Inline name/type pairs: [x i32  y f32] — as in let, defstruct and defn. *)
+let rec fields (f : Form.t) (items : Form.t list) : Ast.field list =
+  match items with
+  | [] -> []
+  | name :: ty :: rest ->
+    { Ast.fname = sym name; fty = texpr ty; floc = name.loc } :: fields f rest
+  | [ odd ] ->
+    Loc.fail odd.loc "field %s has no type — these come in name/type pairs"
+      (Form.to_string odd)
+
+(* ── Expressions ───────────────────────────────────────────────────── *)
+
+let rec expr (f : Form.t) : Ast.expr =
+  let mk e = { Ast.e; loc = f.loc } in
+  match f.v with
+  | Int i -> mk (Ast.Int i)
+  | Float x -> mk (Ast.Float x)
+  | Byte b -> mk (Ast.Byte b)
+  | Str s -> mk (Ast.Str s)
+  | Kw k -> mk (Ast.Kw k)
+  | Sym s -> mk (Ast.Var s)
+  (* In value position brackets are a fixed-array literal; in type position
+     they are a slice or array type. Position disambiguates, as with {}. *)
+  | Vec items -> mk (Ast.Arr (List.map expr items))
+  | Map _ -> fail f "a bare map is not an expression; write (Type {:field v})"
+  | List [] -> fail f "() is not an expression"
+  | List (head :: args) -> form f mk head args
+
+and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
+  match head.v with
+  (* ── quote ─────────────────────────────────────────────────────── *)
+  | Sym "quote" ->
+    (match args with
+     | [ { v = Sym s; _ } ] -> mk (Ast.Quote s)
+     | _ -> fail f "quote takes one symbol")
+
+  (* ── sequencing and binding ────────────────────────────────────── *)
+  | Sym "do" -> mk (Ast.Do (List.map expr args))
+
+  | Sym "let" ->
+    (match args with
+     | { v = Vec bs; _ } :: body -> mk (Ast.Let (bindings f bs, body_of body))
+     | _ -> fail f "let is (let [name value ...] body ...)")
+
+  (* ── conditionals ──────────────────────────────────────────────── *)
+  | Sym "if" ->
+    (match args with
+     | [ c; t ] -> mk (Ast.If (expr c, expr t, None))
+     | [ c; t; e ] -> mk (Ast.If (expr c, expr t, Some (expr e)))
+     | _ -> fail f "if is (if test then) or (if test then else)")
+
+  (* Sugar, desugared here: special forms until macros land at milestone 5. *)
+  | Sym "when" ->
+    (match args with
+     | c :: body when body <> [] ->
+       mk (Ast.If (expr c, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None))
+     | _ -> fail f "when is (when test body ...)")
+
+  | Sym "unless" ->
+    (match args with
+     | c :: body when body <> [] ->
+       let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc },
+                                     [ expr c ]); loc = f.loc } in
+       mk (Ast.If (neg, { Ast.e = Ast.Do (body_of body); loc = f.loc }, None))
+     | _ -> fail f "unless is (unless test body ...)")
+
+  | Sym "cond" -> cond f args
+
+  (* Short-circuiting, so they cannot be ordinary calls. *)
+  | Sym "and" -> shortcircuit f args ~is_and:true
+  | Sym "or" -> shortcircuit f args ~is_and:false
+
+  (* ── loops ─────────────────────────────────────────────────────── *)
+  | Sym "while" ->
+    (match args with
+     | c :: body -> mk (Ast.While (expr c, body_of body))
+     | [] -> fail f "while is (while test body ...)")
+
+  | Sym "until" ->
+    (match args with
+     | c :: body ->
+       let neg = { Ast.e = Ast.Call ({ Ast.e = Ast.Var "not"; loc = head.loc },
+                                     [ expr c ]); loc = f.loc } in
+       mk (Ast.While (neg, body_of body))
+     | [] -> fail f "until is (until test body ...)")
+
+  (* ── control ───────────────────────────────────────────────────── *)
+  | Sym "return" ->
+    (match args with
+     | [] -> mk (Ast.Return None)
+     | [ v ] -> mk (Ast.Return (Some (expr v)))
+     | _ -> fail f "return takes at most one value")
+
+  | Sym "set" ->
+    (match args with
+     | [ target; value ] -> mk (Ast.Set (place target, expr value))
+     | _ -> fail f "set is (set place value)")
+
+  | Sym "match" ->
+    (match args with
+     | scrutinee :: rest -> mk (Ast.Match (expr scrutinee, arms f rest))
+     | [] -> fail f "match is (match value pattern body ...)")
+
+  (* ── binding and control: never a call ─────────────────────────── *)
+  (* A form that binds a name or alters control flow cannot fall through to
+     Call — it would parse cleanly and mean the wrong thing, silently. *)
+  | Sym "fn" ->
+    (match args with
+     | { v = Vec ps; _ } :: body when body <> [] ->
+       mk (Ast.Fn (List.map sym ps, body_of body))
+     | _ -> fail f "fn is (fn [param ...] body ...)")
+
+  | Sym "dotimes" ->
+    (match args with
+     | { v = Vec [ n; count ]; _ } :: body ->
+       mk (Ast.Dotimes (sym n, expr count, body_of body))
+     | _ -> fail f "dotimes is (dotimes [name count] body ...)")
+
+  | Sym "defer" ->
+    (match args with
+     | [] -> fail f "defer is (defer body ...)"
+     | body -> mk (Ast.Defer (body_of body)))
+
+  | Sym "some" ->
+    (match args with
+     | [ v ] -> mk (Ast.Unwrap (Ast.Usome, expr v))
+     | _ -> fail f "some is (some option-value)")
+
+  | Sym "try" ->
+    (match args with
+     | [ v ] -> mk (Ast.Unwrap (Ast.Utry, expr v))
+     | _ -> fail f "try is (try result-value)")
+
+  (* Recognised, deliberately unimplemented. Rejected rather than left to fall
+     through to Call, where they would parse and mean nothing. *)
+  | Sym ("handler-bind" | "handler-case" | "restart-case" | "invoke-restart"
+        | "signal" | "errdefer" | "with-allocator" | "loop" | "recur"
+        | "defmacro" | "await" as name) ->
+    fail f "%s is not implemented yet (see the build sequence in plan.org)" name
+
+  (* ── field access: (.pos c) ────────────────────────────────────── *)
+  | Sym s when String.length s > 1 && s.[0] = '.' ->
+    let field = String.sub s 1 (String.length s - 1) in
+    (match args with
+     | [ target ] -> mk (Ast.Field (expr target, field))
+     | _ -> fail f "field access is (.%s value)" field)
+
+  (* ── struct literal: (Cursor {:src s :pos 0}) ───────────────────── *)
+  | Sym name when args <> [] && is_map (List.hd args) ->
+    (match args with
+     | [ { v = Map kvs; _ } ] -> mk (Ast.Struct (name, struct_fields f kvs))
+     | _ -> fail f "a struct literal is (%s {:field value ...})" name)
+
+  (* ── anything else is a call ────────────────────────────────────── *)
+  | _ -> mk (Ast.Call (expr head, List.map expr args))
+
+and is_map (f : Form.t) = match f.v with Map _ -> true | _ -> false
+
+and body_of (items : Form.t list) : Ast.expr list = List.map expr items
+
+and bindings f (items : Form.t list) : Ast.binding list =
+  (* [name value ...] and [name Type value ...] both read; a type is a form
+     that is not a value position — disambiguated by pair vs triple is
+     ambiguous, so let requires (let [name value]) and types are inferred.
+     Annotated locals are not needed by any acceptance program. *)
+  let rec go = function
+    | [] -> []
+    | name :: value :: rest ->
+      { Ast.bname = sym name; bty = None; bval = expr value; bloc = name.loc }
+      :: go rest
+    | [ odd ] ->
+      Loc.fail odd.loc "binding %s has no value — let takes name/value pairs"
+        (Form.to_string odd)
+  in
+  if items = [] then Loc.fail f.loc "let needs at least one binding" else go items
+
+and struct_fields f (items : Form.t list) : (string * Ast.expr) list =
+  let rec go = function
+    | [] -> []
+    | { v = Kw k; _ } :: value :: rest -> (k, expr value) :: go rest
+    | other :: _ :: _ ->
+      Loc.fail other.loc "expected :field, found %s" (Form.to_string other)
+    | [ odd ] -> Loc.fail odd.loc "field %s has no value" (Form.to_string odd)
+  in
+  ignore f; go items
+
+and cond f (args : Form.t list) : Ast.expr =
+  let rec go = function
+    | [] -> { Ast.e = Ast.Do []; loc = f.loc }   (* no clause matched: Unit *)
+    | { v = Kw "else"; _ } :: body :: _ -> expr body
+    | test :: body :: rest ->
+      { Ast.e = Ast.If (expr test, expr body, Some (go rest)); loc = f.loc }
+    | [ odd ] -> Loc.fail odd.loc "cond clause %s has no body"
+                   (Form.to_string odd)
+  in
+  if args = [] then Loc.fail f.loc "cond needs at least one clause" else go args
+
+and shortcircuit f (args : Form.t list) ~is_and : Ast.expr =
+  let mk e = { Ast.e; loc = f.loc } in
+  let rec go = function
+    | [] -> mk (Ast.Var (if is_and then "true" else "false"))
+    | [ last ] -> expr last
+    | x :: rest ->
+      if is_and then mk (Ast.If (expr x, go rest, Some (mk (Ast.Var "false"))))
+      else mk (Ast.If (expr x, mk (Ast.Var "true"), Some (go rest)))
+  in
+  go args
+
+and place (f : Form.t) : Ast.place =
+  match f.v with
+  | Sym s -> Ast.Pvar s
+  | List ({ v = Sym s; _ } :: args)
+    when String.length s > 1 && s.[0] = '.' ->
+    let field = String.sub s 1 (String.length s - 1) in
+    (match args with
+     | [ target ] -> Ast.Pfield (expr target, field)
+     | _ -> fail f "field place is (.%s value)" field)
+  | List ({ v = Sym "at"; _ } :: target :: idx) when idx <> [] ->
+    Ast.Pindex (expr target, List.map expr idx)
+  | List [ { v = Sym "get"; _ }; m; k ] -> Ast.Pkey (expr m, expr k)
+  | List [ { v = Sym "deref"; _ }; p ] -> Ast.Pderef (expr p)
+  | _ ->
+    fail f
+      "%s is not assignable. set takes a name, (.field x), (at a i ...), \
+       (get m k) or (deref p)"
+      (Form.to_string f)
+
+and arms f (items : Form.t list) : Ast.arm list =
+  let rec go = function
+    | [] -> []
+    | p :: body :: rest ->
+      { Ast.pat = pattern p; body = [ expr body ]; aloc = p.loc } :: go rest
+    | [ odd ] ->
+      Loc.fail odd.loc "match arm %s has no body" (Form.to_string odd)
+  in
+  if items = [] then Loc.fail f.loc "match needs at least one arm" else go items
+
+and pattern (f : Form.t) : Ast.pattern =
+  match f.v with
+  | Sym "_" -> Ast.Pwild
+  | Kw "else" -> Ast.Pwild
+  | Sym ctor -> Ast.Pctor (ctor, [])
+  | List ({ v = Sym ctor; _ } :: binds) ->
+    Ast.Pctor (ctor, List.map sym binds)
+  | _ -> fail f "expected a pattern, found %s" (Form.to_string f)
+
+(* ── Declarations ──────────────────────────────────────────────────── *)
+
+let rec decl types (f : Form.t) : Ast.decl =
+  let mk d = { Ast.d; dloc = f.loc } in
+  match f.v with
+  | List ({ v = Sym "package"; _ } :: args) ->
+    (match args with
+     | [ n ] -> mk (Ast.Package (sym n))
+     | _ -> fail f "package is (package name)")
+
+  | List ({ v = Sym "import"; _ } :: args) ->
+    (match args with
+     | [ alias; { v = Str path; _ } ] -> mk (Ast.Import (sym alias, path))
+     | _ -> fail f "import is (import alias \"collection:path\")")
+
+  | List ({ v = Sym "defalias"; _ } :: args) ->
+    (match args with
+     | [ n; t ] -> mk (Ast.Defalias (sym n, texpr t))
+     | _ -> fail f "defalias is (defalias Name Type)")
+
+  | List ({ v = Sym "defstruct"; _ } :: args) ->
+    (match args with
+     | [ n; { v = Vec fs; _ } ] -> mk (Ast.Defstruct (sym n, fields f fs))
+     | _ -> fail f "defstruct is (defstruct Name [field Type ...])")
+
+  | List ({ v = Sym "defunion"; _ } :: args) ->
+    (match args with
+     | [ n; { v = Vec vs; _ } ] -> mk (Ast.Defunion (sym n, List.map variant vs))
+     | _ -> fail f "defunion is (defunion Name [(Case [field Type ...]) ...])")
+
+  | List ({ v = Sym "defn"; _ } :: args) ->
+    (match args with
+     | n :: { v = Vec ps; _ } :: rest ->
+       let ret, body =
+         match rest with
+         (* An omitted return type means Unit. A leading form that is a type
+            and is not the whole body is the return type. *)
+         | [] -> None, []
+         | first :: more when more <> [] && is_type_form types first ->
+           Some (texpr first), body_of more
+         | _ -> None, body_of rest
+       in
+       mk (Ast.Defn { Ast.name = sym n; params = fields f ps; ret;
+                      fbody = body; nloc = n.loc })
+     | _ -> fail f "defn is (defn name [param Type ...] ReturnType? body ...)")
+
+  | List ({ v = Sym "defvar"; _ } :: args) ->
+    (match args with
+     | [ n; t ] -> mk (Ast.Defvar (sym n, Some (texpr t), Ast.Zeroed))
+     | [ n; t; { v = Sym "uninit"; _ } ] ->
+       mk (Ast.Defvar (sym n, Some (texpr t), Ast.Uninit))
+     | [ n; t; v ] -> mk (Ast.Defvar (sym n, Some (texpr t), Ast.Init (expr v)))
+     | _ -> fail f "defvar is (defvar name Type value?)")
+
+  | List ({ v = Sym "defconst"; _ } :: args) ->
+    (match args with
+     | [ n; v ] -> mk (Ast.Defconst (sym n, None, expr v))
+     | [ n; t; v ] -> mk (Ast.Defconst (sym n, Some (texpr t), expr v))
+     | _ -> fail f "defconst is (defconst name Type? value)")
+
+  | List ({ v = Sym s; _ } :: _) -> fail f "unknown top-level form (%s ...)" s
+  | _ -> fail f "expected a top-level declaration, found %s" (Form.to_string f)
+
+(* Is this form the function's return type, or the first form of its body?
+
+   Shape alone cannot tell: [(Option f64)] and [(Some 1)] are identical
+   s-expressions, one a type application and one a constructor call. Capitalised
+   heads are not a good enough signal — [(defn f [] (Some 1) (bar))] would eat
+   the body's first form as a return type, silently.
+
+   So the decision uses the set of names that are actually types, which the
+   pre-pass in [program] collects from the file's own declarations. That makes
+   it exact rather than heuristic, because types are only ever introduced by
+   defstruct, defunion and defalias — all syntactically obvious. *)
+and is_type_form types (f : Form.t) =
+  match f.v with
+  | Sym s -> Names.mem s types
+  | Vec _ -> true                            (* [T] and [n T] are only types *)
+  | Map _ -> true                            (* {K V} in this position       *)
+  | List ({ v = Sym n; _ } :: _) -> Names.mem n types
+  | _ -> false
+
+and variant (f : Form.t) : Ast.variant =
+  match f.v with
+  | Sym n -> { Ast.vname = n; vfields = []; vloc = f.loc }
+  | List [ { v = Sym n; _ }; { v = Vec fs; _ } ] ->
+    { Ast.vname = n; vfields = fields f fs; vloc = f.loc }
+  | List [ { v = Sym n; _ } ] -> { Ast.vname = n; vfields = []; vloc = f.loc }
+  | _ -> fail f "a union case is Name or (Name [field Type ...])"
+
+(* Names introduced as types by this file, plus the builtins. Collected before
+   anything is parsed, so a type declared at the bottom of a file is still known
+   to a function at the top — top-level names are order-independent. *)
+let declared_types (forms : Form.t list) : Names.t =
+  List.fold_left
+    (fun acc (f : Form.t) ->
+       match f.v with
+       | List [ { v = Sym ("defstruct" | "defunion" | "defalias"); _ };
+                { v = Sym n; _ }; _ ] -> Names.add n acc
+       | _ -> acc)
+    builtin_types forms
+
+let program (forms : Form.t list) : Ast.decl list =
+  let types = declared_types forms in
+  List.map (decl types) forms
+
+(* Single-declaration entry point, for tests and the REPL. Sees only the
+   builtin types plus whatever this one form declares. *)
+let decl (f : Form.t) : Ast.decl = decl (declared_types [ f ]) f

test/dune

@@ -1,3 +1,8 @@
 (test
  (name test_flan)
- (libraries flan))
+ (libraries flan)
+ ; The acceptance programs are part of the test corpus: if the reader or the
+ ; parser regresses on them we want to know here, not at the CLI.
+ (deps
+  (file %{workspace_root}/calc-me.flan)
+  (file %{workspace_root}/sand.flan)))

test/test_flan.ml

@@ -119,3 +119,200 @@ let () =
     Printf.printf "\n%d failure(s)\n" !failures;
     exit 1
   end
+
+(* ═══ Parse: forms → AST ═══════════════════════════════════════════ *)
+
+let parse1 src =
+  match Reader.read_all ~file:"<test>" src with
+  | [ f ] -> Parse.expr f
+  | _ -> failwith "test source must be exactly one form"
+
+let parse_decl src =
+  match Reader.read_all ~file:"<test>" src with
+  | [ f ] -> Parse.decl f
+  | _ -> failwith "test source must be exactly one form"
+
+let parse_rejects name src =
+  match Reader.read_all ~file:"<test>" src |> Parse.program with
+  | _ -> incr failures; Printf.printf "FAIL  %s: expected a parse error\n" name
+  | exception Loc.Error _ -> ()
+
+let () =
+  let open Ast in
+
+  (* ── Sugar is desugared, not preserved ─────────────────────────── *)
+  (match (parse1 "(when c a b)").e with
+   | If (_, { e = Do [ _; _ ]; _ }, None) -> ()
+   | _ -> check "when -> if+do" false);
+
+  (match (parse1 "(unless c a)").e with
+   | If ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, _, None) -> ()
+   | _ -> check "unless -> if(not)" false);
+
+  (match (parse1 "(until c a)").e with
+   | While ({ e = Call ({ e = Var "not"; _ }, [ _ ]); _ }, [ _ ]) -> ()
+   | _ -> check "until -> while(not)" false);
+
+  (match (parse1 "(cond a 1 b 2 :else 3)").e with
+   | If (_, _, Some { e = If (_, _, Some { e = Int 3L; _ }); _ }) -> ()
+   | _ -> check "cond -> nested if with :else last" false);
+
+  (* and/or short-circuit, so they must not become calls *)
+  (match (parse1 "(and a b)").e with
+   | If (_, _, Some { e = Var "false"; _ }) -> ()
+   | _ -> check "and short-circuits" false);
+  (match (parse1 "(or a b)").e with
+   | If (_, { e = Var "true"; _ }, Some _) -> ()
+   | _ -> check "or short-circuits" false);
+
+  (* ── Forms that bind or alter control are never calls ──────────── *)
+  (* This is the class that silently misparses: it reads fine as a call and
+     means something entirely different. *)
+  (match (parse1 "(dotimes [i 10] (f i))").e with
+   | Dotimes ("i", { e = Int 10L; _ }, [ _ ]) -> ()
+   | _ -> check "dotimes binds" false);
+  (match (parse1 "(fn [x y] x)").e with
+   | Fn ([ "x"; "y" ], [ _ ]) -> ()
+   | _ -> check "fn binds" false);
+  (match (parse1 "(defer (close f))").e with
+   | Defer [ _ ] -> ()
+   | _ -> check "defer is not a call" false);
+  (match (parse1 "(some (find x))").e with
+   | Unwrap (Usome, _) -> ()
+   | _ -> check "some is not a call" false);
+  (match (parse1 "(try (read x))").e with
+   | Unwrap (Utry, _) -> ()
+   | _ -> check "try is not a call" false);
+
+  (* ── Places: the fixed assignable list, not setf ───────────────── *)
+  (match (parse1 "(set x 1)").e with
+   | Set (Pvar "x", _) -> () | _ -> check "set local" false);
+  (match (parse1 "(set (.hp e) 1)").e with
+   | Set (Pfield (_, "hp"), _) -> () | _ -> check "set field" false);
+  (match (parse1 "(set (at g r c) 1)").e with
+   | Set (Pindex (_, [ _; _ ]), _) -> () | _ -> check "set index" false);
+  (match (parse1 "(set (deref p) 1)").e with
+   | Set (Pderef _, _) -> () | _ -> check "set deref" false);
+  parse_rejects "set on a call" "(set (foo x) 1)";
+
+  (* ── Field access and struct literals ──────────────────────────── *)
+  (match (parse1 "(.pos c)").e with
+   | Field ({ e = Var "c"; _ }, "pos") -> ()
+   | _ -> check "field access" false);
+  (match (parse1 "(Cursor {:src s :pos 0})").e with
+   | Struct ("Cursor", [ ("src", _); ("pos", _) ]) -> ()
+   | _ -> check "struct literal" false);
+  (match (parse1 "[1 2 3]").e with
+   | Arr [ _; _; _ ] -> () | _ -> check "array literal" false);
+
+  (* ── Types: brackets mean different things by position ─────────── *)
+  let ty src =
+    match parse_decl (Printf.sprintf "(defn f [x %s])" src) with
+    | { d = Defn { params = [ { fty; _ } ]; _ }; _ } -> fty.t
+    | _ -> failwith "bad type test"
+  in
+  (match ty "[u8]" with Tslice _ -> () | _ -> check "[T] is a slice" false);
+  (match ty "[4 f32]" with
+   | Tarray (Lint 4L, _) -> () | _ -> check "[n T] is an array" false);
+  (match ty "[rows [cols u32]]" with
+   | Tarray (Lname "rows", { t = Tarray (Lname "cols", _); _ }) -> ()
+   | _ -> check "nested array with named lengths" false);
+  (match ty "(Ptr Cursor)" with
+   | Tapp ("Ptr", [ _ ]) -> () | _ -> check "(Ptr T)" false);
+  (match ty "{string i32}" with
+   | Tmap (_, _) -> () | _ -> check "{K V} is a map type" false);
+  (match ty "(Fn [a a] bool)" with
+   | Tfn ([ _; _ ], _) -> () | _ -> check "(Fn [T] R)" false);
+
+  (* ── Declarations ──────────────────────────────────────────────── *)
+  (match (parse_decl "(defn f [x i32] bool x)").d with
+   | Defn { ret = Some _; params = [ _ ]; fbody = [ _ ]; _ } -> ()
+   | _ -> check "defn with return type" false);
+  (* An omitted return type means Unit — the body must not be eaten as a type *)
+  (match (parse_decl "(defn f [x i32] (g x))").d with
+   | Defn { ret = None; fbody = [ _ ]; _ } -> ()
+   | _ -> check "defn without return type" false);
+  (match (parse_decl "(defvar grid [4 u32])").d with
+   | Defvar ("grid", Some _, Zeroed) -> ()
+   | _ -> check "defvar is ZII" false);
+  (match (parse_decl "(defvar buf [4 u8] uninit)").d with
+   | Defvar (_, _, Uninit) -> () | _ -> check "defvar uninit opts out" false);
+  (match (parse_decl "(import rl \"vendor:raylib\")").d with
+   | Import ("rl", "vendor:raylib") -> () | _ -> check "import" false);
+
+  (* ── Unimplemented forms are rejected, not silently called ─────── *)
+  parse_rejects "handler-bind" "(handler-bind [E h] body)";
+  parse_rejects "restart-case" "(restart-case body (r [] 1))";
+  parse_rejects "loop/recur"   "(loop [x 1] (recur x))";
+  parse_rejects "defmacro"     "(defmacro m [] 1)";
+
+  (* ── Malformed syntax is caught with a location ────────────────── *)
+  parse_rejects "odd let bindings"  "(let [a])";
+  parse_rejects "odd field pairs"   "(defstruct S [a])";
+  parse_rejects "cond without body" "(cond a)";
+  parse_rejects "unknown top form"  "(nope x)";
+
+  (* ── The corpus parses ─────────────────────────────────────────── *)
+  List.iter
+    (fun path ->
+       match Reader.read_file path |> Parse.program with
+       | _ -> ()
+       | exception Loc.Error (loc, msg) ->
+         incr failures;
+         Printf.printf "FAIL  %s does not parse: %s: %s\n"
+           path (Loc.to_string loc) msg)
+    (* dune runs tests in _build/default/test/; the corpus is declared as a
+       dep in test/dune and lands at the build root. *)
+    [ "../calc-me.flan"; "../sand.flan" ];
+
+  if !failures = 0 then print_endline "parse: all tests passed"
+  else begin
+    Printf.printf "\n%d failure(s)\n" !failures;
+    exit 1
+  end
+
+(* ═══ The return type / body ambiguity ═════════════════════════════ *)
+(* (Option f64) and (Some 1) are the same s-expression shape. Which one is a
+   return type is decided by the set of names that are actually types, not by
+   capitalisation — otherwise a body starting with a constructor call gets
+   silently eaten as a return type. *)
+
+let program src = Reader.read_all ~file:"<test>" src |> Parse.program
+
+let () =
+  let open Ast in
+  (* Pick the defn out; some sources also declare a struct. *)
+  let ret_and_body name src =
+    match
+      List.find_map
+        (fun (d : decl) ->
+           match d.d with Defn fn -> Some fn | _ -> None)
+        (program src)
+    with
+    | Some { ret; fbody; _ } -> (ret <> None, List.length fbody)
+    | None -> check (name ^ ": has a defn") false; (false, 0)
+  in
+
+  check "known type ctor is a return type"
+    (ret_and_body "option" "(defn f [] (Option f64) (g))" = (true, 1));
+
+  check "value ctor is NOT a return type"
+    (ret_and_body "some" "(defn f [] (Some 1) (bar))" = (false, 2));
+
+  check "user struct is a return type"
+    (ret_and_body "user"
+       "(defstruct Cursor [pos i32]) (defn f [] Cursor (g))" = (true, 1));
+
+  (* Order-independent: the type is declared after the function that returns it *)
+  check "type declared later is still known"
+    (ret_and_body "later"
+       "(defn f [] Cursor (g)) (defstruct Cursor [pos i32])" = (true, 1));
+
+  check "unknown capitalised head is a body form"
+    (ret_and_body "unknown" "(defn f [] (Nope 1) (bar))" = (false, 2));
+
+  if !failures = 0 then print_endline "ambiguity: all tests passed"
+  else begin
+    Printf.printf "\n%d failure(s)\n" !failures;
+    exit 1
+  end