(** The indented reader: [.fln] text to exactly the [Form.t] tree the paren
    reader ([Reader]) makes. Nothing after the reader knows which syntax a form
    came from. spec-syntax.md is the grammar; this comment is only the shape.

    Three passes. [lex] turns text into tokens, reusing [Reader]'s own string,
    character, number and quoted-datum readers so the atoms mean exactly what
    they mean in a [.flan] file. [layout] adds NEWLINE, INDENT and DEDENT at
    bracket depth zero from an indent stack of columns. The parser is a
    statement parser (soft keywords at the start of a line) over a precedence
    climber for expressions.

    Locations are spans, as [Reader] makes them: a form starts at its first
    token and ends where its last one does. A form this reader invents — the
    [dyn] of an untyped parameter, the [do] around a block, the [set] of an
    assignment — takes the location of the text that asked for it. *)

type tok =
  | NAME of string        (* a name run, after field splitting *)
  | KW of string
  | ATOM of Form.value    (* number, string, character *)
  | DATUM of Form.t       (* 'x and '(a b), read by the paren reader *)
  | LP | RP | LB | RB | LC | RC
  | COMMA
  | COLON                 (* x: T, and the trailing : of a call's block *)
  | UNQ | SPLICE          (* ~ and ~@ *)
  | BNOT                  (* ~~, bit-not; a nested unquote is ~(~x) *)
  | NEG                   (* the - glued to the front of a name *)
  | QUEST                 (* T? and a?.b: a ? glued after a name or a closer *)
  | BANG                  (* x!: a ! glued after a value *)
  | NEWLINE | INDENT | DEDENT | EOF

type token = { tok : tok; loc : Loc.t; sp : bool (* whitespace before it *) }

let failk ?notes kind loc fmt = Loc.failk ?notes ("indent/" ^ kind) loc fmt

let show = function
  | NAME s -> s
  | KW s -> ":" ^ s
  | ATOM v -> Form.to_source (Form.make v Loc.unknown)
  | DATUM f -> Form.to_source f
  | LP -> "(" | RP -> ")" | LB -> "[" | RB -> "]" | LC -> "{" | RC -> "}"
  | COMMA -> "," | COLON -> ":" | UNQ -> "~" | SPLICE -> "~@" | BNOT -> "~~" | NEG -> "-"
  | QUEST -> "?" | BANG -> "!"
  | NEWLINE -> "the end of the line"
  | INDENT -> "an indented line"
  | DEDENT -> "the end of the block"
  | EOF -> "the end of the file"

(* ── Names ─────────────────────────────────────────────────────────── *)

(* Binary operators and their levels, low to high (spec §2 "Precedence").
   [not] sits at 3 and the prefix [-] and [~~] at 11; neither is binary. The
   bit operators sit between the comparisons and the shifts, Python's and
   Rust's order, so [x && mask == 0] is [(x && mask) == 0]. *)
let binops =
  [ ("or", 1); ("and", 2);
    ("==", 4); ("!=", 4); ("<", 4); ("<=", 4); (">", 4); (">=", 4);
    ("||", 5); ("^^", 6); ("&&", 7);
    ("<<", 8); (">>", 8); ("+", 9); ("-", 9); ("*", 10); ("/", 10); ("%", 10);
    (* [??] is here for the line rules — a line ending in it, or one starting
       with it, continues — and is read by [operand] between 4 and 5, so no
       level of [binary]'s is its own. *)
    ("??", 0) ]

let binop_level s = List.assoc_opt s binops
let is_binop s = binop_level s <> None

(* [==] is Flan's [=], and the bit operators are the words the Lisp side
   writes; every other operator is its own name. *)
let op_sym = function
  | "==" -> "=" | "&&" -> "bit-and" | "||" -> "bit-or" | "^^" -> "bit-xor"
  | s -> s

(* Words that are operators rather than names wherever a value is read. Alone
   before a comma or a closer they are the symbol itself, [reduce(+, 0, xs)];
   glued to a parenthesis they are a call, [+(a, b, c)]. *)
let is_op_word s = is_binop s || s = "not" || s = "="

let assign_ops = [ ("+=", "+"); ("-=", "-"); ("*=", "*"); ("/=", "/") ]

(* A place whose parts are all names and literals reads the same however
   often it is evaluated, so [x += v] over one is [(set x (+ x v))], the form
   the Lisp side writes. Any other place — an index that is a call — reads
   [(update p + v)], which evaluates each part of the place once. The printer
   asks the same question, so the round trip is exact either way. *)
let rec simple_place (f : Form.t) =
  let atom (x : Form.t) =
    match x.v with
    | Form.Sym _ | Form.Int _ | Form.Kw _ | Form.Byte _ -> true
    | _ -> false
  in
  match f.v with
  | Form.Sym _ -> true
  | Form.List [ { v = Form.Sym h; _ }; t ]
    when (String.length h > 1 && h.[0] = '.') || h = "deref" ->
    simple_place t
  | Form.List ({ v = Form.Sym "at"; _ } :: t :: (_ :: _ as idx)) ->
    simple_place t && List.for_all atom idx
  | _ -> false

let compound (at : Loc.t) op (e : Form.t) (v : Form.t) span =
  if simple_place e then
    Form.List
      [ Form.make (Form.Sym "set") at; e;
        Form.make (Form.List [ Form.make (Form.Sym op) at; e; v ]) span ]
  else
    Form.List
      [ Form.make (Form.Sym "update") at; e; Form.make (Form.Sym op) at; v ]

(* A comparison chain that mixes [<] with [<=], or [>] with [>=], is the
   [and] of its neighbouring pairs: [0 <= r < rows] is
   [(and (<= 0 r) (< r rows))]. It is evaluated as [(< a b c)] is: every
   operand once, left to right, before any test, with no short-circuit. When
   an operand is more than a name or a literal, every operand but a literal
   is bound first, in order, to a fresh [~cmp] name, which no reader can
   produce: a name too, since a call to its right may change it. The printer
   rebuilds a candidate with this same function and prints the chain only
   when the two agree. *)
let cmp_dir = function
  | "<" | "<=" -> Some `Up
  | ">" | ">=" -> Some `Down
  | _ -> None

let cmp_chain ~fresh (l : Loc.t) (xs : Form.t list) (ops : string list) =
  let mkf v = Form.make v l in
  let s x = mkf (Form.Sym x) in
  let literal (x : Form.t) =
    match x.v with
    | Form.Int _ | Form.UInt _ | Form.Float _ | Form.Str _ | Form.Byte _
    | Form.Kw _ | Form.Sym ("true" | "false" | "nil") -> true
    | _ -> false
  in
  let simple (x : Form.t) = literal x || (match x.v with Form.Sym _ -> true | _ -> false) in
  let keep = if List.for_all simple xs then simple else literal in
  let bound =
    List.map (fun x -> if keep x then (None, x) else
                 let t = s (fresh ()) in (Some (t, x), t)) xs
  in
  let refs = List.map snd bound in
  let rec tests = function
    | a :: (b :: _ as rest), op :: ops -> mkf (Form.List [ s op; a; b ]) :: tests (rest, ops)
    | _ -> []
  in
  let body = mkf (Form.List (s "and" :: tests (refs, ops))) in
  match List.concat_map (function (Some (t, x), _) -> [ t; x ] | _ -> []) bound with
  | [] -> body
  | bs -> mkf (Form.List [ s "let"; mkf (Form.Vec bs); body ])

(* The reader's fresh names for [cmp_chain], counted per [read_all]. *)
let cmp_n = ref 0
let cmp_fresh () = incr cmp_n; Printf.sprintf "~cmp%d" !cmp_n

(* The reader's fresh names for an optional chain's payload, per [read_all]. *)
let opt_n = ref 0

(* Whether a type is being read, set for [ty]'s extent: there a [?] after
   any name is [Option], [grain?] included. *)
let in_type = ref false

(* A [-] glued to one of these starts a negation: [-x] is [(- x)]. Anything
   else keeps the Lisp reading, so [--], [->] and [-=] stay names. *)
let is_neg_char c =
  (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '$' || c = '_'
  || c = '*'

(* The segment a dot splits after, checked for a capital: [Shape.Rect] and
   [tree/Node.Branch] are one qualified name, [camera.target.x] is two field
   accesses. The part after a package's [/] is what is checked. *)
let capitalised seg =
  let base =
    match String.rindex_opt seg '/' with
    | Some i -> String.sub seg (i + 1) (String.length seg - i - 1)
    | None -> seg
  in
  base <> "" && base.[0] >= 'A' && base.[0] <= 'Z'

let split_fields text =
  if text = "" || text.[0] = '.' then [ text ]
  else
    let segs = String.split_on_char '.' text in
    if List.length segs < 2 || List.mem "" segs || capitalised (List.hd segs)
    then [ text ]
    else segs

(* ── Names without ? or ! ──────────────────────────────────────────── *)

(* What a [?] may follow to mean [Option]: a type's name. A capital after
   any [pkg/], a type variable, or a primitive. *)
let type_like s =
  let base =
    match String.rindex_opt s '/' with
    | Some i -> String.sub s (i + 1) (String.length s - i - 1)
    | None -> s
  in
  base <> ""
  && ((base.[0] >= 'A' && base.[0] <= 'Z') || base.[0] = '$'
      || List.mem base ("char" :: Types.primitive_names))

(* The name a question is spelled with: [is-] in front, unless it already
   starts with a verb. The table holds the prelude's and raylib's names that
   do not follow that rule, so the fix for one of them is the real name. *)
let question_fix name =
  let pkg, base =
    match String.rindex_opt name '/' with
    | Some i -> (String.sub name 0 (i + 1), String.sub name (i + 1) (String.length name - i - 1))
    | None -> ("", name)
  in
  let starts p = String.starts_with ~prefix:p base in
  let fixed =
    match base with
    | "starts-with" -> "has-prefix"
    | "ends-with" -> "has-suffix"
    | "file-exists" | "window-should-close" -> base
    | "bytes<" -> "is-bytes-less"
    | "into-maps" -> "has-map-step"
    | "form-sym" -> "is-form-named"
    | "form-is-sym" -> "is-form-sym"
    | _ when starts "is-" || starts "has-" || starts "can-" -> base
    | _ when starts "collision-" -> "check-" ^ base
    | _ when String.ends_with ~suffix:"=" base ->
      "is-" ^ String.sub base 0 (String.length base - 1) ^ "-equal"
    | _ -> "is-" ^ base
  in
  pkg ^ fixed

let name_refused ?(typed = false) loc whole =
  let drop c s = String.concat "" (String.split_on_char c s) in
  let n = String.length whole in
  if n > 1 && whole.[n - 1] = '?' && not (String.contains (String.sub whole 0 (n - 1)) '?')
     && not (String.contains whole '!') then
    let base = String.sub whole 0 (n - 1) in
    Loc.failk "indent/question-name" loc
      "%s is not a name: a name cannot contain ?.\n\n\
       A name for a yes-or-no question starts with is- or has- instead: %s%s"
      whole (question_fix base)
      (if typed then
         Printf.sprintf "\n\nIf %s is a type, %s is Option(%s), written where a \
                         type goes, after : or ->" base whole base
       else "")
  else
    let c = if String.contains whole '!' then '!' else '?' in
    Loc.failk "indent/mark-in-name" loc
      "%s is not a name: a name cannot contain %c.\n\nLeave it out: %s"
      whole c (drop '!' (drop '?' whole))

(* ── Lexing ────────────────────────────────────────────────────────── *)

let lex ?(line = 1) ?(col = 1) ~file src : token list =
  let st = Reader.of_string ~file src in
  (* Text taken from the middle of a buffer starts where it was written, so
     every location read from it is the buffer's own. *)
  st.Reader.line <- line;
  st.Reader.col <- col;
  let out = ref [] in
  let sp = ref true in
  let line_start = ref true in
  let tab = ref None in
  let emit tok loc = out := { tok; loc; sp = !sp } :: !out; sp := false in
  let piece line col len =
    { (Loc.make file line col) with Loc.eline = line; ecol = col + len }
  in
  let name_run () =
    let l0 = Reader.here st in
    let text = Reader.take_while st (fun c -> not (Reader.is_delimiter c)) in
    let n = String.length text in
    let line = l0.Loc.line and col = l0.Loc.col in
    if n = 0 then
      failk "unexpected-character" l0 "unexpected character %C" (Reader.peek st);
    if text = ":" then emit COLON (piece line col 1)
    else if text.[0] = ':' then emit (KW (String.sub text 1 (n - 1))) (piece line col n)
    else begin
      let body, colon =
        if text.[n - 1] = ':' then (String.sub text 0 (n - 1), true)
        else (text, false)
      in
      let plain col body =
        let bn = String.length body in
        let bcol, body =
          if bn > 1 && body.[0] = '-' && is_neg_char body.[1] then begin
            emit NEG (piece line col 1);
            (col + 1, String.sub body 1 (bn - 1))
          end
          else (col, body)
        in
        let off = ref 0 in
        List.iteri
          (fun i seg ->
             let s = if i = 0 then seg else "." ^ seg in
             emit (NAME s) (piece line (bcol + !off) (String.length s));
             off := !off + String.length s)
          (split_fields body)
      in
      (* [.b.c] after a [?] or a [!]: one field access per segment. *)
      let fields col s =
        let segs = String.split_on_char '.' (String.sub s 1 (String.length s - 1)) in
        if List.mem "" segs then emit (NAME s) (piece line col (String.length s))
        else
          List.fold_left
            (fun c seg ->
               emit (NAME ("." ^ seg)) (piece line c (String.length seg + 1));
               c + String.length seg + 1)
            col segs
          |> ignore
      in
      (* Before the first mark a leading dot is the name's own, [.field] as
         an accessor; after one it starts a field access. *)
      let some_part ~after col s =
        if s = "" then () else if after && s.[0] = '.' then fields col s else plain col s
      in
      (* The name a [?] or a [!] at [i] of [s] belongs to: back to the dot
         or the start before it, on to the dot or the end after it. *)
      let word s i =
        let a = match String.rindex_from_opt s i '.' with Some d -> d + 1 | None -> 0 in
        let b = match String.index_from_opt s i '.' with Some d -> d | None -> String.length s in
        (a, String.sub s a (b - a))
      in
      let next = if Reader.at_end st then ' ' else Reader.peek st in
      (* A [?] ends a type's name, [T?], or starts a chain, [a?.b] and
         [a?[i]]; a [!] unwraps, [x!]. Anywhere else each is inside a name,
         which is refused (spec-syntax.md, "Names"). *)
      let rec marks ?(after = false) col s =
        match String.index_opt s '?', String.index_opt s '!' with
        | None, None -> some_part ~after col s
        | q, b ->
          let i = match q, b with
            | Some q, Some b -> min q b | Some q, None -> q | None, Some b -> b
            | None, None -> assert false
          in
          let pre = String.sub s 0 i and ch = s.[i] in
          let rest = String.sub s (i + 1) (String.length s - i - 1) in
          let at = col + i in
          let wa, whole = word s i in
          let last = match String.rindex_opt pre '.' with
            | Some d -> String.sub pre (d + 1) (String.length pre - d - 1)
            | None -> pre
          in
          (* The word after this run, for an operator written without its
             spaces: [x!= y] is [x != y]. *)
          let after_word r =
            if r <> "" then r
            else
              let j = ref st.Reader.pos in
              while !j < String.length src && src.[!j] = ' ' do incr j done;
              let k = ref !j in
              while !k < String.length src && not (Reader.is_delimiter src.[!k]) do incr k done;
              if !k > !j then String.sub src !j (!k - !j) else "b"
          in
          let tail r = String.sub r 1 (String.length r - 1) in
          if ch = '?' then begin
            if rest = "?" && pre <> "" && type_like last && next <> '(' then
              failk "nested-option" (piece line (col + wa) (String.length whole))
                "%s is not read: ?? is the default operator. An Option of an \
                 Option is written Option(%s?)" whole last;
            if rest <> "" && rest.[0] = '?' && pre <> "" then
              failk "unspaced-operator" (piece line at 2)
                "?? is an operator here, and a binary operator has a space on \
                 each side: %s ?? %s" pre (after_word (tail rest));
            (* A [?] at the end of a name is a type's, [T?], or one the
               parser refuses as part of a name; which, only the parser
               knows. Before [(] or inside a name it is a name's. *)
            let ends = rest = "" && next <> '(' in
            let chain = (rest <> "" && rest.[0] = '.') || (rest = "" && next = '[') in
            if ends || chain then begin
              some_part ~after col pre;
              emit QUEST (piece line at 1);
              marks ~after:true (at + 1) rest
            end
            else name_refused (piece line (col + wa) (String.length whole)) whole
          end
          else begin
            if rest <> "" && rest.[0] = '=' then
              failk "unspaced-operator" (piece line at 2)
                "!= is an operator here, and a binary operator has a space on \
                 each side: %s != %s" pre (after_word (tail rest));
            if rest <> "" && rest.[0] = '!' then
              failk "double-unwrap" (piece line at 2)
                "!! is not read. To unwrap an Option of an Option, unwrap \
                 each level: (%s!)!" (if pre = "" then "x" else pre);
            if (rest = "" && next <> '(') || (rest <> "" && rest.[0] = '.') then begin
              some_part ~after col pre;
              emit BANG (piece line at 1);
              marks ~after:true (at + 1) rest
            end
            else name_refused (piece line (col + wa) (String.length whole)) whole
          end
      in
      let wordy = String.exists (fun c -> Reader.is_digit c || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) body in
      if wordy || body = "?" || body = "!" || body = "!!" then marks col body else plain col body;
      if colon then emit COLON (piece line (col + n - 1) 1)
    end
  in
  let token c =
    let l0 = Reader.here st in
    let simple t = Reader.advance st; emit t (Loc.upto l0 (Reader.here st)) in
    match c with
    | '(' -> simple LP | ')' -> simple RP
    | '[' -> simple LB | ']' -> simple RB
    | '{' -> simple LC | '}' -> simple RC
    | ',' -> simple COMMA
    | '"' -> let f = Reader.read_string st in emit (ATOM f.v) f.loc
    | '\\' -> let f = Reader.read_byte st in emit (ATOM f.v) f.loc
    (* The paren reader reads the quoted datum whole, so ['(a (b c))] is the
       Lisp list it always was and nothing here re-invents it. *)
    | '\'' -> let f = Reader.read_form st in emit (DATUM f) f.loc
    | '`' ->
      failk "backquote" l0
        "` is not read in a .fln file. A quasiquote is quote followed by an \
         indented block, or quasiquote(x) on one line"
    | '~' ->
      Reader.advance st;
      if Reader.peek st = '~' then begin
        Reader.advance st;
        emit BNOT (Loc.upto l0 (Reader.here st))
      end
      else if Reader.peek st = '@' then begin
        Reader.advance st;
        emit SPLICE (Loc.upto l0 (Reader.here st))
      end
      else emit UNQ (Loc.upto l0 (Reader.here st))
    | c when Reader.is_digit c
          || ((c = '-' || c = '+') && Reader.is_digit (Reader.peek2 st)) ->
      (* [while x < 3:] — the colon is a mistake the parser explains, and not
         part of the number, so the number is read without it. *)
      let rec run i =
        if i < String.length src && not (Reader.is_delimiter src.[i]) then run (i + 1)
        else i
      in
      let stop = run st.Reader.pos in
      if stop - st.Reader.pos > 1 && src.[stop - 1] = ':' then begin
        let text = String.sub src st.Reader.pos (stop - st.Reader.pos - 1) in
        let f = Reader.read_number (Reader.of_string ~file text) in
        let n = String.length text in
        for _ = 1 to n do Reader.advance st done;
        emit (ATOM f.v) (piece l0.Loc.line l0.Loc.col n);
        Reader.advance st;
        emit COLON (piece l0.Loc.line (l0.Loc.col + n) 1)
      end
      else begin
        (* [0..10]: a range from another language. *)
        let text = String.sub src st.Reader.pos (stop - st.Reader.pos) in
        (match String.index_opt text '.' with
         | Some i when i + 1 < String.length text && text.[i + 1] = '.' ->
           failk "dot-range" (piece l0.Loc.line l0.Loc.col (String.length text))
             "%s is not a number. A range of numbers is written range(%s, %s), \
              as in for i in range(%s, %s)"
             text (String.sub text 0 i)
             (String.sub text (i + 2) (String.length text - i - 2))
             (String.sub text 0 i)
             (String.sub text (i + 2) (String.length text - i - 2))
         | _ -> ());
        let f = Reader.read_number st in
        emit (ATOM f.v) f.loc
      end
    | _ -> name_run ()
  in
  let rec go () =
    if not (Reader.at_end st) then
      match Reader.peek st with
      | ' ' | '\r' -> Reader.advance st; sp := true; go ()
      | '\t' ->
        if !line_start && !tab = None then tab := Some (Reader.here st);
        Reader.advance st; sp := true; go ()
      | '\n' ->
        Reader.advance st; sp := true; line_start := true; tab := None; go ()
      | ';' ->
        while (not (Reader.at_end st)) && Reader.peek st <> '\n' do
          Reader.advance st
        done;
        go ()
      | c ->
        (match !tab with
         | Some l when !line_start ->
           failk "tab" l
             "this line is indented with a tab. Indentation in a .fln file is \
              measured in columns, and a tab has no one width, so only spaces \
              indent. Replace the tab with spaces"
         | _ -> ());
        line_start := false;
        token c;
        go ()
  in
  go ();
  List.rev !out

(* ── Layout ────────────────────────────────────────────────────────── *)

(* The text being read, so that a message quotes what the user wrote rather
   than the paren form it became. Set for the length of one [read_all]. *)
let source : (string * string array) ref = ref ("", [||])

(* Line [l] of the text being read, trimmed, and the column its text starts
   at. *)
let source_line l =
  let _, lines = !source in
  if l < 1 || l > Array.length lines then ("", 1)
  else
    let t = lines.(l - 1) in
    let n = String.length t in
    let rec first i = if i < n && t.[i] = ' ' then first (i + 1) else i in
    (String.trim t, first 0 + 1)

(* A line under a let that is not at its first name's column [name_col]:
   the fix is the let's line and this one, lined up. *)
let let_misaligned loc ~let_line ~name ~name_col =
  let lt, lc = source_line let_line in
  let bt, _ = source_line loc.Loc.line in
  failk "let-align" loc
    "this line starts at column %d, under the let on line %d, whose bindings \
     line up with its first name, %s, at column %d. Move it to column %d:\n\n\
    \    %s\n    %s%s"
    loc.Loc.col let_line name name_col name_col lt
    (String.make (max 0 (name_col - lc)) ' ') bt

(* A line at a let's first name's column, after a value that took the
   lines under the let: it is the value's, not one more binding. *)
let let_after_block loc ~let_line ~name =
  let bt, _ = source_line loc.Loc.line in
  failk "let-after-block" loc
    "this line lines up as one more binding of the let on line %d, after %s, \
     whose value is the block above it. A binding whose value is a block ends \
     its let's bindings, so this one needs a let of its own, at that let's \
     column:\n\n    let %s"
    let_line name bt

(* Whether the tokens from [i] start a line shaped as a binding: [name =],
   [name:], a [[...]], [{...}] or [(op)] pattern, or [~x]. The alignment
   advice is for such lines only; any other line under a let is some other
   mistake. *)
let binding_shaped (arr : token array) i =
  let n = Array.length arr in
  let at k = if i + k < n then arr.(i + k).tok else EOF in
  match at 0, at 1 with
  | NAME s, (NAME "=" | COLON) -> s <> "" && s.[0] <> '.'
  | (LB | LC | LP | UNQ), _ -> true
  | _ -> false

(* A tab between [let] and its first name: the bindings under the let line
   up with that name, and a tab has no one width to line up with. *)
let let_gap_tab (t : token) (nm : token) =
  if t.loc.Loc.eline = nm.loc.Loc.line then begin
    let _, lines = !source in
    if nm.loc.Loc.line <= Array.length lines then
      let line = lines.(nm.loc.Loc.line - 1) in
      let a = t.loc.Loc.ecol - 1 and b = nm.loc.Loc.col - 1 in
      if a >= 0 && b <= String.length line && b > a
         && String.contains (String.sub line a (b - a)) '\t' then
        failk "tab" t.loc
          "there is a tab between let and %s. The bindings under a let line up \
           with its first name, and a tab has no one width, so put a space \
           there: let %s"
          (show nm.tok) (show nm.tok)
  end

let point (l : Loc.t) = { l with Loc.line = l.Loc.eline; col = l.Loc.ecol }

(* NEWLINE, INDENT and DEDENT, at bracket depth zero only: inside ( [ { a
   line break is whitespace. A line continues the one before it when either
   side of the break is a spaced binary operator (spec §2 "Continuation").

   The one exception is a lambda's block. A [=>] that ends its line inside
   brackets opens a block there: the lines under it are laid out as they
   would be at depth zero, against a base of their own (the column the [=>]
   line starts at), until the bracket around the lambda closes. That closer
   ends the block, whether it ends the block's last line or has a line of
   its own. The block is the last thing in its brackets: a comma after it,
   or a line back at the header's column, is refused. *)
type frame = {
  f_base : int;
  f_stack : int list;
  f_opens : token list;       (* the brackets open around the lambda *)
  f_arrow : token;            (* the [=>] that opened the block *)
}

let lambda_not_last (fr : frame) (t : token) =
  failk "lambda-block-last" t.loc
    "%s follows the block of the lambda on line %d, inside the same \
     brackets. A lambda with a block is the last thing in its brackets, and \
     its block ends where they close. Name the lambda with a let first and \
     pass the name:\n\n\
    \    let f = fn(a) =>\n      ...\n    g(f, x)"
    (if t.tok = COMMA then "a comma" else show t.tok) fr.f_arrow.loc.Loc.line

let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token array =
  let arr = Array.of_list toks in
  let n = Array.length arr in
  (* A snippet from the editor starts wherever it was written, and its first
     line is its base: a later line may not go left of it. One cut from the
     middle of a line (see [indent]) has that line's start as its base, so a
     block under the line, a [let]'s [match] arms or a lambda's, reads as it
     does in the file. *)
  let base =
    ref (if snippet && n > 0 then
           match indent with
           | Some c -> min c arr.(0).loc.Loc.col
           | None -> arr.(0).loc.Loc.col
         else base)
  in
  let out = ref [] in
  let add tok loc = out := { tok; loc; sp = true } :: !out in
  let stack = ref [ !base ] in
  (* [indent] is the column of the statement a snippet was cut out of, when
     the snippet starts after that statement's first word (an elif's
     condition, an arm's value). Its first joined line continues as it does
     in the file: deeper than the statement, not than the cut. *)
  let first_line = ref true in
  (* The brackets open in the current layout, innermost first. A lambda's
     block starts with none, and [frames] holds what it interrupted. *)
  let opens = ref [] in
  let frames = ref [] in
  let binop t = match t.tok with NAME s -> is_binop s | _ -> false in
  let closer t = match t.tok with RP | RB | RC -> true | _ -> false in
  (* The column [i]'s line starts at. *)
  let line_col i =
    let rec go j =
      if j > 0 && arr.(j - 1).loc.Loc.eline = arr.(i).loc.Loc.line then go (j - 1) else j
    in
    arr.(go i).loc.Loc.col
  in
  for i = 0 to n - 1 do
    let t = arr.(i) in
    (if i = 0 then begin
        if t.loc.Loc.col <> !base && indent = None then
          failk "unexpected-indent" t.loc
            "the first line starts at column %d, and a file's top-level lines \
             start at column %d. Remove the indentation"
            t.loc.Loc.col !base
      end
     else
       let p = arr.(i - 1) in
       (* The closer that ends a lambda's block takes the block's end with
          it, below: the line break before it is nothing. *)
       let ends_block = !frames <> [] && !opens = [] && closer t in
       if !opens = [] && t.loc.Loc.line > p.loc.Loc.eline && not ends_block then begin
         let spaced_after =
           i + 1 < n && arr.(i + 1).loc.Loc.line = t.loc.Loc.line
           && arr.(i + 1).sp
         in
         let continues = (binop p && p.sp) || (binop t && spaced_after) in
         let top =
           match indent with
           | Some c when !first_line && List.length !stack = 1 -> min c (List.hd !stack)
           | _ -> List.hd !stack
         in
         (* A continuation line sits deeper than the statement it continues.
            One at or left of that statement's column is not read as joining
            it: that would pull a line into a block it was written outside
            of, silently. *)
         if continues && t.loc.Loc.col <= top then
           failk "continuation" t.loc
             "%s"
             (if binop t then
                Printf.sprintf
                  "this line starts with the operator %s, so it continues the \
                   line above, but it is not indented past the start of that \
                   line (column %d). Indent it further to continue the line, \
                   or give %s a value on its left"
                  (show t.tok) top (show t.tok)
              else
                Printf.sprintf
                  "the line above ends with the operator %s, so this line \
                   continues it, but it is not indented past the start of \
                   that line (column %d). Indent it further, or finish the \
                   line above"
                  (show p.tok) top);
         if not continues then begin
           first_line := false;
           let at = point p.loc in
           let col = t.loc.Loc.col in
           (* Inside a lambda's brackets, a line at or left of the line its
              header is on would be a statement beside the lambda. *)
           (match !frames with
            (* Left of the block's own column, after the block: the next
               element of the brackets, which the block must end. *)
            | fr :: _ when List.length !stack > 1
                           && col < List.nth !stack (List.length !stack - 2) ->
              lambda_not_last fr t
            | fr :: _ when col <= !base ->
              if t.tok = COMMA then lambda_not_last fr t
              else
                failk "lambda-block-left" t.loc
                  "this line starts at column %d and is still inside the \
                   brackets of the lambda on line %d, whose block is indented \
                   past column %d. Indent it into the block, or close the \
                   brackets at the end of the block's last line"
                  col fr.f_arrow.loc.Loc.line !base
            | _ -> ());
           add NEWLINE at;
           let top = List.hd !stack in
           if col > top then begin
             stack := col :: !stack;
             add INDENT at
           end
           else if col < top then begin
             if col < !base then
               failk "dedent" t.loc
                 "%s"
                 (if snippet then
                    Printf.sprintf
                      "this line starts at column %d, left of column %d where \
                       the code sent starts. Its first line sets its left \
                       edge, and no later line can go left of it: send the \
                       enclosing form, or line this up at column %d or right \
                       of it"
                      col !base !base
                  else
                    Printf.sprintf
                      "this line starts at column %d, left of the top level at \
                       column %d" col !base);
             let closed = ref top in
             let rec pop () =
               match !stack with
               | top :: (_ :: _ as rest) when col < top ->
                 closed := top; stack := rest; add DEDENT at; pop ()
               | _ -> ()
             in
             pop ();
             (* Between a let's column and the block under it: a binding
                meant for that let, if the let owns the block. *)
             (if col <> List.hd !stack then
                let first_on_line j =
                  j = 0 || arr.(j - 1).loc.Loc.eline < arr.(j).loc.Loc.line
                in
                let rec owner j =
                  if j < 0 then None
                  else if first_on_line j && arr.(j).loc.Loc.col <= List.hd !stack then
                    Some j
                  else owner (j - 1)
                in
                match owner (i - 1) with
                | Some j when arr.(j).tok = NAME "let" && j + 1 < n
                              && arr.(j).loc.Loc.col = List.hd !stack
                              && binding_shaped arr i ->
                  let nm = arr.(j + 1) in
                  let let_line = arr.(j).loc.Loc.line and name = show nm.tok in
                  if col = nm.loc.Loc.col then let_after_block t.loc ~let_line ~name
                  else let_misaligned t.loc ~let_line ~name ~name_col:nm.loc.Loc.col
                | _ -> ());
             if col <> List.hd !stack then
               failk "dedent" t.loc
                 "this line starts at column %d, between the block at column \
                  %d and the one at column %d it would close, so it belongs \
                  to neither. The enclosing blocks start at column%s %s: line \
                  it up with one of them"
                 col (List.hd !stack) !closed
                 (if List.length !stack > 1 then "s" else "")
                 (String.concat ", "
                    (List.rev_map string_of_int !stack))
           end
         end
       end);
    (match !frames with
     (* A comma at the top of a lambda's block, on one of the block's lines. *)
     | fr :: _ when !opens = [] && t.tok = COMMA -> lambda_not_last fr t
     (* The closer of the brackets a lambda's block is in: the block ends. *)
     | fr :: rest when !opens = [] && closer t ->
       let at = point arr.(i - 1).loc in
       add NEWLINE at;
       List.iter (fun _ -> add DEDENT at) (List.tl !stack);
       base := fr.f_base;
       stack := fr.f_stack;
       opens := fr.f_opens;
       frames := rest
     | _ -> ());
    out := t :: !out;
    (match t.tok with
     | LP | LB | LC -> opens := t :: !opens
     | RP | RB | RC -> (match !opens with _ :: r -> opens := r | [] -> ())
     | NAME "=>" when !opens <> [] && i + 1 < n
                      && arr.(i + 1).loc.Loc.line > t.loc.Loc.eline ->
       frames := { f_base = !base; f_stack = !stack; f_opens = !opens; f_arrow = t }
                 :: !frames;
       (* A snippet cut from the middle of a line starts where its line
          does in the file, [indent], not where the cut does. *)
       base :=
         (match indent with
          | Some c when t.loc.Loc.line = arr.(0).loc.Loc.line -> min c (line_col i)
          | _ -> line_col i);
       stack := [ !base ];
       opens := []
     | _ -> ())
  done;
  (match !frames with
   | fr :: _ ->
     let o = match fr.f_opens with o :: _ -> o | [] -> fr.f_arrow in
     failk "unclosed" o.loc
       ~notes:[ Loc.note (point arr.(n - 1).loc) "the input ends here, still inside it" ]
       "unclosed %s: the block of the lambda on line %d ends where this \
        bracket closes"
       (show o.tok) fr.f_arrow.loc.Loc.line
   | [] -> ());
  (if n > 0 then
     let at = point arr.(n - 1).loc in
     add NEWLINE at;
     List.iter (fun _ -> add DEDENT at) (List.tl !stack));
  let eof_loc = if n > 0 then point arr.(n - 1).loc else Loc.unknown in
  add EOF eof_loc;
  Array.of_list (List.rev !out)

(* ── Parsing ───────────────────────────────────────────────────────── *)

(* [closed] is where a lambda's block that ended its statement stopped:
   the block took the line's end with it, so a check for that end passes
   there. *)
type p = { toks : token array; mutable i : int; mutable closed : int }

(* Set below [params] and [ty], which the expression parser comes before. *)
let typed_fn_expr : (p -> Form.t * int) ref = ref (fun _ -> assert false)

(* A block's statements, for a lambda's; set once the statement parser is. *)
let block_of : (p -> Form.t list) ref = ref (fun _ -> assert false)

let peek p = p.toks.(p.i)
let peek_at p k = p.toks.(min (p.i + k) (Array.length p.toks - 1))
let advance p =
  let t = peek p in
  if t.tok <> EOF then p.i <- p.i + 1;
  t
let last p = p.toks.(max 0 (p.i - 1))

(* From [l] to the end of the last token consumed. *)
let span p (l : Loc.t) =
  let e = (last p).loc in
  if e.Loc.eline > l.Loc.line
     || (e.Loc.eline = l.Loc.line && e.Loc.ecol > l.Loc.col)
  then { l with Loc.eline = e.Loc.eline; ecol = e.Loc.ecol }
  else l

let mk p l v = Form.make v (span p l)
let sym l s = Form.make (Form.Sym s) l

(* Where a stray token is, pointing at the real token after a layout one. *)
let where_ p =
  let t = peek p in
  match t.tok with
  | NEWLINE | INDENT | DEDENT -> (peek_at p 1).loc
  | _ -> t.loc

let starts_value = function
  | NAME _ | KW _ | ATOM _ | DATUM _ | LP | LB | LC | UNQ | SPLICE | BNOT | NEG -> true
  | _ -> false

let ends_value = function
  | RP | RB | RC | COMMA | NEWLINE | EOF | INDENT | DEDENT -> true
  | _ -> false

let negative_literal = function
  | ATOM (Form.Int i) -> Int64.compare i 0L < 0
  | ATOM (Form.Float f) -> f < 0.
  | _ -> false

(* Something followed a complete value where nothing may. The two shapes that
   get their own sentence are the ones a Lisp hand writes: [a -1] and
   [f (x)]. *)
(* A [?] glued to the name just read, somewhere a type is not: the name
   is what was meant, [let ok? = 1] or [fn f(ok?: bool)]. *)
let mark_after p =
  let t = peek p in
  match t.tok, (last p).tok with
  | QUEST, NAME n when (not t.sp) && p.i > 0 && n <> "" ->
    let l = (last p).loc in
    let n = if n.[0] = '.' then String.sub n 1 (String.length n - 1) else n in
    name_refused ~typed:(type_like n) { l with Loc.eline = t.loc.Loc.eline; ecol = t.loc.Loc.ecol } (n ^ "?")
  | _ -> ()

let stray p ~after =
  mark_after p;
  let t = peek p in
  match t.tok with
  | ATOM _ when t.sp && negative_literal t.tok ->
    let text = show t.tok in
    let digits = String.sub text 1 (String.length text - 1) in
    failk "glued-minus" t.loc
      "%s is read as the number %s, right after %s with nothing between them. \
       To subtract, space the minus: %s - %s. For two values, separate them \
       with a comma: %s, %s"
      text text after after digits after text
  | LP when t.sp ->
    failk "spaced-call" t.loc
      "there is a space before this (, so it does not call %s — a call has \
       none. Write %s(...), or put a comma before the ( if it is a separate \
       value"
      after after
  | LB when t.sp ->
    failk "spaced-index" t.loc
      "there is a space before this [, so it does not index %s — indexing has \
       none. Write %s[i]"
      after after
  | NEWLINE | INDENT | DEDENT | EOF ->
    failk "unexpected-end" (where_ p) "the line ends after %s, which is not \
                                       finished here" after
  | NAME "=" ->
    failk "assign-in-test" t.loc
      "this = follows %s, where it cannot assign: an assignment is a line \
       of its own, with one =. To compare two values, write == instead"
      after
  | COLON ->
    failk "header-colon" t.loc
      "this line ends in a colon after %s. A header (if, elif, else, while, \
       until, for, fn, match, ...) opens its block with no colon; only a call \
       takes one, as in f(x):. Remove the colon"
      after
  | _ ->
    failk "unexpected-token" t.loc
      "%s follows %s, and two values cannot sit side by side here. Separate \
       them with a comma, or join them with an operator"
      (show t.tok) after

let expect p tok ~what =
  let t = peek p in
  if t.tok = tok then ignore (advance p)
  else
    let () = mark_after p in
    failk "expected" (where_ p) "expected %s here, and found %s" what
      (show t.tok)

let expect_name p s ~what =
  match (peek p).tok with
  | NAME n when n = s -> ignore (advance p)
  | t -> mark_after p; failk "expected" (where_ p) "expected %s here, and found %s" what (show t)

(* The lets whose first value is being read, innermost first: the column
   of the let's first name, the name, and the let's line. A line at that
   column under the value's block looks like one more binding and is not. *)
let let_values : (int * string * int) list ref = ref []

(* The end of a line that is not followed by a block. *)
let expect_eol p ~after =
  if p.i = p.closed then () else
  match (peek p).tok with
  | NEWLINE ->
    ignore (advance p);
    (match (peek p).tok, !let_values with
     | INDENT, (name_col, name, let_line) :: _ ->
       let t = peek_at p 1 in
       let shaped =
         match t.tok, (peek_at p 2).tok with
         | NAME _, (NAME "=" | COLON) | (LB | LC | LP | UNQ), _ -> true
         | _ -> false
       in
       if t.loc.Loc.col = name_col && shaped then let_after_block t.loc ~let_line ~name
     | _ -> ());
    if (peek p).tok = INDENT then
      failk "stray-indent" (peek_at p 1).loc
        "this line is indented under %s, which takes no block. A call takes \
         an indented block only with a trailing colon, as in %s:"
        after
        (* The call itself when [after] is one, [f(a, b)]; else an example. *)
        (match String.index_opt after '(', String.index_opt after ' ' with
         | Some i, Some j when i < j -> after
         | Some _, None when after.[String.length after - 1] = ')' -> after
         | _ -> "rl/with-drawing()")
  | EOF -> ()
  | _ -> stray p ~after

(* A target's first token, for a message: [(not)] is shown whole. *)
let text_of_tok (t : token) =
  match t.tok with LP -> "the name in parentheses" | tk -> show tk

let check_name (t : token) s =
  if String.contains s ':' then
    failk "colon-in-name" t.loc
      "%s has a colon inside it, and a name cannot. A type annotation puts a \
       space after the colon: %s"
      s
      (match String.index_opt s ':' with
       | Some i -> String.sub s 0 (i + 1) ^ " " ^ String.sub s (i + 1) (String.length s - i - 1)
       | None -> s)

(* A form's own text, for the "after" half of a message. *)

let text_of (f : Form.t) =
  let file, lines = !source in
  let l = f.loc in
  let from_source =
    if l.Loc.file <> file || l.Loc.line < 1 || l.Loc.line > Array.length lines then None
    else
      let text = lines.(l.Loc.line - 1) in
      let a = l.Loc.col - 1 in
      let b = if l.Loc.eline = l.Loc.line then l.Loc.ecol - 1 else String.length text in
      if a < 0 || b > String.length text || b <= a then None
      else
        let t = String.trim (String.sub text a (b - a)) in
        Some (if l.Loc.eline > l.Loc.line then t ^ " ..." else t)
  in
  let s = match from_source with Some t -> t | None -> Form.to_source f in
  if String.length s > 40 then String.sub s 0 37 ^ "..." else s

(* An assignment's place that is an optional chain or an unwrap: neither
   names storage, and the forms they read to would show the reader's names. *)
let no_place (e : Form.t) =
  match e.v with
  | Form.List ({ v = Form.Sym "?."; _ } :: _) ->
    failk "chain-assign" e.loc
      "%s is an optional chain, and a chain cannot be assigned to: when it \
       holds nothing there is no place to write. Unwrap it first with if let, \
       then assign through the name it binds"
      (text_of e)
  | Form.List [ { v = Form.Sym "!!"; _ }; _ ] ->
    failk "chain-assign" e.loc
      "%s unwraps a value, and a value cannot be assigned to. Unwrap it with \
       if let, then assign through the name it binds"
      (text_of e)
  | _ -> ()

let unclosed p c l0 =
  failk "unclosed" l0
    ~notes:[ Loc.note (where_ p) "the input ends here, still inside it" ]
    "unclosed %C" c

let refuse_ws ?(brace = false) loc e =
  failk "separate-elements" loc
    "%s has an operator in it and sits in a list separated by spaces, where \
     only single values are. Separate the %s with commas: %s"
    (text_of e)
    (if brace then "entries" else "elements")
    (if brace then "{.x a + 1, .y 2}" else "[a - 1, b]")

(* [loop] and [recur] are Lisp-syntax forms. A .fln loop is a [while],
   [until], [dotimes] or [for]; [read_all] refuses any that gets past the
   parser, in a [quote] or a quoted datum too. *)
let no_loop loc word =
  failk "no-loop" loc
    "%s is not part of the indented syntax. A loop here is a while, until, \
     dotimes or for, with let variables it changes:\n\n\
    \    let i = 0\n    let total = 0\n    while i < 10\n      total += i\n      i += 1\n\n\
     break leaves the loop early, and continue goes on to the next round."
    word

(* A [when] has one branch; an else under one is an if's. *)
let when_else p =
  failk "when-else" (peek p).loc
    "a when has no else — it answers Some of its value when the test holds \
     and None when it does not. For two branches write if c then a else b, \
     or an if with an else block"

(* A refused chain written out as the [and] of all its tests. A middle
   operand that is more than a name or a literal is named by a [let] first,
   so the rewrite does not run it twice. *)
let and_rewrite (xs : Form.t list) ops =
  let n = List.length xs in
  let lets = ref [] in
  let texts =
    List.mapi
      (fun i (x : Form.t) ->
         let plain = match x.v with Form.List _ | Form.Vec _ | Form.Map _ -> false | _ -> true in
         if plain || i = 0 || i = n - 1 then text_of x
         else begin
           let m = if !lets = [] then "mid" else Printf.sprintf "mid%d" (List.length !lets + 1) in
           lets := Printf.sprintf "    let %s = %s\n" m (text_of x) :: !lets;
           m
         end)
      xs
  in
  let rec tests = function
    | a :: (b :: _ as rest), op :: ops -> Printf.sprintf "%s %s %s" a op b :: tests (rest, ops)
    | _ -> []
  in
  String.concat "" (List.rev !lets) ^ "    " ^ String.concat " and " (tests (texts, ops))

(* Expressions come back with their syntactic level: 13 an atom or a bracket,
   12 a postfix chain, 11 a prefix [-] or [~~], 1-10 a binary operator's
   level, 3 a [not], 0 a one-line [if] or a lambda. Anything under 11 is
   "compound": it has an operator at its top, so it cannot sit in a list
   separated only by whitespace. *)
let rec expr p : Form.t * int = binary p 1

and binary p lvl : Form.t * int =
  if lvl = 3 then not_ p
  else if lvl > 10 then unary p
  else
    let l0 = (peek p).loc in
    let ((first, _) as fst_) = operand p lvl in
    let close op operands =
      match List.rev operands with
      | [ x ] -> (x, lvl)
      | ops ->
        if op = "!=" && List.length ops > 2 then
          failk "chained-not-equal" l0
            "a != b != c is not read. != with more than two values means all \
             of them are distinct, which is not what the chain says, so it is \
             written as a call: !=(a, b, c)";
        (mk p l0 (Form.List (sym l0 (op_sym op) :: ops)), lvl)
    in
    (* An operator glued to a parenthesis is a call, [+(a, b)], and never
       the operator between two values. *)
    let binary_here s =
      binop_level s = Some lvl
      && not ((peek_at p 1).tok = LP && not (peek_at p 1).sp)
    in
    let operator s =
      let ot = advance p in
      if not (ot.sp && (peek p).sp) then
        failk "unspaced-operator" ot.loc
          "%s is an operator here, and a binary operator has a space on each \
           side: a %s b. Without them a-b is one name"
          s s;
      let rhs, _ = operand p lvl in
      (ot, rhs)
    in
    let rec run op operands =
      match (peek p).tok with
      | NAME s when binary_here s ->
        let _, rhs = operator s in
        if s = op then run op (rhs :: operands)
        else
          let folded, _ = close op operands in
          run s [ rhs; folded ]
      | _ -> close op operands
    in
    (* A comparison chain is read whole, then judged: one operator throughout
       is the variadic call, one direction is [cmp_chain], anything else is
       refused at the first operator that breaks it. *)
    let rec chain acc =
      match (peek p).tok with
      | NAME s when binary_here s ->
        let ot, rhs = operator s in
        chain ((s, ot, rhs) :: acc)
      | _ -> List.rev acc
    in
    let comparison () =
      let links = chain [] in
      let ops = List.map (fun (s, _, _) -> s) links in
      let xs = first :: List.map (fun (_, _, x) -> x) links in
      let op1 = List.hd ops in
      if List.for_all (( = ) op1) ops then close op1 (List.rev xs)
      else
        let d = cmp_dir op1 in
        Array.iteri
          (fun i (op, (ot : token), _) ->
             if i > 0 && (d = None || cmp_dir op <> d) then begin
               let prev, _, _ = List.nth links (i - 1) in
               failk "mixed-comparison" ot.loc
                 "%s follows %s in one chain. A chain may repeat one operator, \
                  or mix < with <=, or > with >=, as in 0 <= i < n. Write this \
                  one as tests joined with and:\n\n%s"
                 op prev (and_rewrite xs ops)
             end)
          (Array.of_list links);
        (cmp_chain ~fresh:cmp_fresh (span p l0) xs ops, lvl)
    in
    (* [run] folds a different operator at the same level into the left
       operand, so the first operator here only starts the first run. *)
    match (peek p).tok with
    | NAME s when binary_here s && (cmp_dir s <> None || s = "==" || s = "!=") ->
      comparison ()
    | NAME s when binary_here s -> run s [ first ]
    | _ -> fst_

(* An operand of level [lvl]'s operators. [??] sits between the comparisons
   (4) and the bit operators (5), Swift's place for it: [a ?? b == c] is
   [(a ?? b) == c] and [a ?? b + 1] is [a ?? (b + 1)]. A chain is one
   variadic form, [(?? a b c)], which the checker reads from the right. *)
and operand p lvl =
  if lvl <> 4 then binary p (lvl + 1)
  else
    let l0 = (peek p).loc in
    let ((first, _) as fp) = binary p 5 in
    let rec more acc =
      match (peek p).tok with
      | NAME "??" when not ((peek_at p 1).tok = LP && not (peek_at p 1).sp) ->
        let ot = advance p in
        if not (ot.sp && (peek p).sp) then
          failk "unspaced-operator" ot.loc
            "?? is an operator here, and a binary operator has a space on each \
             side: a ?? b";
        let rhs, _ = binary p 5 in
        more (rhs :: acc)
      | _ -> List.rev acc
    in
    match more [] with
    | [] -> fp
    | rest -> (mk p l0 (Form.List (sym l0 "??" :: first :: rest)), 4)

and not_ p =
  let t = peek p in
  match t.tok with
  | NAME "not" when (peek_at p 1).sp && starts_value (peek_at p 1).tok ->
    ignore (advance p);
    let x, _ = not_ p in
    (mk p t.loc (Form.List [ sym t.loc "not"; x ]), 3)
  | _ -> binary p 4

and unary p =
  let t = peek p in
  match t.tok with
  | NEG ->
    ignore (advance p);
    let x, _ = postfix p in
    (mk p t.loc (Form.List [ sym t.loc "-"; x ]), 11)
  | BNOT ->
    ignore (advance p);
    let x, _ = unary p in
    (mk p t.loc (Form.List [ sym t.loc "bit-not"; x ]), 11)
  | _ -> postfix p

and postfix p =
  let l0 = (peek p).loc in
  let rec loop ((f, _) as fp) =
    let t = peek p in
    if t.sp then fp
    else
      match t.tok with
      | LP ->
        ignore (advance p);
        let args = items p RP t.loc ~what:"arguments" in
        loop (mk p l0 (Form.List (f :: args)), 12)
      | LB ->
        ignore (advance p);
        let idx = index_items p t.loc ~head:(text_of f) in
        loop (mk p l0 (Form.List (sym t.loc "at" :: f :: idx)), 12)
      | NAME s when String.length s > 1 && s.[0] = '.' ->
        ignore (advance p);
        loop (mk p l0 (Form.List [ sym t.loc s; f ]), 12)
      | LC ->
        ignore (advance p);
        let m = map_items p t.loc in
        loop (mk p l0 (Form.List [ f; Form.make (Form.Map m) (span p t.loc) ]), 12)
      (* [a?.b.c(x)] and [a?[i]]: the rest of the chain is read over a fresh
         name, [~o1], bound to what [a] holds — [(?. [~o1 a] (.c ...))]. No
         reader can produce a [~] name, so it shadows nothing. A [?.] later
         in the rest nests, and the checker flattens it. *)
      | QUEST
        when (let n = peek_at p 1 in
              (not n.sp)
              && (match n.tok with
                  | NAME s -> String.length s > 1 && s.[0] = '.'
                  | LB -> true
                  | _ -> false)) ->
        ignore (advance p);
        incr opt_n;
        let h = Printf.sprintf "~o%d" !opt_n in
        let rest, _ = loop (sym t.loc h, 12) in
        (mk p l0
           (Form.List
              [ sym t.loc "?.";
                Form.make (Form.Vec [ sym t.loc h; f ]) f.loc;
                rest ]), 12)
      (* [T?] where a type is read, and after what can only be a type
         where a value is, [vec-new(i32?)]. On a value, [x?] tests that it
         holds one (decision 133): [(? x)]. *)
      | QUEST ->
        let typish =
          match f.v with
          | Form.Sym n -> type_like n
          | Form.Vec _ -> true
          | Form.List ({ v = Form.Sym h; _ } :: _) ->
            h <> "" && h.[0] >= 'A' && h.[0] <= 'Z'
          | _ -> false
        in
        ignore (advance p);
        if !in_type || typish then
          loop (mk p l0 (Form.List [ sym l0 "Option"; f ]), 12)
        else loop (mk p l0 (Form.List [ sym t.loc "?"; f ]), 12)
      | BANG ->
        ignore (advance p);
        loop (mk p l0 (Form.List [ sym t.loc "!!"; f ]), 12)
      | _ -> fp
  in
  loop (primary p)

and primary p : Form.t * int =
  let t = peek p in
  let l0 = t.loc in
  match t.tok with
  | NAME s ->
    let nxt = peek_at p 1 in
    let glued_lp = nxt.tok = LP && not nxt.sp in
    if (s = "if" || s = "when") && nxt.sp && starts_value nxt.tok then if_expr p
    else if s = "fn" && glued_lp then fn_expr p
    (* Only the Lisp loop's spellings are refused here, for a message at the
       word: [loop x = a, ...], [loop([...]):], a bare [loop] over a block
       where a statement or a let's value starts, and [recur(...)]. Anywhere
       else [loop] and [recur] are names; [refuse_loops] catches the rest. *)
    else if glued_lp && (s = "loop" || s = "recur") then no_loop l0 s
    else if s = "loop"
         && ((nxt.sp
              && (match nxt.tok with NAME x -> not (is_op_word x) | _ -> false)
              && (match (peek_at p 2).tok with NAME "=" | COMMA -> true | _ -> false))
             || (nxt.tok = NEWLINE && (peek_at p 2).tok = INDENT
                 && (p.i = 0
                     || (match (last p).tok with
                         | NEWLINE | INDENT | DEDENT | NAME "=" -> true
                         | _ -> false)))) then
      no_loop l0 s
    else if is_op_word s then begin
      if glued_lp || ends_value nxt.tok then begin
        ignore (advance p);
        (sym l0 (op_sym s), 13)
      end
      else if s = "not" && nxt.sp && starts_value nxt.tok then begin
        (* [a == not b]: [not] binds looser than the operator before it, so
           it cannot start that operator's right side. The fix is the line
           with the [not] and its operand in parentheses. *)
        ignore (advance p);
        let x, _ = not_ p in
        let e = (last p).loc in
        let _, lines = !source in
        let fix =
          if e.Loc.eline <> l0.Loc.line || l0.Loc.line > Array.length lines then
            "(not " ^ text_of x ^ ")"
          else
            let line = lines.(l0.Loc.line - 1) in
            let a = l0.Loc.col - 1 and b = e.Loc.ecol - 1 in
            String.trim
              (String.sub line 0 a ^ "(" ^ String.sub line a (b - a) ^ ")"
               ^ String.sub line b (String.length line - b))
        in
        failk "not-operand" l0
          "not follows an operator here, and it binds looser than any \
           operator but and and or, so it cannot start that operator's right \
           side. Put it in parentheses with what it negates:\n\n    %s"
          fix
      end
      else
        failk "operator-operand" l0
          "%s is an operator, and nothing is on its left. As a value on its \
           own it goes before a comma or a closing bracket, reduce(%s, xs); \
           as a call it is glued to its parenthesis, %s(a, b)"
          s s s
    end
    else begin
      ignore (advance p);
      check_name t s;
      (sym l0 s, 13)
    end
  | KW k -> ignore (advance p); (Form.make (Form.Kw k) l0, 13)
  | ATOM v ->
    ignore (advance p);
    (Form.make v l0, if negative_literal t.tok then 11 else 13)
  | DATUM f -> ignore (advance p); (f, 13)
  | LP ->
    ignore (advance p);
    if (peek p).tok = RP then begin
      ignore (advance p);
      (mk p l0 (Form.List []), 13)
    end
    else
      let e, _ = expr p in
      (match (peek p).tok with
       | RP -> ignore (advance p)
       | EOF -> unclosed p '(' l0
       | COMMA ->
         failk "tuple" (peek p).loc
           "parentheses group one value, and this comma starts a second. \
            Several values in a list are written in brackets, [a, b]; \
            arguments go glued to a name, f(a, b)"
       | _ -> stray p ~after:(text_of e));
      (e, 13)
  | LB ->
    ignore (advance p);
    let xs = vec_items p l0 in
    (mk p l0 (Form.Vec xs), 13)
  | LC ->
    ignore (advance p);
    let xs = map_items p l0 in
    (mk p l0 (Form.Map xs), 13)
  | UNQ | SPLICE ->
    ignore (advance p);
    let x, _ = primary p in
    let name = if t.tok = UNQ then "unquote" else "unquote-splicing" in
    (mk p l0 (Form.List [ sym l0 name; x ]), 13)
  | NEG | BNOT -> unary p
  | tk ->
    failk "expected-value" (where_ p) "expected a value here, and found %s"
      (show tk)

(* [if c then a else b]: the one-line form, for a value. [if let P = v then
   a else b] and [when c then a] too. *)
and if_expr p =
  let t = advance p in
  let word = match t.tok with NAME w -> w | _ -> "if" in
  let letp = if word = "if" then if_let_head p else None in
  let c = match letp with Some m -> m | None -> fst (binary p 1) in
  let letp, c =
    match letp with
    | Some _ -> (letp, c)
    | None -> (match as_head p c with Some m when word = "if" -> (Some m, m) | _ -> (None, c))
  in
  (match (peek p).tok with
   | NAME "then" -> ignore (advance p)
   | _ ->
     failk "if-then" (where_ p)
       "an %s inside a line is %s, and there is no then \
        after %s. Write the then, or start the %s on its own line with its \
        branches indented under it"
       word
       (if word = "when" then "when c then a" else "if c then a else b")
       (text_of c) word);
  let a = inline_stmt p in
  match (peek p).tok with
  | NAME ("else" | "elif") when word = "when" -> when_else p
  | NAME "else" ->
    ignore (advance p);
    let b = inline_stmt p in
    (if_let_wrap letp (mk p t.loc (Form.List [ sym t.loc "if"; c; a; b ])), 0)
  | NAME "elif" ->
    failk "one-line-elif" (peek p).loc
      "a one-line if has then and else and no elif. Chain another if after \
       the else — if a then x else if b then y else z — or write the if over \
       several lines, where elif goes"
  | _ -> (if_let_wrap letp (mk p t.loc (Form.List [ sym t.loc "when"; c; a ])), 0)

(* [if let P = v]: after the [if], the pattern and the value, as the one form
   [[P v]] that stands where the test would. [None] when no [let] follows. *)
and if_let_head p =
  match (peek p).tok, (peek_at p 1) with
  | NAME "let", n when n.sp ->
    let lt = advance p in
    let pat, _ = unary p in
    expect_name p "=" ~what:"= and the value the pattern is matched against";
    let v, _ = binary p 1 in
    (match pat.v with
     | Form.Sym g
       when g <> "" && g.[0] >= 'a' && g.[0] <= 'z' && not (String.contains g '.')
            && g <> "true" && g <> "false" ->
       failk "if-let-name" pat.loc
         "if let %s = %s has no pattern to test. To test that %s holds a \
          value, write if %s?, and in the block it is what it holds; to name \
          what it holds, write if %s? as %s"
         g (text_of v) (text_of v) (text_of v) (text_of v) g
     | _ -> ());
    Some (mk p lt.loc (Form.Vec [ pat; v ]))
  | _ -> None

(* [e? as g]: after a test [e?], the name what [e] holds is bound to, as
   the head [[g e]] an [if let] over a plain name stands as (decision 133). *)
and as_head p (c : Form.t) =
  match (peek p).tok with
  | NAME "as" ->
    let at = advance p in
    (match c.v with
     | Form.List [ { v = Form.Sym "?"; _ }; e ] ->
       let g =
         match (peek p).tok with
         | NAME g when g <> "" && g.[0] <> '.' ->
           let gt = advance p in
           check_name gt g;
           sym gt.loc g
         | tk ->
           failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk)
       in
       Some (Form.make (Form.Vec [ g; e ]) c.loc)
     | _ ->
       failk "as-test" at.loc
         "as names what a test found, and %s is not one. Write %s? as name"
         (text_of c) (text_of c))
  | _ -> None

(* The if an [if let] head was read into, rewritten to (if-let [P v] then
   else): [(if [P v] a b)], [(when [P v] body ...)] and an elif chain's
   [(cond [P v] a c2 b2 ...)], whose rest is the else. *)
and if_let_wrap letp (f : Form.t) =
  match letp with
  | None -> f
  | Some m ->
    let il (h : Form.t) items =
      { f with Form.v = Form.List (sym h.Form.loc "if-let" :: m :: items) }
    in
    let body (h : Form.t) = function
      | [ x ] -> x
      | (x : Form.t) :: _ as xs ->
        Form.make (Form.List (sym x.Form.loc "do" :: xs)) x.Form.loc
      | [] -> Form.make (Form.List [ sym h.Form.loc "do" ]) h.Form.loc
    in
    match f.Form.v with
    | Form.List (({ v = Form.Sym "if"; _ } as h) :: c :: rest) when c == m -> il h rest
    | Form.List (({ v = Form.Sym "when"; _ } as h) :: c :: b) when c == m ->
      il h [ body h b ]
    | Form.List (({ v = Form.Sym "cond"; _ } as h) :: c :: b1 :: rest) when c == m ->
      (match rest with
       | [] -> il h [ b1 ]
       | [ { v = Form.Kw "else"; _ }; e ] -> il h [ b1; e ]
       | (c2 : Form.t) :: _ ->
         il h [ b1; Form.make (Form.List (sym c2.Form.loc "cond" :: rest)) c2.Form.loc ])
    | _ -> f

(* What a one-line slot takes — a match arm's value, a then or an else, the
   thing after defer: a value, or one of the statements that fit on a line,
   break, continue, return and an assignment. *)
(* A bare [()] written where a body goes — a one-line slot, a function's
   [= ()] — is the empty statement, [(do)], as it is on a line of its own:
   "do nothing" is what it says there. [(())] stays a value. *)
and unit_slot p i0 (t0 : token) (e : Form.t) =
  if p.i - i0 = 2 && t0.tok = LP && e.v = Form.List [] then
    Form.make (Form.List [ sym t0.loc "do" ]) e.loc
  else e

and inline_stmt p : Form.t =
  let t = peek p in
  let glued = let n = peek_at p 1 in n.tok = LP && not n.sp in
  match t.tok with
  | NAME (("break" | "continue") as w) when not glued ->
    ignore (advance p);
    (match (peek p).tok with
     | KW k ->
       let kt = advance p in
       mk p t.loc (Form.List [ sym t.loc w; Form.make (Form.Kw k) kt.loc ])
     | _ -> mk p t.loc (Form.List [ sym t.loc w ]))
  | NAME "return" when not glued ->
    ignore (advance p);
    let n = peek p in
    if starts_value n.tok && not (n.tok = NAME "else") then
      let v, _ = expr p in
      mk p t.loc (Form.List [ sym t.loc "return"; v ])
    else mk p t.loc (Form.List [ sym t.loc "return" ])
  | _ ->
    let i0 = p.i in
    let e, _ = expr p in
    match (peek p).tok with
    | NAME "=" ->
      no_place e;
      let eq = advance p in
      let v, _ = expr p in
      mk p t.loc (Form.List [ sym eq.loc "set"; e; v ])
    | NAME op when List.mem_assoc op assign_ops ->
      no_place e;
      let eq = advance p in
      let v, _ = expr p in
      mk p t.loc (compound eq.loc (List.assoc op assign_ops) e v (span p e.loc))
    | _ -> unit_slot p i0 t e

(* [fn(a, b) => body] is a lambda; [fn(...)] followed by anything else is the
   fallback call spelling of [(fn ...)]. *)
and fn_expr p =
  if typed_lambda p then !typed_fn_expr p else
  let t = advance p in
  let lp = advance p in
  let args = items p RP lp.loc ~what:"parameters" in
  let rp = last p in
  let names = List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) args in
  let header () = "fn(" ^ String.concat ", " (List.map text_of args) ^ ")" in
  let n = peek p in
  match n.tok with
  | NAME "=>" ->
    ignore (advance p);
    let ps = lambda_params args in
    let body = lambda_body p ~header:(header ()) in
    (mk p t.loc
       (Form.List
          (sym t.loc "fn" :: Form.make (Form.Vec ps) (span_of_list lp.loc args) :: body)),
     0)
  | NAME "=" when names -> lambda_equals p (header ())
  | NAME w when names && glued_arrow w -> lambda_glued n (header ()) w
  | NEWLINE when names && (peek_at p 1).tok = INDENT ->
    lambda_arrow (peek_at p 2).loc (header ())
  (* Inside brackets a line break is no token: the next line's first token
     is what follows. *)
  | tk when names && n.loc.Loc.line > rp.loc.Loc.eline && starts_value tk ->
    lambda_arrow n.loc (header ())
  | _ -> (mk p t.loc (Form.List (sym t.loc "fn" :: args)), 12)

(* What follows a lambda's [=>]: a value on the line, or the indented block
   under it. [header] is the lambda's header as written, for a message. *)
and lambda_body p ~header =
  match (peek p).tok, (peek_at p 1).tok with
  | NEWLINE, INDENT ->
    ignore (advance p);
    let body = !block_of p in
    p.closed <- p.i;
    body
  | (NEWLINE | EOF | DEDENT), _ ->
    failk "lambda-body" (where_ p)
      "the line ends after %s =>, and the lambda's body is not under it. Put \
       the body after the =>, or on the lines under it, indented:\n\n\
      \    %s =>\n      ..."
      header header
  | _ ->
    let i0 = p.i and t0 = peek p in
    let body, _ = expr p in
    [ unit_slot p i0 t0 body ]

(* [fn(a) = x]: a lambda written with a named function's [=]. *)
and lambda_equals : 'a. p -> string -> 'a = fun p header ->
  let eq = advance p in
  let body =
    match expr p with
    | b, _ -> text_of b
    | exception _ -> "..."
  in
  failk "lambda-equals" eq.loc
    "a lambda's body follows =>, and this one has =, which is how a named \
     function is written. Write:\n\n    %s => %s"
    header body

(* [fn(a) =>x]: the body glued to the arrow reads as one name. *)
and glued_arrow w = String.length w > 2 && String.sub w 0 2 = "=>"

and lambda_glued : 'a. token -> string -> string -> 'a = fun t header w ->
  failk "lambda-arrow-space" t.loc
    "%s is one name, with nothing between => and the body. Put a space \
     after the arrow: %s => %s"
    w header (String.sub w 2 (String.length w - 2))

(* A lambda header with lines under it and no [=>]. *)
and lambda_arrow : 'a. Loc.t -> string -> 'a = fun at header ->
  failk "lambda-arrow" at
    "the lines under %s are a lambda's body only after =>. End the header \
     with it:\n\n    %s =>\n      ..."
    header header

(* Whether the [fn(] at point has a [:] among its parameters or a [->]
   after them: a lambda that states its types. *)
and typed_lambda p =
  let rec go k depth =
    let t = peek_at p k in
    match t.tok with
    | EOF -> false
    | COLON when depth = 1 -> true
    | LP | LB | LC -> go (k + 1) (depth + 1)
    | RP when depth = 1 -> (peek_at p (k + 1)).tok = NAME "->"
    | RP | RB | RC -> go (k + 1) (depth - 1)
    | _ -> go (k + 1) depth
  in
  go 1 0

and span_of_list l args =
  match List.rev args with
  | [] -> l
  | (x : Form.t) :: _ -> { l with Loc.eline = x.loc.Loc.eline; ecol = x.loc.Loc.ecol }

and lambda_params args =
  List.map
    (fun (a : Form.t) ->
       match a.v with
       | Form.Sym _ -> a
       | _ ->
         failk "lambda-param" a.loc
           "a lambda's parameter is a name, and this is %s. Take the value \
            under a name and destructure it in the body"
           (text_of a))
    args

(* Comma-separated values up to [closer]. [const T] is two elements without a
   comma, for [Ptr(const u8)]: const is a reserved word in a type and never a
   value. *)
and items p closer open_loc ~what =
  let opener = if closer = RB then '[' else '(' in
  let rec go acc =
    let t = peek p in
    if t.tok = closer then (ignore (advance p); List.rev acc)
    else if t.tok = EOF then unclosed p opener open_loc
    else
      match t.tok, peek_at p 1 with
      | NAME "const", n when n.sp && starts_value n.tok ->
        ignore (advance p);
        go (sym t.loc "const" :: acc)
      | _ ->
        let e, _ = expr p in
        (match (peek p).tok with
         | COMMA -> ignore (advance p); go (e :: acc)
         | tk when tk = closer -> ignore (advance p); List.rev (e :: acc)
         | EOF -> unclosed p opener open_loc
         | _ ->
           let n = peek p in
           if starts_value n.tok && n.sp && not (negative_literal n.tok)
                   && n.loc.Loc.line > e.loc.Loc.eline then
             (* Most often the bracket was never closed: the next statement
                has been read as one more argument. *)
             failk "missing-comma" n.loc
               "%s on a new line follows %s with no comma between them. If the \
                %c on line %d was meant to close before this line, close it; \
                otherwise separate %s with commas"
               (show n.tok) (text_of e) opener open_loc.Loc.line what
           else if starts_value n.tok && n.sp && not (negative_literal n.tok) then
             failk "missing-comma" n.loc
               "%s follows %s with no comma between them. Separate %s with \
                commas: f(a, b)"
               (show n.tok) (text_of e) what
           else stray p ~after:(text_of e))
  in
  go []

(* An index's values, [grid[r c]] or [grid[r + 1, c]]: separated as a
   vector's elements are, by commas or, between single values only, by
   spaces. The whole list is read before a mistake is named, so the fix can
   be the index as written, commas put in. [head] is the text of what is
   indexed. *)
and index_items p open_loc ~head =
  let rec go acc =
    let t = peek p in
    match t.tok with
    | RB -> ignore (advance p); List.rev acc
    | EOF -> unclosed p '[' open_loc
    | _ ->
      let e, lvl = expr p in
      (* The element as written, parentheses and all. *)
      let src = text_of (Form.make (Form.Sym "") (span p t.loc)) in
      let n = peek p in
      match n.tok with
      | COMMA -> ignore (advance p); go ((e, src, lvl, t.loc, Some n.loc) :: acc)
      | RB -> ignore (advance p); List.rev ((e, src, lvl, t.loc, None) :: acc)
      | EOF -> unclosed p '[' open_loc
      (* [grid[i -1]]: most likely [i - 1] with its minus glued. *)
      | (ATOM _ | NEG) when n.sp && (negative_literal n.tok || n.tok = NEG) ->
        let x, _ = unary p in
        let digits =
          let s = text_of x in String.sub s 1 (String.length s - 1)
        in
        failk "glued-minus" n.loc
          "%s is read as the value %s, right after %s with nothing between \
           the minus and it. To subtract, space the minus: %s[%s - %s]. For \
           two indices, separate them with a comma: %s[%s, %s]"
          (text_of x) (text_of x) src head src digits head src (text_of x)
      | tk when starts_value tk && n.sp -> go ((e, src, lvl, t.loc, None) :: acc)
      | _ -> stray p ~after:(text_of e)
  in
  let xs = go [] in
  let commas = List.exists (fun (_, _, _, _, c) -> c <> None) xs in
  let spaces =
    List.exists (fun (_, _, _, _, c) -> c = None) (match List.rev xs with _ :: r -> r | [] -> [])
  in
  let with_commas () =
    Printf.sprintf "%s[%s]" head
      (String.concat ", " (List.map (fun (_, s, _, _, _) -> s) xs))
  in
  if commas && spaces then begin
    let at = match List.find_opt (fun (_, _, _, _, c) -> c <> None) xs with
      | Some (_, _, _, _, Some l) -> l | _ -> open_loc
    in
    failk "mixed-separators" at
      "these indices are separated some with commas and some with only \
       spaces. Use one: %s%s"
      (with_commas ())
      (if List.for_all (fun (_, _, l, _, _) -> l >= 11) xs then
         Printf.sprintf " or %s[%s]" head
           (String.concat " " (List.map (fun (_, s, _, _, _) -> s) xs))
       else "")
  end;
  (match List.find_opt (fun (_, _, l, _, _) -> l < 11) xs with
   | Some (_, src, _, at, _) when spaces ->
     failk "separate-elements" at
       "%s has an operator in it and sits among indices separated by spaces, \
        where only single values are. Separate the indices with commas: %s"
       src (with_commas ())
   | _ -> ());
  List.map (fun (e, _, _, _, _) -> e) xs

(* [[a b c]] or [[a, b + 1]]: whitespace separates only single terms. *)
and vec_items p open_loc =
  (* One separator per bracket: [1 2, 3] mixes them, and which elements the
     comma was meant to part is a guess. *)
  let commas = ref false and spaces = ref false in
  let mixed at =
    failk "mixed-separators" at
      "this bracket separates some elements with commas and some with only \
       spaces. Use one: [1, 2, 3] or [1 2 3]"
  in
  let rec go acc prev_ws =
    let t = peek p in
    match t.tok with
    | RB -> ignore (advance p); List.rev acc
    | EOF -> unclosed p '[' open_loc
    | _ ->
      let e, lvl = expr p in
      if lvl < 11 && prev_ws then refuse_ws t.loc e;
      (match (peek p).tok with
       | COMMA ->
         if !spaces then mixed (peek p).loc;
         commas := true;
         ignore (advance p); go (e :: acc) false
       | RB -> ignore (advance p); List.rev (e :: acc)
       | EOF -> unclosed p '[' open_loc
       | tk when starts_value tk && (peek p).sp ->
         if lvl < 11 then refuse_ws t.loc e;
         if !commas then mixed (peek p).loc;
         spaces := true;
         go (e :: acc) true
       | _ -> stray p ~after:(text_of e))
  in
  go [] false

(* Braces pair a key with a value, so a value may be any expression; after
   one that has an operator in it, the next entry needs a comma. *)
and map_items p open_loc =
  let rec go acc =
    let t = peek p in
    match t.tok with
    | RC -> ignore (advance p); List.rev acc
    | EOF -> unclosed p '{' open_loc
    | _ ->
      let e, lvl = expr p in
      (match (peek p).tok with
       | COMMA -> ignore (advance p); go (e :: acc)
       | RC -> ignore (advance p); List.rev (e :: acc)
       | EOF -> unclosed p '{' open_loc
       (* [P{x = 1}] or [P{x: 1}]: another language's field syntax. *)
       | (NAME "=" | COLON) as tk
         when (match e.v with Form.Sym n -> n <> "" && n.[0] <> '.' | _ -> false) ->
         let n = text_of e in
         failk "brace-field" (peek p).loc
           "a field in braces is written {.%s value}: a dot before the name, \
            and no %s between it and the value"
           n (if tk = COLON then "colon" else "= sign")
       | tk when starts_value tk && (peek p).sp ->
         if lvl < 11 then refuse_ws ~brace:true t.loc e;
         go (e :: acc)
       | _ -> stray p ~after:(text_of e))
  in
  go []


(* A type after [:] or [->]: a postfix term, plus the arrow of a function
   type, [Fn(A, B) -> R], which reads as [(Fn [A B] R)]. *)
let rec ty p : Form.t =
  let l0 = (peek p).loc in
  let was = !in_type in
  in_type := true;
  let f, _ = Fun.protect ~finally:(fun () -> in_type := was) (fun () -> postfix p) in
  match f.v, (peek p).tok with
    | Form.List (({ v = Form.Sym ("Fn" | "CFn"); _ } as h) :: args), NAME "->"
      when (last p).tok = RP ->
      ignore (advance p);
      let r = ty p in
      mk p l0 (Form.List [ h; Form.make (Form.Vec args) h.loc; r ])
    | _ -> f

(* ── Statements ────────────────────────────────────────────────────── *)

(* The let-statements this reader built, so that a [let] whose whole body is
   another one merges into one binding vector (spec §2), and a [let] written
   as a call does not. *)
type st = { p : p; mutable lets : Form.t list }

(* Whether the code line before [t] is a one-line [if c then a] with no
   else: an else under it reads as written for that if, and is not. *)
let one_line_if_above p (t : token) =
  let layout = function NEWLINE | INDENT | DEDENT -> true | _ -> false in
  let rec prev j =
    if j < 0 then None
    else
      let u = p.toks.(j) in
      if u.loc.Loc.line < t.loc.Loc.line && not (layout u.tok) then Some u.loc.Loc.line
      else prev (j - 1)
  in
  match prev (p.i - 1) with
  | None -> false
  | Some l ->
    let rec line j acc =
      if j < 0 || p.toks.(j).loc.Loc.line < l then acc
      else line (j - 1) (if layout p.toks.(j).tok || p.toks.(j).loc.Loc.line > l then acc
                         else p.toks.(j).tok :: acc)
    in
    (match line (p.i - 1) [] with
     | NAME "if" :: rest -> List.mem (NAME "then") rest && not (List.mem (NAME "else") rest)
     | _ -> false)

(* Whether the code line before [t] is [else if c then a]: that else took
   the one-line if as its value, and an else under it has no if left. *)
let else_if_above p (t : token) =
  let layout = function NEWLINE | INDENT | DEDENT -> true | _ -> false in
  let rec prev j =
    if j < 0 then None
    else
      let u = p.toks.(j) in
      if u.loc.Loc.line < t.loc.Loc.line && not (layout u.tok) then Some u.loc.Loc.line
      else prev (j - 1)
  in
  match prev (p.i - 1) with
  | None -> false
  | Some l ->
    let rec first j =
      if j <= 0 || p.toks.(j - 1).loc.Loc.line < l then j else first (j - 1)
    in
    let j = first (p.i - 1) in
    let j = if layout p.toks.(j).tok then j + 1 else j in
    j + 1 < Array.length p.toks
    && p.toks.(j).tok = NAME "else" && p.toks.(j + 1).tok = NAME "if"

(* A block of several lines is a [do] spanning its lines, from the first
   statement to the end of the last — not from the header above it, which is
   another form's. *)
let blk (s : st) l (ss : Form.t list) =
  match ss with
  | [ x ] -> x
  | (first : Form.t) :: _ -> mk s.p first.loc (Form.List (sym first.loc "do" :: ss))
  | [] -> mk s.p l (Form.List [ sym l "do" ])

(* The word at the head of the line is a variable being assigned, [data = 3]
   or [on += 1], whatever else it could start. *)
let assigns p =
  let n = peek_at p 1 in
  n.sp && (match n.tok with NAME x -> x = "=" || List.mem_assoc x assign_ops | _ -> false)

let header_follow p s =
  let n = peek_at p 1 in
  (not (assigns p)) &&
  let plain_name = function
    | NAME x -> not (is_op_word x || x = "=" || List.mem_assoc x assign_ops)
    | _ -> false
  in
  match s with
  | "fn" | "fn-" | "def" | "once" | "const" | "struct" | "union" | "data"
  | "enum" | "import" ->
    n.sp && plain_name n.tok
  | "if" | "when" | "while" | "until" | "match" | "let" | "for" ->
    n.sp && starts_value n.tok
    && (match n.tok with
        | NAME x when x = "=" || List.mem_assoc x assign_ops -> false
        | NAME x when is_binop x ->
          let a = peek_at p 2 in
          a.tok = LP && not a.sp
        | _ -> true)
  (* [macro name(...)]: the name and its glued parenthesis. *)
  | "macro" ->
    n.sp && plain_name n.tok
    && (let a = peek_at p 2 in a.tok = LP && not a.sp)
  (* [class Lambda(...)] or [class Lambda] over its slot lines. *)
  | "class" -> n.sp && plain_name n.tok
  (* [generic describe(v)], [multi kind(v)], [method describe(f: C)]: the
     name and its glued parenthesis. *)
  | "generic" | "multi" | "method" ->
    n.sp && plain_name n.tok
    && (let a = peek_at p 2 in a.tok = LP && not a.sp)
  (* [type Row = Vec(i32)]: a name and its [=]. *)
  | "type" -> n.sp && plain_name n.tok && (peek_at p 2).tok = NAME "="
  | "return" -> n.tok = NEWLINE || (n.sp && starts_value n.tok)
  | "break" | "continue" ->
    n.tok = NEWLINE || (n.sp && (match n.tok with KW _ -> true | _ -> false))
  | "defer" ->
    (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok)
  | "handler-case" | "handler-bind" | "restart-case" ->
    n.tok = NEWLINE || (n.sp && starts_value n.tok)
  | "quote" ->
    (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok)
  | _ -> false

let name_tok p ~what =
  let t = peek p in
  match t.tok with
  | NAME s when not (String.length s > 0 && s.[0] = '.') ->
    ignore (advance p);
    check_name t s;
    sym t.loc s
  | tk -> failk "expected-name" (where_ p) "expected %s here, and found %s" what (show tk)

let glued_lp p ~what =
  let t = peek p in
  if t.tok = LP && not t.sp then advance p
  else failk "expected" (where_ p) "expected %s here, and found %s" what (show t.tok)

(* [(a: i32, b)] as name/type pairs, [dyn] written out for the untyped: the
   reader never leaves a vector for [Check.pair_params] to guess at. *)
let params p (lp : token) =
  let rec go acc =
    let t = peek p in
    match t.tok with
    | RP -> ignore (advance p); List.rev acc
    | EOF -> unclosed p '(' lp.loc
    | _ ->
      (match t.tok with
       | NAME "&" ->
         failk "rest-parameter" t.loc
           "a function's parameters are a fixed list of names, each with an \
            optional : Type, and & (a rest parameter) is not one. Take the rest \
            as one parameter, xs: [T]"
       | _ -> ());
      let n = name_tok p ~what:"a parameter's name" in
      let typed = (peek p).tok = COLON in
      let tyf =
        match (peek p).tok with
        | COLON -> ignore (advance p); ty p
        | _ -> sym n.loc "dyn"
      in
      (match (peek p).tok with
       | COMMA -> ignore (advance p)
       | RP -> ()
       | _ -> stray p ~after:(text_of (if typed then tyf else n)));
      go (tyf :: n :: acc)
  in
  go []

(* [(a, b: T)] as each name and its type when one is written. *)
let named_params p (lp : token) =
  let rec go acc =
    let t = peek p in
    match t.tok with
    | RP -> ignore (advance p); List.rev acc
    | EOF -> unclosed p '(' lp.loc
    | _ ->
      let n = name_tok p ~what:"a parameter's name" in
      let tyf =
        match (peek p).tok with
        | COLON -> ignore (advance p); Some (ty p)
        | _ -> None
      in
      (match (peek p).tok with
       | COMMA -> ignore (advance p)
       | RP -> ()
       | _ -> stray p ~after:(text_of (match tyf with Some t -> t | None -> n)));
      go ((n, tyf) :: acc)
  in
  go []

(* [fn(a: C, b) -> R => body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the
   paren [fn] takes its parameters' types from where it is written, and [the]
   is the form that says what a value is, as in [let x: T = v]. An untyped
   parameter is dyn, as in a definition, and the return type is required. *)
let () = typed_fn_expr := fun p ->
  let t = advance p in
  let lp = advance p in
  let ps = params p lp in
  let rec split = function
    | n :: ty :: rest -> let ns, ts = split rest in (n :: ns, ty :: ts)
    | _ -> ([], [])
  in
  let names, tys = split ps in
  let params_text () =
    String.concat ", "
      (List.map2 (fun n (ty : Form.t) ->
           if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
          names tys)
  in
  let r =
    match (peek p).tok with
    | NAME "->" -> ignore (advance p); ty p
    | _ ->
      failk "lambda-return" (where_ p)
        "a lambda that states its parameters' types states its return type \
         too: fn(%s) -> R => value"
        (params_text ())
  in
  let header () = "fn(" ^ params_text () ^ ") -> " ^ text_of r in
  let fty = mk p lp.loc (Form.List [ sym t.loc "Fn"; Form.make (Form.Vec tys) lp.loc; r ]) in
  let vec = Form.make (Form.Vec names) lp.loc in
  let wrap body =
    mk p t.loc (Form.List [ sym t.loc "the"; fty;
                            mk p t.loc (Form.List (sym t.loc "fn" :: vec :: body)) ])
  in
  match (peek p).tok with
  | NAME "=>" ->
    ignore (advance p);
    let body = lambda_body p ~header:(header ()) in
    (wrap body, 0)
  | NAME "=" -> lambda_equals p (header ())
  | NAME w when glued_arrow w -> lambda_glued (peek p) (header ()) w
  | NEWLINE when (peek_at p 1).tok = INDENT -> lambda_arrow (peek_at p 2).loc (header ())
  (* Inside brackets a line break is no token: the next line's first token
     is what follows. *)
  | tk when (peek p).loc.Loc.line > (last p).loc.Loc.eline && tk <> EOF ->
    lambda_arrow (peek p).loc (header ())
  | _ ->
    failk "lambda-body" (where_ p)
      "a lambda's body follows => on its line, or is the block under it: \
       %s => value" (header ())

let rec stmts (s : st) : Form.t list =
  let p = s.p in
  match (peek p).tok with
  | DEDENT -> ignore (advance p); []
  | EOF -> []
  | NAME "let" when header_follow p "let" -> let_stmt s
  | _ ->
    let f = stmt s in
    f :: stmts s

and block (s : st) ~after : Form.t list =
  let p = s.p in
  match (peek p).tok with
  | INDENT -> ignore (advance p); stmts s
  | _ ->
    failk "expected-block" (where_ p)
      "%s takes an indented block on the lines under it, and the next line is \
       not indented"
      after

(* The rest of a line read as a value, through its end: [= v], or [=] and an
   indented block that reduces to one form, or a lambda with a block body. *)
and value_line ?(block_ok = false) (s : st) ~after : Form.t =
  let p = s.p in
  let l0 = where_ p in
  if (peek p).tok = NEWLINE && (peek_at p 1).tok = INDENT then begin
    ignore (advance p);
    blk s l0 (block s ~after)
  end
  else
    match (peek p).tok with
    (* [let r = match a] with its arms under it, and [let r = if c] with its
       branches: a header read as the value, block and all. *)
    | NAME (("match" | "handler-case" | "handler-bind" | "restart-case") as w)
      when header_follow p w ->
      header s w
    | NAME (("if" | "when") as w) when header_follow p w && not (then_on_line p) ->
      header s w
    | _ ->
    let e, _ = expr p in
    match (peek p).tok with
    (* [let v = with-foo(a):] and its block: the call takes the block, as it
       would on a line of its own. *)
    | COLON when (match e.v, (last p).tok with
        | Form.List (_ :: _), RP | Form.Sym _, NAME _ -> true
        | _ -> false) ->
      ignore (advance p);
      (match (peek p).tok with
       | NEWLINE -> ignore (advance p)
       | _ -> stray p ~after:":");
      let body = block s ~after:(text_of e ^ ":") in
      (match e.v with
       | Form.List items -> mk p e.loc (Form.List (items @ body))
       | _ -> mk p e.loc (Form.List (e :: body)))
    | COMMA ->
      let c = (peek p).loc in
      (* On a let's line, the fix is the let's group: the rest of the line
         under the first name. *)
      let group =
        let file, lines = !source in
        if c.Loc.file <> file || c.Loc.line > Array.length lines then None
        else
          let line = lines.(c.Loc.line - 1) in
          let head = String.trim (String.sub line 0 (c.Loc.col - 1)) in
          let rest = String.trim (String.sub line c.Loc.col (String.length line - c.Loc.col)) in
          if String.length head > 4 && String.sub head 0 4 = "let " && rest <> "" then
            Some (Printf.sprintf ":\n\n    %s\n        %s" head rest)
          else None
      in
      failk "one-binding" c
        "%s is followed by a comma, and one line binds one name. Put each \
         binding on its own line%s"
        (text_of e)
        (match group with
         | Some g -> ", the ones after the first under its name" ^ g
         | None -> ", one after the other")
    | _ -> lambda_block ~block_ok s e ~after:(text_of e)

(* Whether this line has a [then] at depth zero: a one-line if. *)
and then_on_line p =
  let rec go k depth =
    let t = peek_at p k in
    match t.tok with
    | NEWLINE | EOF -> false
    | NAME "then" when depth = 0 -> true
    | LP | LB | LC -> go (k + 1) (depth + 1)
    | RP | RB | RC -> go (k + 1) (max 0 (depth - 1))
    | _ -> go (k + 1) depth
  in
  go 1 0

(* The end of a statement's line, which a lambda's block may already have
   taken. *)
and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after =
  let p = s.p in
  if block_ok && p.i <> p.closed && (peek p).tok = NEWLINE then ignore (advance p)
  else expect_eol p ~after;
  e

(* One binding of a let, [x = v], [x: T = v] or [{a .x} = p], through the
   end of its line (and the block its value takes). *)
and binding (s : st) : Form.t * Form.t =
  let p = s.p in
  let target, _ = unary p in
  (* [let x: T = v] is [(let [x (the T v)])]: a let binding has no type slot
     of its own, and [the] is the form that says what a value is. *)
  let annot =
    match (peek p).tok with
    | COLON -> ignore (advance p); Some (ty p)
    | _ -> None
  in
  (match (peek p).tok with
   | NAME "=" -> ignore (advance p)
   | _ ->
     failk "let-equals" (where_ p)
       "a let is let name = value, and %s is not followed by =" (text_of target));
  let v = value_line ~block_ok:true s ~after:("let " ^ text_of target) in
  let v =
    match annot with
    | Some tyf ->
      Form.make (Form.List [ sym tyf.loc "the"; tyf; v ]) (span p tyf.loc)
    | None -> v
  in
  (target, v)

(* The lines indented under a let, each one more binding of it: [let a = 1]
   and under it [b = a + 1], lined up with [a]. Anything else there is
   refused; [first] is the let's first target, for the message. *)
and binding_lines : 'a. ?global:bool -> st -> first:Form.t -> name_col:int -> one:(unit -> 'a) -> 'a list =
  fun ?(global = false) s ~first ~name_col ~one ->
  let p = s.p in
  if (peek p).tok <> INDENT then []
  else begin
    ignore (advance p);
    let misaligned (t : token) =
      let_misaligned t.loc ~let_line:first.loc.Loc.line ~name:(text_of first)
        ~name_col
    in
    (* [block] is the binding before this line when its value ended in a
       block still open at its end — a trailing [fn(x) =>], [match], [if],
       [x =] or [f():] — which ends the let's bindings. A block lambda whose
       brackets close after its block does not. *)
    let rec go ?block acc =
      match (peek p).tok with
      | DEDENT -> ignore (advance p); List.rev acc
      | EOF -> List.rev acc
      | INDENT when binding_shaped p.toks (p.i + 1) -> misaligned (peek_at p 1)
      | INDENT -> ignore (advance p); not_binding ()
      | _ when binding_line ~global p ->
        if (peek p).loc.Loc.col <> name_col then misaligned (peek p);
        (match block with
         | Some name -> let_after_block (peek p).loc ~let_line:first.loc.Loc.line ~name
         | None -> ());
        let t0 = peek p in
        let x = one () in
        (* The last token the value took, past its line's end. *)
        let rec last_real k =
          if k > 0 && p.toks.(k).tok = NEWLINE then last_real (k - 1) else k
        in
        let open_block = p.toks.(last_real (p.i - 1)).tok = DEDENT in
        go ?block:(if open_block then Some (text_of_tok t0) else None) (x :: acc)
      | _ -> not_binding ()
    and not_binding () =
      failk "let-block" (where_ p)
        "this line is indented under let %s, and the only lines that go \
         there are more bindings of the let, lined up with its first name:\n\n\
        \    let a = 1\n        b = a + 1\n\n\
         A let's names last to the end of the block the let is in, so any \
         other line after it goes at the let's column"
        (text_of first)
    in
    go []
  end

(* Whether the line at point is a binding: a name, a [[...]] or [{...}]
   pattern, or an operator word in parentheses, [(not) = 3], then [=] or
   [: T =]. [x += 1] and [f(x)] are not. A [global]'s line may be [x: T]
   alone, as a top-level let's may. *)
and binding_line ?(global = false) p =
  (* An [=] at the line's own depth, from token [k] on. *)
  let rec eq k depth =
    match (peek_at p k).tok with
    | EOF | NEWLINE | INDENT | DEDENT -> false
    | NAME "=" when depth = 0 -> true
    | LP | LB | LC -> eq (k + 1) (depth + 1)
    | RP | RB | RC -> eq (k + 1) (depth - 1)
    | _ -> eq (k + 1) depth
  in
  match (peek p).tok with
  | NAME s when s <> "" && s.[0] <> '.' && not (is_op_word s) ->
    (match (peek_at p 1).tok with
     | NAME "=" -> (peek_at p 1).sp
     | COLON -> global || eq 2 0
     | _ -> false)
  (* [~g = a] in a template. *)
  | UNQ -> eq 1 0
  | LB | LC | LP ->
    let rec close k depth =
      match (peek_at p k).tok with
      | EOF | NEWLINE -> false
      | LP | LB | LC -> close (k + 1) (depth + 1)
      | RP | RB | RC when depth = 1 -> (peek_at p (k + 1)).tok = NAME "="
      | RP | RB | RC -> close (k + 1) (depth - 1)
      | _ -> close (k + 1) depth
    in
    close 0 0
  | _ -> false

and let_stmt (s : st) : Form.t list =
  let p = s.p in
  let t = advance p in
  let_gap_tab t (peek p);
  let name_col = (peek p).loc.Loc.col in
  let (target, v) =
    let_values := (name_col, text_of_tok (peek p), t.loc.Loc.line) :: !let_values;
    Fun.protect ~finally:(fun () -> let_values := List.tl !let_values)
      (fun () -> binding s)
  in
  let more = binding_lines s ~first:target ~name_col ~one:(fun () -> binding s) in
  let own = List.concat_map (fun (a, b) -> [ a; b ]) ((target, v) :: more) in
  let make bindings body =
    let f =
      mk p t.loc
        (Form.List
           (sym t.loc "let" :: Form.make (Form.Vec bindings) (span_of_list target.loc bindings)
            :: body))
    in
    s.lets <- f :: s.lets;
    f
  in
  let merged body =
    match body with
    | [ ({ Form.v = Form.List (_ :: { v = Form.Vec bs; _ } :: body); _ } as inner) ]
      when List.memq inner s.lets ->
      make (own @ bs) body
    | _ -> make own body
  in
  [ merged (stmts s) ]

and stmt (s : st) : Form.t =
  let p = s.p in
  let t = peek p in
  match t.tok with
  | NAME w when header_follow p w -> header s w
  | NAME _ when assigns p -> expr_stmt s
  | NAME (("else" | "elif") as w) when else_if_above p t ->
    failk "orphan-else" t.loc
      "the else above took the one-line if after it as its value, so this %s \
       has no if to belong to. Write that line as elif:\n\n\
      \    if a then x\n    elif b then y\n    else z"
      w
  | NAME (("else" | "elif") as w) when one_line_if_above p t ->
    failk "orphan-else" t.loc
      "this %s is not at the column of the one-line if above it. An else or \
       elif that continues a one-line if goes at the if's column:\n\n\
      \    if c then a\n    else b"
      w
  | NAME (("else" | "elif") as w) ->
    failk "orphan-else" t.loc
      "%s is not under an if at this column. It goes at the same column as \
       the if it belongs to, right after that if's block"
      w
  | _ -> expr_stmt s

and expr_stmt (s : st) : Form.t =
  let p = s.p in
  let i0 = p.i in
  let t0 = peek p in
  let e, _ = expr p in
  match (peek p).tok with
  | NAME "=" ->
    no_place e;
    let eq = advance p in
    let v = value_line s ~after:(text_of e ^ " =") in
    mk p t0.loc (Form.List [ sym eq.loc "set"; e; v ])
  | NAME op when List.mem_assoc op assign_ops ->
    no_place e;
    let eq = advance p in
    let v = value_line s ~after:(text_of e ^ " " ^ op) in
    let o = List.assoc op assign_ops in
    mk p t0.loc (compound eq.loc o e v (span p e.loc))
  | COLON ->
    let before = (last p).tok in
    let c = advance p in
    (* [f(x):] and, with no arguments, [comment:] — a bare name — open a
       block; anything else has no call to hang it on. *)
    (match e.v, before with
     | Form.List (_ :: _), RP -> ()
     | Form.Sym _, NAME _ -> ()
     | _ ->
       failk "colon-block" c.loc
         "a trailing colon gives a call an indented block, and %s is not a \
          call. Write it as one, as in f(x): or comment:"
         (text_of e));
    (match (peek p).tok with
     | NEWLINE -> ignore (advance p)
     | _ -> stray p ~after:":");
    let body = block s ~after:(text_of e ^ ":") in
    (match e.v with
     | Form.List items -> mk p t0.loc (Form.List (items @ body))
     | _ -> mk p t0.loc (Form.List (e :: body)))
  | _ ->
    (* [()] alone on a line is the empty statement, spec §2 "Unit". *)
    let e =
      if p.i - i0 = 2 && t0.tok = LP && e.v = Form.List [] then
        Form.make (Form.List [ sym t0.loc "do" ]) e.loc
      else e
    in
    lambda_block s e ~after:(text_of e)

and header (s : st) w : Form.t =
  let p = s.p in
  let t = advance p in
  let l0 = t.loc in
  let form items = mk p l0 (Form.List (sym l0 w :: items)) in
  let named head items = mk p l0 (Form.List (sym l0 head :: items)) in
  match w with
  | "fn" | "fn-" ->
    let name = name_tok p ~what:"the function's name" in
    let lp = glued_lp p ~what:"the parameters, in parentheses glued to the name" in
    let ps = params p lp in
    let rp = last p in
    (* No arrow reads the return type off the body: the paren syntax's [_]
       (spec-syntax.md §3.5). *)
    let ret, ret_text =
      match (peek p).tok with
      | NAME "->" -> ignore (advance p); let r = ty p in (r, text_of r)
      | _ -> (sym rp.loc "_", ")")
    in
    let where_clause =
      match (peek p).tok with
      | NAME "where" ->
        let wt = advance p in
        let rec preds acc =
          let e, _ = expr p in
          (* [and] is how a condition joins tests, so it is what gets written
             for several predicates; the clause separates them with commas. *)
          (match e.Form.v with
           | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) ->
             let spell (q : Form.t) =
               match q.Form.v with
               | Form.List [ { Form.v = Form.Sym n; _ };
                             { Form.v = Form.Sym v; _ } ] ->
                 Printf.sprintf "%s(%s)" n v
               | _ -> Form.to_string q
             in
             failk "where-and" e.Form.loc
               "a where clause separates its predicates with commas, not and \
                — write where %s"
               (String.concat ", " (List.map spell ps))
           | _ -> ());
          match (peek p).tok with
          | COMMA -> ignore (advance p); preds (e :: acc)
          | _ -> List.rev (e :: acc)
        in
        let es = preds [] in
        let v =
          match es with
          | [ e ] -> e
          | _ -> Form.make (Form.Vec es) (span p wt.loc)
        in
        [ mk p wt.loc (Form.Map [ Form.make (Form.Kw "where") wt.loc; v ]) ]
      | _ -> []
    in
    let body =
      match (peek p).tok with
      | NAME "=" ->
        ignore (advance p);
        if (peek p).tok = NEWLINE && (peek_at p 1).tok = INDENT then begin
          ignore (advance p);
          block s ~after:"fn"
        end
        else begin
          let i0 = p.i and t0 = peek p in
          let v = value_line s ~after:"=" in
          let bare =
            t0.tok = LP && p.toks.(i0 + 1).tok = RP && v.v = Form.List []
            && (match p.toks.(i0 + 2).tok with NEWLINE | EOF | DEDENT -> true | _ -> false)
          in
          [ (if bare then Form.make (Form.List [ sym t0.loc "do" ]) v.loc else v) ]
        end
      | NEWLINE ->
        ignore (advance p);
        if (peek p).tok = INDENT then block s ~after:"fn" else []
      | _ -> stray p ~after:ret_text
    in
    named (if w = "fn" then "defn" else "defn-")
      (name :: Form.make (Form.Vec ps) lp.loc :: ret :: (where_clause @ body))
  | "def" | "once" | "const" -> def_form s w t l0
  | "struct" | "union" ->
    let name = name_tok p ~what:"the type's name" in
    (* [struct Pt(x: i32, y: i32)]: the fields on the header's line, as a
       data case writes them, with no block under it. *)
    let inline =
      match (peek p).tok with
      | LP when not (peek p).sp -> let lp = advance p in Some (params p lp)
      | _ -> None
    in
    (* [struct DiskFull :parent IoError]: a condition's parent, before the
       fields as in the paren form. *)
    let parent =
      match (peek p).tok with
      | KW "parent" when w = "struct" ->
        let kt = advance p in
        let pt = ty p in
        Some (Form.make (Form.Kw "parent") kt.loc, pt)
      | _ -> None
    in
    let after =
      match parent, inline with
      | Some (_, pt), _ -> text_of pt
      | None, Some _ -> ")"
      | None, None -> w ^ " " ^ text_of name
    in
    let fields =
      match inline with
      | Some fs -> expect_eol p ~after; fs
      | None ->
      expect_eol_block p ~after;
      lines s (fun () ->
        let f = name_tok p ~what:"a field's name" in
        let tf =
          match (peek p).tok with
          | COLON -> ignore (advance p); ty p
          | _ -> sym f.loc "dyn"
        in
        expect_eol p ~after:(text_of tf);
        [ f; tf ])
    in
    let fv = Form.make (Form.Vec fields) (span p name.loc) in
    (* No field lines under a parent is the category form, which has no
       field vector. *)
    named (if w = "struct" then "defstruct" else "defunion")
      (match parent with
       | None -> [ name; fv ]
       | Some (k, pt) -> name :: k :: pt :: (if fields = [] then [] else [ fv ]))
  | "class" ->
    let name = name_tok p ~what:"the class's name" in
    let ps =
      match (peek p).tok with
      | LP when not (peek p).sp ->
        let lp = advance p in
        let ps = named_params p lp in
        expect_eol p ~after:")";
        ps
      | _ ->
        expect_eol_block p ~after:("class " ^ text_of name);
        let acc = ref [] in
        ignore
          (lines s (fun () ->
             let f = name_tok p ~what:"a slot's name" in
             let t =
               match (peek p).tok with
               | COLON -> ignore (advance p); Some (ty p)
               | _ -> None
             in
             expect_eol p ~after:(match t with Some t -> text_of t | None -> text_of f);
             acc := (f, t) :: !acc;
             []));
        List.rev !acc
    in
    (* Each slot's name, and its type after it when one is written: the
       paren form's [(defclass c [a b n i32])], whose untyped slots are dyn. *)
    let slots =
      List.concat_map (fun (n, t) -> match t with Some t -> [ n; t ] | None -> [ n ]) ps
    in
    named "defclass" [ name; Form.make (Form.Vec slots) (span p name.loc) ]
  | "generic" | "multi" | "method" ->
    let name = name_tok p ~what:(Printf.sprintf "the %s's name" w) in
    let lp = advance p in
    let ps = named_params p lp in
    (* A method's first parameter may name the class it answers for; every
       other parameter of these is dyn, so it takes no type. *)
    let names = String.concat ", " (List.map (fun ((n : Form.t), _) -> text_of n) ps) in
    let first = match ps with (n, _) :: _ -> text_of n | [] -> "v" in
    let first_class = ref None in
    List.iteri
      (fun k ((n : Form.t), t) ->
         match t with
         | Some (tf : Form.t) when k = 0 && w = "method" -> first_class := Some tf
         | Some tf ->
           failk "dyn-parameter" tf.loc
             "every parameter of a %s is dyn, so %s takes no type: write %s %s(%s)%s"
             w (text_of n) w (text_of name)
             (String.concat ", "
                (List.mapi
                   (fun k ((n : Form.t), t) ->
                      match t with
                      | Some t when k = 0 && w = "method" -> text_of n ^ ": " ^ text_of t
                      | _ -> text_of n)
                   ps))
             (if w = "method" then "" else " -> dyn")
         | None -> ())
      ps;
    let pv = Form.make (Form.Vec (List.map fst ps)) (span p lp.loc) in
    let ret () =
      match (peek p).tok with
      | NAME "->" -> ignore (advance p); ty p
      | _ ->
        (* At the end of the header's line, where the arrow goes. *)
        let e = (last p).loc in
        failk "generic-return"
          { e with Loc.line = e.Loc.eline; col = e.Loc.ecol }
          "a %s states the type every method returns: %s %s(%s) -> dyn"
          w w (text_of name) names
    in
    let body ~after ~prev =
      match (peek p).tok with
      | NAME "=" ->
        ignore (advance p);
        [ value_line s ~after:"=" ]
      | NEWLINE ->
        ignore (advance p);
        block s ~after
      | _ -> stray p ~after:prev
    in
    (match w with
     | "generic" ->
       let r = ret () in
       expect_eol p ~after:(text_of r);
       named "defgeneric" [ name; pv; r ]
     | "multi" ->
       let r = ret () in
       named "defmulti"
         (name :: pv :: r :: body ~after:("multi " ^ text_of name ^ "(...)") ~prev:(text_of r))
     | _ ->
       let key =
         match (peek p).tok, !first_class with
         | NAME "when", Some tf ->
           failk "method-key" (peek p).loc
             "this method already answers for %s, its first parameter's type. \
              Write the type or the when, not both"
             (text_of tf)
         | NAME "when", None ->
           ignore (advance p);
           fst (unary p)
         | _, Some tf -> tf
         | _, None ->
           failk "method-key" (where_ p)
             "a method says what it answers for: a class as its first \
              parameter's type, method %s(%s: point), or a value after when, \
              method %s(%s) when :int"
             (text_of name) first (text_of name) names
       in
       named "defmethod"
         (name :: key :: pv
          :: body ~after:("method " ^ text_of name ^ "(...)")
               ~prev:(if !first_class = None then text_of key else ")")))
  | "type" ->
    let name = name_tok p ~what:"the alias's name" in
    expect_name p "=" ~what:"= and the type it names";
    let t = ty p in
    expect_eol p ~after:(text_of t);
    named "defalias" [ name; t ]
  | "macro" ->
    let name = name_tok p ~what:"the macro's name" in
    let lp = glued_lp p ~what:"the parameters, in parentheses glued to the name" in
    let rec go acc =
      let t = peek p in
      match t.tok with
      | RP -> ignore (advance p); List.rev acc
      | EOF -> unclosed p '(' lp.loc
      | _ ->
        let one =
          match t.tok with
          | NAME "&" ->
            ignore (advance p);
            [ name_tok p ~what:"the rest parameter's name after &"; sym t.loc "&" ]
          | LB -> [ fst (primary p) ]
          | _ -> [ name_tok p ~what:"a parameter's name" ]
        in
        (match (peek p).tok with
         | COMMA -> ignore (advance p)
         | RP -> ()
         | _ -> stray p ~after:(text_of (List.hd one)));
        go (one @ acc)
    in
    let ps = go [] in
    let n = List.length ps in
    List.iteri
      (fun k (a : Form.t) ->
         if a.v = Form.Sym "&" && k < n - 2 then begin
           let r = List.nth ps (k + 1) in
           let others = List.filteri (fun j _ -> j <> k && j <> k + 1) ps in
           failk "macro-rest-last" a.loc
             "& %s takes the arguments left over, so it comes last: macro %s(%s)"
             (text_of r) (text_of name)
             (String.concat ", " (List.map text_of others @ [ "& " ^ text_of r ]))
         end)
      ps;
    let pv = Form.make (Form.Vec ps) (span p lp.loc) in
    expect_line_end p ~after:")";
    let body = block s ~after:("macro " ^ text_of name ^ "(...)") in
    named "defmacro" (name :: pv :: body)
  | "data" ->
    let name = name_tok p ~what:"the type's name" in
    expect_eol_block p ~after:("data " ^ text_of name);
    let cases =
      lines s (fun () ->
        let c = name_tok p ~what:"a case's name" in
        let f =
          match (peek p).tok with
          | LP when not (peek p).sp ->
            let lp = advance p in
            let ps = params p lp in
            mk p c.loc (Form.List [ c; Form.make (Form.Vec ps) lp.loc ])
          | _ -> c
        in
        expect_eol p ~after:(text_of f);
        [ f ])
    in
    named "defdata" [ name; Form.make (Form.Vec cases) (span p name.loc) ]
  | "enum" ->
    let name = name_tok p ~what:"the enum's name" in
    expect_eol_block p ~after:("enum " ^ text_of name);
    let members =
      lines s (fun () ->
        let m = name_tok p ~what:"a member's name" in
        match (peek p).tok with
        | NAME "=" ->
          ignore (advance p);
          let v, _ = unary p in
          expect_eol p ~after:(text_of v);
          [ m; v ]
        | _ -> expect_eol p ~after:(text_of m); [ m ])
    in
    named "defenum" [ name; Form.make (Form.Vec members) (span p name.loc) ]
  | "import" ->
    let alias = name_tok p ~what:"the package's alias" in
    let path =
      match (peek p).tok with
      | ATOM (Form.Str _ as v) -> let pt = advance p in Form.make v pt.loc
      | tk ->
        failk "import-path" (where_ p)
          "an import is import alias \"collection:path\", and found %s where \
           the path goes"
          (show tk)
    in
    expect_eol p ~after:(text_of path);
    form [ alias; path ]
  | "if" | "when" ->
    let letp = if w = "if" then if_let_head p else None in
    let c = match letp with Some m -> m | None -> fst (binary p 1) in
    let letp, c =
      match letp with
      | Some _ -> (letp, c)
      | None -> (match as_head p c with Some m when w = "if" -> (Some m, m) | _ -> (None, c))
    in
    (* The elif and else clauses at the if's column, then the whole form.
       [oneline] when the if was [if c then a]: its clauses may then be
       one-line too, [elif c then x] and [else y], or take blocks. *)
    let clauses ~oneline body =
      (match (peek p).tok with
       | NAME ("else" | "elif") when w = "when" && not (assigns p) -> when_else p
       | _ -> ());
      (* The [elif let P = v] heads, as the [[P v]] each stands as. *)
      let elif_lets = ref [] in
      let rec elifs acc =
        match (peek p).tok with
        | NAME "elif" when not (assigns p) ->
          ignore (advance p);
          let c =
            match if_let_head p with
            | Some m -> elif_lets := m :: !elif_lets; m
            | None ->
              let c = fst (binary p 1) in
              (match as_head p c with
               | Some m -> elif_lets := m :: !elif_lets; m
               | None -> c)
          in
          (match (peek p).tok with
           | NAME "then" when oneline ->
             ignore (advance p);
             let x = inline_stmt p in
             expect_eol p ~after:(text_of x);
             elifs ((c, [ x ]) :: acc)
           | NAME "then" ->
             failk "elif-then" (peek p).loc
               "elif takes its block on the indented lines under it, with no \
                then. Put the branch on the next line, indented"
           | _ ->
             expect_line_end p ~after:("elif " ^ text_of c);
             let b = block s ~after:"elif" in
             elifs ((c, b) :: acc))
        | _ -> List.rev acc
      in
      let els_ = elifs [] in
      let else_ =
        match (peek p).tok with
        | NAME "else" when not (assigns p) ->
          let et = advance p in
          (match (peek p).tok with
           | NEWLINE -> ignore (advance p); Some (et.loc, block s ~after:"else")
           | NAME "if" when not oneline ->
             failk "else-if" (where_ p)
               "after an if with a block, another test at this level is \
                written elif c, with its own block"
           (* [else x] on one line, after a one-line if or a block. *)
           | _ ->
             let x = inline_stmt p in
             expect_eol p ~after:(text_of x);
             Some (et.loc, [ x ]))
        | _ -> None
      in
      match els_, else_ with
      | _ when !elif_lets <> [] ->
        (* An [elif let] makes the rest of the chain the else of an if-let:
           each clause nests in the one before it, [if] or [if-let] as its
           head is, and a chain with no else ends in a [when]. *)
        let is_let c = List.memq c !elif_lets || Some c == letp in
        let rec build = function
          | [] -> Option.map (fun (el, e) -> blk s el e) else_
          | ((c : Form.t), b) :: rest ->
            let at = c.Form.loc in
            let f items = Form.make (Form.List items) at in
            let r = build rest in
            Some
              (if is_let c then f (sym at "if-let" :: c :: blk s at b :: Option.to_list r)
               else
                 match r with
                 | None -> f (sym at "when" :: c :: b)
                 | Some r -> f [ sym at "if"; c; blk s at b; r ])
        in
        Option.get (build ((c, body) :: els_))
      | [], None -> named "when" (c :: body)
      | [], Some (el, e) -> named "if" [ c; blk s l0 body; blk s el e ]
      | _ ->
        let pairs =
          List.concat_map (fun (c, b) -> [ c; blk s c.Form.loc b ]) ((c, body) :: els_)
        in
        let tail =
          match else_ with
          | Some (el, e) -> [ Form.make (Form.Kw "else") el; blk s el e ]
          | None -> []
        in
        named "cond" (pairs @ tail)
    in
    if_let_wrap letp @@
    (match (peek p).tok with
     | NAME "then" ->
       ignore (advance p);
       let a = inline_stmt p in
       (match (peek p).tok with
        | NAME ("else" | "elif") when w = "when" -> when_else p
        | NAME "else" ->
          ignore (advance p);
          let b = inline_stmt p in
          let f = named "if" [ c; a; b ] in
          expect_eol p ~after:(text_of f);
          f
        | NAME "elif" ->
          failk "one-line-elif" (peek p).loc
            "a one-line if has then and else and no elif. Chain another if \
             after the else — if a then x else if b then y else z — or write \
             the if over several lines, where elif goes"
        | _ ->
          (* An else or elif indented under the one-line if: it continues
             that if only at the if's own column. *)
          (match (peek p).tok, (peek_at p 1).tok, (peek_at p 2).tok with
           | NEWLINE, INDENT, NAME (("else" | "elif") as w) ->
             failk "else-column" (peek_at p 2).loc
               "this %s is indented deeper than the one-line if it continues. \
                Put it at the if's column:\n\n\
               \    if c then a\n    %s ..."
               w w
           | _ -> ());
          expect_eol p ~after:(text_of (named "when" [ c; a ]));
          (* An else or elif on the next line, at the if's column,
             continues it. *)
          clauses ~oneline:true [ a ])
     | _ ->
       expect_line_end p ~after:("if " ^ text_of c);
       let body = block s ~after:("if " ^ text_of c) in
       clauses ~oneline:false body)
  | "while" | "until" ->
    let label =
      match (peek p).tok, (peek_at p 1).tok with
      | KW k, n when n <> NEWLINE -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ]
      | _ -> []
    in
    let c, _ = expr p in
    (match (if w = "while" then as_head p c else None) with
    (* [while e? as g]: [(while true (if-let [g e] (do body) (break)))]. A
       break or continue in the body is this loop's. *)
    | Some m ->
      expect_line_end p ~after:(w ^ " " ^ text_of c ^ " as ...");
      let body = block s ~after:w in
      let at = c.Form.loc in
      let f items = Form.make (Form.List items) at in
      form (label @ [ sym at "true";
                      f [ sym at "if-let"; m; f (sym at "do" :: body); f [ sym at "break" ] ] ])
    | None ->
      expect_line_end p ~after:(w ^ " " ^ text_of c);
      let body = block s ~after:w in
      form (label @ (c :: body)))
  | "for" ->
    let label =
      match (peek p).tok with
      | KW k -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ]
      | _ -> []
    in
    (* In a macro template the variable may be an unquote, [for ~i in ...]. *)
    let v =
      match (peek p).tok with
      | UNQ -> fst (primary p)
      | _ -> name_tok p ~what:"the loop variable"
    in
    expect_name p "in" ~what:"in, as in for i in range(n)";
    let rt = peek p in
    expect_name p "range" ~what:"range(n), range(a, b) or range(a, b, step)";
    let lp = glued_lp p ~what:"range's bounds in parentheses" in
    let bs = items p RP lp.loc ~what:"bounds" in
    if bs = [] || List.length bs > 3 then
      failk "range-arity" rt.loc
        "range takes one, two or three bounds: range(stop), range(start, stop) \
         or range(start, stop, step)";
    expect_line_end p ~after:"range(...)";
    let body = block s ~after:"for" in
    named "dotimes"
      (label @ (Form.make (Form.Vec (v :: bs)) (span_of_list v.loc bs) :: body))
  | "return" ->
    (match (peek p).tok with
     | NEWLINE -> expect_eol p ~after:"return"; form []
     | _ ->
       let e, _ = expr p in
       expect_eol p ~after:(text_of e);
       form [ e ])
  | "break" | "continue" ->
    (match (peek p).tok with
     | KW k ->
       let kt = advance p in
       expect_eol p ~after:(":" ^ k);
       form [ Form.make (Form.Kw k) kt.loc ]
     | _ -> expect_eol p ~after:w; form [])
  | "defer" ->
    (match (peek p).tok with
     | NEWLINE ->
       ignore (advance p);
       form (block s ~after:"defer")
     | _ ->
       let e = inline_stmt p in
       expect_eol p ~after:(text_of e);
       form [ e ])
  | "match" ->
    let scrut, _ = expr p in
    expect_eol_block p ~after:("match " ^ text_of scrut);
    let arms =
      lines s (fun () ->
        let pat, _ = unary p in
        expect_name p "->" ~what:"-> and the arm's value";
        let body =
          if (peek p).tok = NEWLINE && (peek_at p 1).tok = INDENT then begin
            let nl = advance p in
            blk s nl.loc (block s ~after:"->")
          end
          else begin
            let e = inline_stmt p in
            expect_eol p ~after:(text_of e);
            e
          end
        in
        [ pat; body ])
    in
    form (scrut :: arms)
  | "handler-case" | "handler-bind" ->
    clause_header_end p w;
    let body = block s ~after:w in
    let rec clauses acc =
      match (peek p).tok, (peek_at p 1) with
      | NAME "on", n when n.sp && not (assigns p) ->
        let ot = advance p in
        let head, _ = postfix p in
        let ty, var =
          match head.v with
          | Form.List [ ty; ({ v = Form.Sym _; _ } as var) ] -> (ty, var)
          | _ ->
            failk "on-clause" head.loc
              "a handler clause is on Type(name), naming the condition type \
               and the name it is bound to, as in on FileError(c)"
        in
        clause_end p ("on " ^ text_of ty ^ "(" ^ text_of var ^ ")");
        let b = block s ~after:"on" in
        let c =
          mk p ot.loc
            (Form.List (ty :: Form.make (Form.Vec [ var ]) var.loc :: b))
        in
        clauses (c :: acc)
      | _ -> List.rev acc
    in
    let cs = clauses [] in
    let vec = Form.make (Form.Vec cs) (span p l0) in
    if w = "handler-case" then form [ blk s l0 body; vec ]
    else form (vec :: body)
  | "restart-case" ->
    clause_header_end p w;
    let body = block s ~after:w in
    let rec clauses acc =
      match (peek p).tok, (peek_at p 1) with
      | NAME "restart", n when n.sp && not (assigns p) ->
        ignore (advance p);
        let name = name_tok p ~what:"the restart's name" in
        let lp = glued_lp p ~what:"the restart's parameters in parentheses" in
        let ps = params p lp in
        (* [restart name() "text"]: the report the break loop shows,
           [:report "text"] in the clause. *)
        let report =
          match (peek p).tok with
          | ATOM (Form.Str _ as v) ->
            let st = advance p in
            [ Form.make (Form.Kw "report") st.loc; Form.make v st.loc ]
          | _ -> []
        in
        clause_end p ("restart " ^ text_of name ^ "(...)");
        let b = block s ~after:"restart" in
        let c =
          mk p name.loc (Form.List (name :: Form.make (Form.Vec ps) lp.loc :: (report @ b)))
        in
        clauses (c :: acc)
      | _ -> List.rev acc
    in
    let cs = clauses [] in
    form (blk s l0 body :: cs)
  | "quote" ->
    (* One line, [quote ~x + 1], is the quasiquote of that expression. *)
    (match (peek p).tok with
     | NEWLINE ->
       ignore (advance p);
       let body = block s ~after:"quote" in
       named "quasiquote" [ blk s l0 body ]
     | _ ->
       let e, _ = expr p in
       expect_eol p ~after:(text_of e);
       named "quasiquote" [ e ])
  | _ -> assert false

(* [let x = v] at the top level, [once x = v] or [const x = v], from the
   name on: [t] is the word, and [l0] where the form starts. A top-level let
   leaves the lines indented under it to [read_all], which reads each as one
   more global. *)
and def_form (s : st) w (t : token) l0 : Form.t =
  let p = s.p in
  let named head items = mk p l0 (Form.List (sym l0 head :: items)) in
    (* A top-level [let] is read here too, as [def]: [w] is then "def" and
       [t] the let. *)
    let shown = match t.tok with NAME "let" -> "let" | _ -> w in
    let name = name_tok p ~what:"the name being defined" in
    let tyf =
      match (peek p).tok with
      | COLON -> ignore (advance p); Some (ty p)
      | _ -> None
    in
    let v =
      match (peek p).tok with
      | NAME "=" ->
        ignore (advance p);
        Some (value_line ~block_ok:(shown = "let") s
                ~after:(shown ^ " " ^ text_of name ^ " ="))
      (* [let a: i32] with more globals under it. *)
      | NEWLINE when shown = "let" && tyf <> None && (peek_at p 1).tok = INDENT ->
        ignore (advance p); None
      | _ ->
        expect_eol p ~after:(match tyf with Some f -> text_of f | None -> text_of name);
        None
    in
    let head =
      match w with "def" -> "def" | "once" -> "defonce" | _ -> "defconst"
    in
    if shown = "def" then
      failk "def-is-let" l0
        "a global is written with let, at the file's top level:\n\n    let %s%s%s"
        (text_of name)
        (match tyf, v with
         | Some t, _ -> ": " ^ text_of t
         | None, None -> ": i32"
         | None, Some _ -> "")
        (match v, tyf with
         | Some v, _ -> " = " ^ text_of v
         | None, None -> " = 0"
         | None, Some _ -> "");
    let items =
      match w, tyf, v with
      | "const", None, Some v -> [ name; v ]
      | "const", Some t, Some v -> [ name; t; v ]
      | "const", _, None ->
        failk "const-value" l0
          "a const needs its value: const %s = 3" (text_of name)
      | _, None, Some v -> [ name; sym name.loc "dyn"; v ]
      | _, Some t, None -> [ name; t ]
      | _, Some t, Some v -> [ name; t; v ]
      | _, None, None ->
        failk "def-empty" l0
          "%s %s names neither a type nor a value. Give it one or both: %s %s: \
           i32 = 0"
          shown (text_of name) shown (text_of name)
    in
    named head items

(* handler-case, handler-bind and restart-case take nothing on their own line. *)
and clause_header_end p w =
  match (peek p).tok with
  | NEWLINE -> ignore (advance p)
  | _ ->
    failk "clause-header" (peek p).loc
      "%s takes its body on the indented lines under it, and its %s clauses \
       at its own column after that, each with its block under it:\n\
       %s\n  body\n%s"
      w (if w = "restart-case" then "restart" else "on") w
      (if w = "restart-case" then "restart name()\n  value" else "on Type(c)\n  value")

and clause_end p head =
  match (peek p).tok with
  | NEWLINE -> ignore (advance p)
  | _ ->
    failk "clause-body" (peek p).loc
      "the body of %s goes on the indented lines under it, not on its line. \
       Move it to the next line, indented"
      head

(* The end of a header line whose block must follow. *)
and expect_line_end p ~after =
  if p.i = p.closed then () else
  match (peek p).tok with
  | NEWLINE -> ignore (advance p)
  | _ -> stray p ~after

and expect_eol_block p ~after =
  expect_line_end p ~after

(* An indented run of one-line entries — a struct's fields, a match's arms.
   None at all is allowed for the declarations and is refused later, by the
   form, where it matters. *)
and lines (s : st) (one : unit -> Form.t list) : Form.t list =
  let p = s.p in
  if (peek p).tok <> INDENT then []
  else begin
    ignore (advance p);
    let rec go acc =
      match (peek p).tok with
      | DEDENT -> ignore (advance p); List.rev acc
      | EOF -> List.rev acc
      | _ -> go (List.rev_append (one ()) acc)
    in
    go []
  end

let () = block_of := fun p -> block { p; lets = [] } ~after:"=>"

(* Every [(loop ...)] and [(recur ...)] in [fs], at any depth and inside
   quoted code too, in source order. The indented syntax has neither: its
   loops are [while], [until], [dotimes] and [for]. The printer asks the same
   question before it converts a .flan file. *)
let loop_forms (fs : Form.t list) =
  let out = ref [] in
  let rec walk (f : Form.t) =
    match f.v with
    | Form.List ({ v = Form.Sym ("loop" | "recur"); _ } :: _) ->
      out := f :: !out;
      (match f.v with Form.List l -> List.iter walk l | _ -> ())
    | Form.List l | Form.Vec l | Form.Map l -> List.iter walk l
    | _ -> ()
  in
  List.iter walk fs;
  List.rev !out

let refuse_loops fs =
  match loop_forms fs with
  | [] -> ()
  | (f : Form.t) :: _ ->
    no_loop f.loc (match f.v with Form.List ({ v = Form.Sym w; _ } :: _) -> w | _ -> "loop")

(** All top-level forms in a [.fln] source string. [col] is the column the
    text's top level starts at, 1 for a file. *)
let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
  let snippet = col <> None in
  let col = Option.value col ~default:1 in
  let saved = !source in
  let saved_n = !cmp_n and saved_o = !opt_n in
  cmp_n := 0;
  opt_n := 0;
  (* The quoted text is indexed by the buffer's lines, so a snippet that
     starts on line 40 is padded to start there. *)
  source :=
    (file, Array.of_list (String.split_on_char '\n'
                            (String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
  Fun.protect ~finally:(fun () -> source := saved; cmp_n := saved_n; opt_n := saved_o) (fun () ->
    let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
    let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in
    (* At the top level, a [let] is a global, [(def x dyn v)]: a let there has
       no block to be local to. Not in an expression the editor sends, where
       a let is the statement it is in a body. *)
    let rec top () =
      match (peek s.p).tok with
      | EOF -> []
      | DEDENT -> ignore (advance s.p); []
      | NAME "let" when header_follow s.p "let" ->
        let t = peek s.p in
        let_gap_tab t (peek_at s.p 1);
        let name_col = (peek_at s.p 1).loc.Loc.col in
        let f =
          let_values := (name_col, text_of_tok (peek_at s.p 1), t.loc.Loc.line) :: !let_values;
          Fun.protect ~finally:(fun () -> let_values := List.tl !let_values)
            (fun () -> header s "def")
        in
        (* The lines indented under it are more globals, one each: a global
           is one name, so a pattern there is refused. *)
        let first = match f.v with Form.List (_ :: n :: _) -> n | _ -> f in
        let more =
          binding_lines ~global:true s ~first ~name_col ~one:(fun () ->
            let l = peek s.p in
            (match l.tok with
             | LP ->
               failk "global-pattern" l.loc
                 "a global's name is a plain name, and this line under let %s \
                  names an operator word in parentheses. Give the global \
                  another name"
                 (text_of first)
             | LB | LC ->
               failk "global-pattern" l.loc
                 "a global binds one name, and this line under let %s is a \
                  pattern. Bind the value to a name, and take it apart inside \
                  the function that uses it"
                 (text_of first)
             | _ -> ());
            def_form s "def" t l.loc)
        in
        f :: more @ top ()
      | _ -> let f = stmt s in f :: top ()
    in
    let fs = if global_let then top () else stmts s in
    (match (peek s.p).tok with
     | EOF -> ()
     | tk -> failk "unexpected-token" (where_ s.p) "unexpected %s" (show tk));
    refuse_loops fs;
    fs)

let read_file path =
  let ic = open_in_bin path in
  Fun.protect ~finally:(fun () -> close_in ic) (fun () ->
    let n = in_channel_length ic in
    read_all ~file:path (really_input_string ic n))