(** 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 ~@ *) | NEG (* the - glued to the front of a name *) | 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 -> "~@" | NEG -> "-" | 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 unary minus at 8; neither is binary. *) let binops = [ ("or", 1); ("and", 2); ("==", 4); ("!=", 4); ("<", 4); ("<=", 4); (">", 4); (">=", 4); ("<<", 5); (">>", 5); ("+", 6); ("-", 6); ("*", 7); ("/", 7); ("%", 7) ] let binop_level s = List.assoc_opt s binops let is_binop s = binop_level s <> None (* [==] is Flan's [=]; every other operator is its own name. *) let op_sym = function "==" -> "=" | 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 [-] 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 (* ── 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 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); 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 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 ────────────────────────────────────────────────────────── *) 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 "a comma follows the block of the lambda on line %d. 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)" 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 | 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 (); 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 | 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)]. *) let stray p ~after = 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 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 -> failk "expected" (where_ p) "expected %s here, and found %s" what (show t) (* 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); 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 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. *) (* 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 ("", [||]) 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 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]") (* Expressions come back with their syntactic level: 10 an atom or a bracket, 9 a postfix chain, 8 a unary minus, 1-7 a binary operator's level, 3 a [not], 0 a one-line [if] or a lambda. Anything under 8 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 > 7 then unary p else let l0 = (peek p).loc in let ((first, _) as fst_) = binary p (lvl + 1) 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 rec run op operands = match (peek p).tok with | NAME s when binary_here 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, _ = binary p (lvl + 1) in if s = op then run op (rhs :: operands) else begin if lvl = 4 then failk "mixed-comparison" ot.loc "%s follows %s in one chain, and a chain compares with one \ operator. Join the tests with and, or parenthesise one side" s op; let folded, _ = close op operands in run s [ rhs; folded ] end | _ -> close op operands 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 -> run s [ first ] | _ -> fst_ 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 ]), 8) | _ -> 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)), 9) | LB -> ignore (advance p); let idx = items p RB t.loc ~what:"indices" ~head:(text_of f) in loop (mk p l0 (Form.List (sym t.loc "at" :: f :: idx)), 9) | NAME s when String.length s > 1 && s.[0] = '.' -> ignore (advance p); loop (mk p l0 (Form.List [ sym t.loc s; f ]), 9) | 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) ]), 9) | _ -> 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" && nxt.sp && starts_value nxt.tok then if_expr p else if s = "fn" && glued_lp then fn_expr p 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), 10) 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, 10) end | KW k -> ignore (advance p); (Form.make (Form.Kw k) l0, 10) | ATOM v -> ignore (advance p); (Form.make v l0, if negative_literal t.tok then 8 else 10) | DATUM f -> ignore (advance p); (f, 10) | LP -> ignore (advance p); if (peek p).tok = RP then begin ignore (advance p); (mk p l0 (Form.List []), 10) 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, 10) | LB -> ignore (advance p); let xs = vec_items p l0 in (mk p l0 (Form.Vec xs), 10) | LC -> ignore (advance p); let xs = map_items p l0 in (mk p l0 (Form.Map xs), 10) | 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 ]), 10) | NEG -> 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. *) and if_expr p = let t = advance p in let c, _ = binary p 1 in (match (peek p).tok with | NAME "then" -> ignore (advance p) | _ -> failk "if-then" (where_ p) "an if inside a line is if c then a else b, and there is no then \ after %s. Write the then, or start the if on its own line with its \ branches indented under it" (text_of c)); let a = inline_stmt p in match (peek p).tok with | NAME "else" -> ignore (advance p); let b = inline_stmt p in (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" | _ -> (mk p t.loc (Form.List [ sym t.loc "when"; c; a ]), 0) (* 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 "=" -> 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 -> 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)), 9) (* 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. *) (* [head] is the text of what is indexed, for [[ ]]'s message. *) and items ?head 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: %s" (show n.tok) (text_of e) what (match head with | Some h -> Printf.sprintf "%s[%s, %s]" h (text_of e) (show n.tok) | None -> "f(a, b)") else stray p ~after:(text_of e)) in go [] (* [[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 < 8 && 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 < 8 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 < 8 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 f, _ = 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" ]) let header_follow p s = let n = peek_at p 1 in 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" | "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) | "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 [] (* [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 header_follow p "if" && not (then_on_line p) -> header s "if" | _ -> 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 -> failk "one-binding" (peek p).loc "%s is followed by a comma, and one line binds one name. Put each \ binding on its own line, one after the other" (text_of e) | _ -> 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 and let_stmt (s : st) : Form.t list = let p = s.p in let t = advance 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 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 (target :: v :: bs) body | _ -> make [ target; v ] body in (* A let has no block: its name lasts to the end of the block it is in. *) if (peek p).tok = INDENT then failk "let-block" (peek_at p 1).loc "this line is indented under let %s, which takes no block. A let's \ name lasts to the end of the block the let is in, so the lines after \ it go at the let's column" (text_of target) else [ 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 (("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 "=" -> 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 -> 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" -> 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 s ~after:(w ^ " " ^ text_of name ^ " =")) | _ -> 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 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" w (text_of name) w (text_of name) in named head items | "struct" | "union" -> let name = name_tok p ~what:"the type's name" in expect_eol_block p ~after:(w ^ " " ^ text_of name); let fields = 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 named (if w = "struct" then "defstruct" else "defunion") [ name; Form.make (Form.Vec fields) (span p name.loc) ] | "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" -> let c, _ = binary p 1 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 = let rec elifs acc = match (peek p).tok with | NAME "elif" -> ignore (advance p); let c, _ = binary p 1 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" -> 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 | [], None -> named "when" (c :: body) | [], Some (el, e) -> form [ 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 (match (peek p).tok with | NAME "then" -> ignore (advance p); let a = inline_stmt p in (match (peek p).tok with | NAME "else" -> ignore (advance p); let b = inline_stmt p in let f = form [ 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 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 -> 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 -> 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 (* 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:"=>" (** 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 ~file src = let snippet = col <> None in let col = Option.value col ~default:1 in let saved = !source in (* 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) (fun () -> let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in let fs = stmts s in (match (peek s.p).tok with | EOF -> () | tk -> failk "unexpected-token" (where_ s.p) "unexpected %s" (show tk)); 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))