diff --git a/lib/check.ml b/lib/check.ml index 24416ca7..a23f2e83 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1165,6 +1165,21 @@ let one_edit a b = else ta a (!i + 1) = ta b !i end +(* Whether [got] could be [want] once [want]'s type variables are bound: + the same shape, a variable matching anything. Binding them consistently is + the generic call's business; this only says a literal may take the shape. *) +let rec fits_shape (want : Types.t) (got : Types.t) = + match want, got with + | Types.Var _, _ -> true + | Types.Fn (ps, r), Types.Fn (qs, s) | Types.CFn (ps, r), Types.CFn (qs, s) -> + List.length ps = List.length qs && List.for_all2 fits_shape ps qs && fits_shape r s + | Types.Slice (a, x), Types.Slice (b, y) | Types.Ptr (a, x), Types.Ptr (b, y) -> + a = b && fits_shape x y + | Types.Vec x, Types.Vec y | Types.Option x, Types.Option y -> fits_shape x y + | Types.Array (n, x), Types.Array (m, y) -> n = m && fits_shape x y + | Types.Map (k, v), Types.Map (k', v') -> fits_shape k k' && fits_shape v v' + | _ -> Types.equal want got + (* [Dir.north] as the enum and the member's value, when [Dir] is an enum with a member [north]. *) let enum_member env name = @@ -1527,10 +1542,10 @@ let struct_app g args = let finite_from env name0 = let rec walk seen name = if List.mem name seen then - (let shown = Types.to_string (Types.Named name) in - fail (Option.value (Hashtbl.find_opt env.locs name) ~default:Loc.unknown) - "%s contains itself by value, so it has no size — go through (Ptr %s)" - shown shown); + (let l = Option.value (Hashtbl.find_opt env.locs name) ~default:Loc.unknown in + fail l "%s contains itself by value, so it has no size — go through %s" + (tyname l (Types.Named name)) + (tyname l (Types.Ptr (Types.Mut, Types.Named name)))); let seen = name :: seen in match Hashtbl.find_opt env.structs name with | Some s -> List.iter (fun (f : Tast.field) -> ty seen f.Tast.fty) s.Tast.fields @@ -1739,7 +1754,7 @@ and struct_len_arg env name p (a : Ast.texpr) = (match List.assoc_opt bare env.subst with | Some (Types.Len _ as l) -> l | Some (Types.Var v) -> Types.Var v - | Some t -> not_one ("the type " ^ Types.to_string t) + | Some t -> not_one ("the type " ^ tyname a.Ast.tloc t) | None -> if List.mem bare env.lenvars then Types.Var bare else if List.mem bare env.tyvars then not_one "a type variable" @@ -2301,7 +2316,7 @@ let rec slot_of env ~classes cls fname (t : Ast.texpr) : slot_ty = (match resolve env t with | Types.Dyn -> Sany | (Types.Bool | Types.Int _ | Types.Float _ | Types.String) as t -> Sval t - | other -> refuse (Types.to_string other)) + | other -> refuse (tyname t.Ast.tloc other)) (* The type's word in the string the runtime reads: the scalar type's name, [#name] for a class, [?] in front for an Option. See [slot_type_of] in @@ -3154,7 +3169,7 @@ let clone_accepts env (t : Types.t) = the elements themselves into a second container would copy their headers and share their blocks, so the advice is a copy of each element where clone takes one, and otherwise that there is no copy to make. *) -let insert_copies env (t : Types.t) = +let insert_copies ?(loc = Loc.unknown) env (t : Types.t) = let elem = match t with | Types.Vec e | Types.Slice (_, e) | Types.Map (_, e) -> Some e @@ -3167,7 +3182,7 @@ let insert_copies env (t : Types.t) = Printf.sprintf "Nothing copies what a %s owns either, so read the elements where they \ are" - (Types.to_string e) + (tyname loc e) | None -> "Build a second container and insert into it" (* A call written back out as source, for a fix that has to repeat what the @@ -3949,8 +3964,8 @@ let refuse_frame_escapes (f : Tast.fn) = | _, _, `Addr, _ -> let pointee = match e.Tast.ty with - | Types.Ptr (_, t) -> Types.to_string t - | t -> Types.to_string t + | Types.Ptr (_, t) -> tyname e.Tast.loc t + | t -> tyname e.Tast.loc t in fix_addr pointee in @@ -6252,8 +6267,15 @@ and var ctx ?(qualified = false) loc ~want name = (* [Dir.north]: an enum's member named through its type, as a data case is [Shape.Rect]; the same value as [:north] where a Dir is expected. *) | _ when lookup ctx name = None && enum_member ctx.env name <> None -> - let e, v = Option.get (enum_member ctx.env name) in - expect ctx loc ~want (mk loc (Types.Enum e) (Tast.Int (v, Types.I32))) + let head = String.sub name 0 (String.rindex name '.') in + let field = String.sub name (String.length head + 1) (String.length name - String.length head - 1) in + (* A local named like the enum shadows it, as a local shadows any + global: [Dir.north] is then that local's field. *) + if lookup ctx head <> None then + check ctx ?want { Ast.e = Ast.Field ({ Ast.e = Ast.Var head; loc }, field); loc } + else + let e, v = Option.get (enum_member ctx.env name) in + expect ctx loc ~want (mk loc (Types.Enum e) (Tast.Int (v, Types.I32))) | "None" -> (match want with | Some (Types.Option t) -> mk loc (Types.Option t) Tast.None_ @@ -6542,12 +6564,11 @@ and check_fn ctx ~want ?gen loc (params : string list) body = if bare && fctx.caught <> [] then begin let names = List.map fst fctx.caught in Loc.failk "check/cfn-captures" loc - "this fn captures %s, so it is a (Fn [%s] %s) and not a (CFn [%s] \ - %s): a CFn is the bare address, one word, with nowhere for the \ - copies to live. Widen the position to Fn, or pass %s in as a parameter" + "this fn captures %s, so it is a %s and not a %s: a CFn is the bare \ + address, one word, with nowhere for the copies to live. Widen the \ + position to Fn, or pass %s in as a parameter" (String.concat ", " names) - (String.concat " " (List.map (tyname loc) pts)) (tyname loc ret) - (String.concat " " (List.map (tyname loc) pts)) (tyname loc ret) + (tyname loc (Types.Fn (pts, ret))) (tyname loc (Types.CFn (pts, ret))) (match names with [ n ] -> n | _ -> "them") end; (* An [Fn]-position literal declares the environment whether or not it @@ -8459,7 +8480,7 @@ and mixed_refusal : 'a. ctx -> Ast.expr list -> Loc.diag -> 'a = (match want with | Some t when not (Types.fits ~expected:t ~actual:v.Tast.ty) -> fail i.Ast.loc "this array's elements are %s, but this one is %s" - (Types.to_string t) (Types.to_string v.Tast.ty) + (tyname i.Ast.loc t) (tyname i.Ast.loc v.Tast.ty) | _ -> ()) | exception Loc.Error e when e.Loc.dloc = i.Ast.loc && want <> None -> raise @@ -8471,7 +8492,7 @@ and mixed_refusal : 'a. ctx -> Ast.expr list -> Loc.diag -> 'a = (Printf.sprintf "this array's first element is %s, so every \ element is" - (Types.to_string first.Tast.ty)) ] })) + (tyname first.Tast.loc first.Tast.ty)) ] })) rest; raise (Loc.Error d) @@ -8620,8 +8641,12 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = literal is that CFn, as an untyped one would be. *) let ty = match ty, v.Ast.e, want with - | Types.Fn (ps, r), Ast.Fn _, Some (Types.CFn (ps', r') as c) - when Types.equal (Types.Fn (ps, r)) (Types.Fn (ps', r')) -> c + | Types.Fn (ps, r), Ast.Fn _, Some (Types.CFn (ps', r')) + when List.length ps = List.length ps' + && fits_shape (Types.Fn (ps', r')) (Types.Fn (ps, r)) -> + (* A generic's [CFn($t) -> $t] binds [$t] from the literal's own + types, as it would from any other argument's. *) + Types.CFn (ps, r) | _ -> ty in let is_nil = match v.Ast.e with Ast.Var "nil" -> true | _ -> false in @@ -9572,11 +9597,11 @@ and struct_target ctx (target : Ast.expr) : Tast.expr * string = fail target.Ast.loc "%s is %s — the pattern bound it to %s, so the value is already \ in hand and there is no field left to read" - n (Types.to_string other) w + n (tyname target.Ast.loc other) w | _ -> ()) | _ -> ()); fail target.Ast.loc "%s is not a struct, so it has no fields" - (Types.to_string other) + (tyname target.Ast.loc other) (* (at s i) reads a string's byte, and reading is the whole of what a string does here: it is a view of bytes the program does not own — a literal's @@ -11647,7 +11672,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = "%s cannot be cloned — its elements own storage, and nothing here \ can walk one to copy what it owns. %s" (tyname loc target.Tast.ty) - (insert_copies ctx.env target.Tast.ty) + (insert_copies ~loc:target.Tast.loc ctx.env target.Tast.ty) (* A slice's elements, copied into a block from the allocator and answered as a slice over it — what (bytes s) does for a string's bytes, and the same lowering. The same refusal as a Vec's, for the @@ -11657,7 +11682,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = "%s cannot be cloned — its elements own storage, and nothing here \ can walk one to copy what it owns. %s" (tyname loc target.Tast.ty) - (insert_copies ctx.env target.Tast.ty) + (insert_copies ~loc:target.Tast.loc ctx.env target.Tast.ty) (* The copy is a block from an allocator, which the collector does not walk, so a dyn in it would be a root nothing marks. *) | Types.Slice (_, elem) when holds_dyn ctx.env elem -> @@ -13576,8 +13601,22 @@ and generic_call ctx ~want loc name vars pats pret args = when not (open_ty p || bound_exactly v) -> Some v | _ -> None in + (* A typed .fln lambda, [(the (Fn [i32] i32) (fn ...))], at a + [CFn($t) -> $t] parameter: the literal is a CFn at its own types, + and those bind [$t] below as any argument's type would. *) + let typed_cfn = + match p, a.Ast.e with + | Types.CFn _, Ast.The (t, { Ast.e = Ast.Fn _; _ }) -> + (match resolve ctx.env t with + | Types.Fn (ps, r) when fits_shape p (Types.CFn (ps, r)) -> + Some (Types.CFn (ps, r)) + | _ -> None + | exception Loc.Error _ -> None) + | _ -> None + in let a = - if open_ty p || bound_view <> None then check ctx a + if typed_cfn <> None then check ctx ~want:(Option.get typed_cfn) a + else if open_ty p || bound_view <> None then check ctx a else if bound_scalar <> None && not untyped_literal then (* On its own terms first. A form that has no type without a want — [(zeroed)] is the one that matters — refuses here and is @@ -15555,7 +15594,7 @@ let rec check_fn ?sign env (fn : Ast.fn) : Tast.fn = | [] -> if Types.equal ret Types.Unit || ret == infer_ret then [] else fail fn.Ast.nloc "%s returns %s but has no body" fn.Ast.name - (Types.to_string ret) + (tyname fn.Ast.nloc ret) | body -> (* The last form is the return value, unless the function returns Unit, in which case whatever it evaluates to is discarded. *) @@ -15812,11 +15851,11 @@ and read_return env (fn : Ast.fn) params = (match List.find_opt unit arrive, List.find_opt (fun x -> not (unit x)) arrive with | Some (_, bare, _), Some (t, valued, _) -> Loc.failk "check/infer-mixed" bare - ~notes:[ Loc.note valued ("this gives " ^ Types.to_string t) ] + ~notes:[ Loc.note valued ("this gives " ^ tyname valued t) ] "%s gives no value here and %s on another path, and its return \ type is read off its body. Give this path a value too, or write \ the return type" - fn.Ast.name (Types.to_string t) + fn.Ast.name (tyname bare t) | _ -> ()); match arrive with | [] -> (Types.Unit, fn.Ast.nloc) @@ -16370,7 +16409,7 @@ let check_global env (d : Ast.decl) : Tast.global option = fail d.Ast.dloc "%s is a data type, and uninit on one is refused. Drop the \ uninit — a zeroed %s is %s" - (Types.to_string ty) un + (tyname d.Ast.dloc ty) un (match Hashtbl.find_opt env.datas un with | Some { Tast.cases = c :: _; _ } -> un ^ "." ^ c.Tast.vname | _ -> "its first case") @@ -16469,11 +16508,12 @@ let check_main env decls = if not ok_params then fail at "main takes no parameters or one [string], not (%s)" - (String.concat " " (List.map Types.to_string params)); + (String.concat (if Source.indented_at at then ", " else " ") + (List.map (tyname at) params)); if not (Types.equal ret Types.Unit || Types.equal ret (Types.Int Types.I32)) then fail at "main returns i32 or nothing, not %s" - (Types.to_string ret) + (tyname at ret) (* The environment as well as the program. A session needs it to check an expression typed at a REPL against the program the process is running — and @@ -17017,7 +17057,7 @@ let dyn_descriptors (p : Tast.program) = "%s of %s (the C symbol %s) is %s, and a dyn is reachable through \ it. %s, so the collector cannot mark that word and will free what \ it names — pass the fields across at written types instead" - what e.Tast.ename e.Tast.esym (Types.to_string t) why + what e.Tast.ename e.Tast.esym (tyname e.Tast.eloc t) why in (* One level in, because that level is the compiler's own: what a foreign parameter of pointer or slice type receives is the address diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 02ddd75c..4aaa75f0 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -805,6 +805,18 @@ and fn_expr p = 0) | _ -> (mk p t.loc (Form.List (sym t.loc "fn" :: args)), 9) +(* A lambda with a block written inside a call's brackets, where no block can + open. The fix shown is the typed form, since a lambda bound by [let] has + no call to take its types from; [header] is [fn(a: T) -> R] or the + header as written. *) +and lambda_in_brackets : 'a. Loc.t -> string -> 'a = fun at header -> + failk "lambda-block-in-brackets" at + "a lambda's block cannot go inside brackets, where a line break is only \ + a space. Name it first, with its types and the block under it:\n\n\ + \ let f = %s\n ...\n\n\ + and pass f, or write it on one line: %s = value" + 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 = @@ -867,12 +879,13 @@ and items p closer open_loc ~what = | _ -> false in if block_lambda then - failk "lambda-block-in-brackets" n.loc - "a lambda's block cannot go inside brackets, where a line break \ - is only a space. Name it first, with the block under it:\n\n\ - \ let f = %s\n ...\n\n\ - and pass f, or write it on one line: %s = value" - (text_of e) (text_of e) + let names = + match e.v with + | Form.List (_ :: ps) -> List.map text_of ps + | _ -> [] + in + lambda_in_brackets n.loc + ("fn(" ^ String.concat ", " (List.map (fun x -> x ^ ": T") names) ^ ") -> R") else 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 @@ -998,6 +1011,28 @@ let one_line_if_above p (t : token) = | 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. *) @@ -1126,6 +1161,17 @@ let () = typed_fn_expr := fun p -> let body, _ = expr p in (wrap [ unit_slot p i0 t0 body ], 0) | NEWLINE when (peek_at p 1).tok = INDENT -> (wrap [], 0) + (* 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 -> + let header = + "fn(" ^ 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) + ^ ") -> " ^ text_of r + in + lambda_in_brackets (peek p).loc header | _ -> failk "lambda-body" (where_ p) "a lambda's body follows = on its line, or is the block under it" @@ -1285,6 +1331,12 @@ and stmt (s : st) : Form.t = 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 \ @@ -1554,13 +1606,13 @@ and header (s : st) w : Form.t = | NEWLINE -> ignore (advance p); Some (et.loc, block s ~after:"else") | NAME "if" when not oneline -> failk "else-if" (where_ p) - "else takes its block on the lines under it. For another test \ - at this level, write elif c" - | _ when oneline -> + "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 ]) - | _ -> stray p ~after:"else") + Some (et.loc, [ x ])) | _ -> None in match els_, else_ with @@ -1594,6 +1646,16 @@ and header (s : st) w : Form.t = 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. *) diff --git a/spec-syntax.md b/spec-syntax.md index f420a8e7..0416c89a 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -361,15 +361,34 @@ Settled 2026-09-26, after writing programs by hand (`test/syntax/handwritten/`): 6. **A one-line if continues on the next line.** `if c then a` followed by `else b` (or `elif c2 then d`, or either with a block) at the if's column - is one if. An `else` left of that column is refused. + is one if. An `else` left of that column, or indented deeper, is refused. + After an if with a block, `else x` on one line is accepted too. + **Binding:** an `else` or `elif` on a line of its own belongs to the if + that starts at its column. An if inside a one-line slot (after `then`, + after `else`, in an arm) ends with its line and takes no later clause, so + + ``` + if a then x + else if b then y + else z + ``` + + is refused at its last line: the first `else` took `if b then y` as its + value, and the chain is `if a then x else if b then y else z` on one line, + or `elif b then y` on the second. 7. **Typed lambdas.** `fn(a: C, b) -> R = body`, or plus a block, reads `(the (Fn [C dyn] R) (fn [a b] body))`: the paren `fn` has no typed parameters, and `the` is how a value states its type, as in `let x: T = v`. An untyped parameter is `dyn`; the return type is required. Where a `CFn` of the same signature is wanted, the literal is - that `CFn`. The printer writes that form back as the typed lambda. + that `CFn`; at a generic's `CFn($t) -> $t` parameter the literal is a + `CFn` at its own types, which bind `$t` as any argument's would. The + printer writes that form back as the typed lambda. A block lambda cannot + sit inside a call's brackets; the refusal shows the typed `let` form to + bind it with. 8. **`Dir.north` is the enum member `:north`**, in a value and in a match - pattern, in both syntaxes. `:north` stays. + pattern, in both syntaxes. `:north` stays. A local named `Dir` shadows the + enum as a local shadows any global: `Dir.north` is then its field. 9. **Types in messages follow the code's syntax.** `Types.spell ~indented` is the one printer, `Fn(A) -> R`, `Option(i32)`, `Small(4, i32)` for a .fln location and `(Fn [A] R)` for a .flan one; `Types.to_string` stays the diff --git a/test/syntax/handwritten/ring.fln b/test/syntax/handwritten/ring.fln index 88940780..bc80797c 100644 --- a/test/syntax/handwritten/ring.fln +++ b/test/syntax/handwritten/ring.fln @@ -53,6 +53,15 @@ fn checksum(p: Ptr(u8), size: i64) -> u32 h = h * 16777619 h +; Apply f n times, for any element type. +fn repeat-apply(f: CFn($t) -> $t, x: $t, n: i32) -> $t + let v = x + for i in range(n) + v = f(v) + v + +fn halve-all(x: $t) -> $t where numeric?($t) = repeat-apply(fn(a: $t) -> $t = a / 2, x, 3) + fn main() -> i32 let r: Ring(5, i32) = zeroed() let samples = [7 3 9 3 12 5 3 8] @@ -82,4 +91,5 @@ fn main() -> i32 let raw: [4 u32] = [1 2 3 4] let p = Ptr(u8)(addr(raw[0])) println("checksum", checksum(p, 16)) + println("doubled", repeat-apply(fn(a: i32) -> i32 = a * 2, 1, 10), "halved", halve-all(800.0)) 0 diff --git a/test/syntax/handwritten/ring.out b/test/syntax/handwritten/ring.out index 68cae26e..df34a718 100644 --- a/test/syntax/handwritten/ring.out +++ b/test/syntax/handwritten/ring.out @@ -7,3 +7,4 @@ sensor 1 15 sensor 3 22 sensor 2 40 checksum 1041505217 +doubled 1024 halved 100 diff --git a/test/test_syntax.ml b/test/test_syntax.ml index ac8a215c..1b3843a1 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -593,7 +593,15 @@ let () = refuses "field with a colon" "p = P{x: 1}" "indent/brace-field" "no colon"; refuses "a dotted range" "for i in 0..10\n g(i)" "indent/dot-range" "range(0, 10)"; refuses "a block lambda inside a call" "sort-by(xs, fn(a, b)\n a < b)" - "indent/lambda-block-in-brackets" "let f = fn(a, b)"; + "indent/lambda-block-in-brackets" "let f = fn(a: T, b: T) -> R"; + refuses "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)" + "indent/lambda-block-in-brackets" "let f = fn(a: C, b: C) -> bool"; + refuses "an else after else-if on one line" "if a then x\nelse if b then y\nelse z" + "indent/orphan-else" "Write that line as elif"; + refuses "else deeper than a one-line if" "if a then b\n else c" + "indent/else-column" "Put it at the if's column"; + reads "a one-line else after an if with a block" "if a\n b()\n c()\nelse d()" + "(if a (do (b) (c)) (d))"; refuses "an unclosed call swallows the next line" "fn f() -> ()\n push(v, 1\n g()" "indent/missing-comma" "If the ( on line 2 was meant to close"; reads "else on the line after a one-line if" "if a then b\nelse c" "(if a b c)"; @@ -1037,6 +1045,26 @@ let () = fail "map-key.fln: %d errors, wanted one" (List.length ds) | exception _ -> () | _ -> ()); + (* The fix the lambda-in-brackets refusal shows compiles, with its + placeholders filled in. *) + (match read "sort-by(xs, fn(a, b)\n a.n < b.n)" with + | _ -> fail "lambda in brackets: read" + | exception Loc.Error d -> + let header = + let m = d.Loc.dmsg in + let i = String.index m '=' + 2 in + String.sub m i (String.index_from m i '\n' - i) + in + let header = + String.concat "C" (String.split_on_char 'T' header) + |> String.split_on_char 'R' |> String.concat "bool" + in + checks "lambda-fix.fln" + ("struct C\n n: i32\n\nfn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n" + ^ " let f = " ^ header ^ "\n a.n < b.n\n sort-by(slice(xs), f)\n xs[0].n\n")); + refused "cfn-captures.fln" + "fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) = k)\n" + [ "so it is a Fn(Option(i32)) -> i32 and not a CFn(Option(i32)) -> i32" ]; refused "defvar.fln" "defvar(x, 1)\n\nfn main() -> i32 = 0\n" [ "once x = 1 initialises once"; "def x = 1 re-initialises" ] @@ -1169,4 +1197,22 @@ let () = end else print_endline "syntax: no clang, the import programs are not built" +let () = + (* A local named like an enum shadows it. *) + List.iter + (fun (name, text) -> + let f = Filename.concat scratch name in + write f text; + match Test_support.linked f with + | exception e -> fail "%s: %s" name (diag_text e) + | _ -> run_both f "5 true\n") + (if Test_support.have "clang" then + [ ("shadow-enum.fln", + "enum Dir\n north\n south\n\nstruct P\n north: i32\n\nfn main() -> i32\n" + ^ " let a = Dir.north\n let Dir = P{.north 5}\n println(Dir.north, a == :north)\n 0\n"); + ("shadow-enum.flan", + "(defenum Dir [north south])\n(defstruct P [north i32])\n(defn main [] i32 " + ^ "(let [a Dir.north Dir (P {.north 5})] (println Dir.north (= a :north)) 0))\n") ] + else []) + let () = Test_support.report ~label:"syntax" ()