diff --git a/TODO.org b/TODO.org index 42f928cc..58fca022 100644 --- a/TODO.org +++ b/TODO.org @@ -19,7 +19,8 @@ Waits on the dyn char lane and the literal inference lane. ** DONE if let CLOSED: [2026-09-26] =(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it -is a statement, not an Option. Rules out a plain name or =_= as the pattern (use =let=). +is a statement unless kept, when it is an Option as =when= is. Rules out a plain name or +=_= as the pattern (use =let=). ** DONE when as a value, and get as a checked lookup CLOSED: [2026-09-26] Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a diff --git a/lib/check.ml b/lib/check.ml index 7d9235ed..4bc91709 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8709,8 +8709,8 @@ and kept_open ~used want (e : Ast.expr) = in let rec open_ (e : Ast.expr) = match e.Ast.e with - | Ast.Do [] | Ast.If (_, _, None) -> true - | Ast.If (_, _, Some e') -> open_ e' + | Ast.Do [] | Ast.If (_, _, None) | Ast.IfLet (_, _, None) -> true + | Ast.If (_, _, Some e') | Ast.IfLet (_, _, Some e') -> open_ e' | _ -> false in kept && open_ e @@ -9763,12 +9763,18 @@ and check_array_gen ctx ~want loc dims f = (array_build ctx loc ns elem ~pre:[ (fs, f) ] ~element:(fun idxs -> mk loc elem (Tast.CallPtr (fv, idxs)))) -and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc - scrutinee arms = +and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = false) + ?want loc scrutinee arms = (* [stmt] is an [if let] with no else: a statement, Unit whatever its arm - answers, as a one-armed [if] is when nothing keeps it. *) + answers, as a one-armed [if] is when nothing keeps it. [opt] is one that + is kept: its arm answers [Some], and the arm with no body [None]. *) let used = used && not stmt in - let want = if stmt then None else want in + let arms_ast_for_opt = arms in + let want = + if stmt then None + else if opt then (match want with Some (Types.Option i) -> Some i | _ -> None) + else want + in let s = check ctx scrutinee in (* What the arms are alternatives over. An [Option] is a two-case data type wearing a special coat, so the two shapes below are the same shape: a set @@ -10173,7 +10179,9 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc ctx.tail <- tail; ctx.used <- used; let arm = (a, ctor, binds) in + let empty = opt && a.Ast.body = [] in let body = + if empty then unit_at a.Ast.aloc else if free && !want <> None && not (literal_arm arm) then (* As an [if]'s else arm: at the join so far first, on its own terms only when that is refused as a mismatch. *) @@ -10223,7 +10231,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc then mk body.Tast.loc Types.Unit (Tast.Do [ body; unit_at body.Tast.loc ]) else body in - (if body.Tast.ty <> Types.Never && not stmt then + (if body.Tast.ty <> Types.Never && not stmt && not empty then match !want with | None -> want := Some body.Tast.ty | Some w when free -> @@ -10255,8 +10263,11 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc is said, as each would be checked at it. *) List.map (fun (i, (arm : Tast.arm)) -> + let empty = + opt && (let (a : Ast.arm), _, _ = List.nth resolved i in a.Ast.body = []) + in match arm.Tast.abody with - | [ b ] when not (Types.equal b.Tast.ty j || b.Tast.ty = Types.Never) -> + | [ b ] when not (empty || Types.equal b.Tast.ty j || b.Tast.ty = Types.Never) -> let at = value_loc i in let b = try expect ctx at ~want:(Some j) b @@ -10270,6 +10281,20 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc let arms = List.map snd (List.sort (fun (i, _) (j, _) -> compare i j) checked) in + let opt_ty = Option.map (fun t -> Types.Option t) !want in + let arms = + match opt, opt_ty with + | true, Some oty -> + List.map2 + (fun (a : Ast.arm) (arm : Tast.arm) -> + match a.Ast.body, arm.Tast.abody with + | [], _ -> { arm with Tast.abody = [ mk a.Ast.aloc oty Tast.None_ ] } + | _, [ b ] when b.Tast.ty <> Types.Never -> + { arm with Tast.abody = [ mk b.Tast.loc oty (Tast.Some_ b) ] } + | _ -> arm) + arms_ast_for_opt arms + | _ -> arms + in (* Exhaustiveness is refused, not defaulted. A match that silently fell through would have to produce a value of the match's type out of nothing, and there is no such value for most types; and the case a data type grows @@ -10319,6 +10344,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc (if List.length missing = 1 then "it" else "them"); let ty = if stmt then Types.Unit + else if opt then (match opt_ty with Some t -> t | None -> Types.Never) else match !want with Some t -> t | None -> Types.Never in match subject with @@ -10392,7 +10418,39 @@ and check_if_let ctx ~tail ~used ?want loc scrutinee (arm : Ast.arm) els = | Ast.Pctor (n, []) when not (is_case n) -> irrefutable (Some n) | _ -> ()); let wild body = { Ast.pat = Ast.Pwild; body; aloc = loc } in + (* Kept with no else at the end of its chain, it is a [when] over a + pattern: [Some] of the arm that ran and [None] when none did — or, where + a dyn is wanted, the value or nil. *) + let open_end = + match els with None -> true | Some e -> kept_open ~used:true None e + in + let kept = + match want with + | Some (Types.Unit | Types.Never) -> false + | Some _ -> true + | None -> used + in + let at (x : Ast.expr) e = { Ast.e; loc = x.Ast.loc } in match els with + | _ when kept && open_end -> + let rest = match els with Some e -> e | None -> at scrutinee (Ast.Var "nil") in + (match want with + | Some Types.Dyn -> + check_match ctx ~tail ~used:true ?want loc scrutinee [ arm; wild [ rest ] ] + | _ -> + match els with + | None -> + expect ctx loc ~want + (check_match ctx ~tail ~used:true ~opt:true ?want loc scrutinee + [ arm; wild [] ]) + | Some rest -> + let some = + List.map + (fun (b : Ast.expr) -> at b (Ast.Call (at b (Ast.Var "Some"), [ b ]))) + arm.Ast.body + in + check_match ctx ~tail ~used:true ?want loc scrutinee + [ { arm with Ast.body = some }; wild [ rest ] ]) | Some e -> check_match ctx ~tail ~used ?want loc scrutinee [ arm; wild [ e ] ] | None -> @@ -11168,27 +11226,56 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args = expect ctx loc ~want acc end -(* An operand is kept, so a [when] written as one answers an Option, which - no arithmetic takes. Said at the [when], before the operands are checked - against each other — where the literal beside it would be blamed instead. - A [when] over a dyn answers a dyn, and that is left to the fold. *) +(* An operand is kept, so a form with no else at its end — a [when], a + [cond] or an [if]/[if let] chain with no final else, or a [do] or [let] + ending in one — answers an Option there. Beside a number that is refused + at the form itself, before the operands are checked against each other, + where the number beside it would be blamed instead. One over a dyn answers + a dyn, and that is left to the operator. *) and refuse_kept_when ctx name (args : Ast.expr list) = + (* The form with no else, found at the end of [a]. *) + let rec else_less (a : Ast.expr) = + match a.Ast.e with + | Ast.If (_, _, None) | Ast.IfLet (_, _, None) -> Some a + | Ast.If (_, _, Some e) | Ast.IfLet (_, _, Some e) -> + if open_tail e then Some a else None + | Ast.Do (_ :: _ as xs) | Ast.Let (_, (_ :: _ as xs)) -> + else_less (List.nth xs (List.length xs - 1)) + | _ -> None + and open_tail (e : Ast.expr) = + match e.Ast.e with + | Ast.Do [] -> true + | _ -> else_less e <> None + in + let ty (a : Ast.expr) = probe ctx a.Ast.loc (fun () -> (check ctx a).Tast.ty) in + let number (a : Ast.expr) = + match a.Ast.e with + | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true + | _ when else_less a <> None -> false + | _ -> (match ty a with Some t -> Types.is_numeric t | None -> false) + in List.iter (fun (a : Ast.expr) -> - match a.Ast.e with - | Ast.If (_, _, None) -> - (match probe ctx a.Ast.loc (fun () -> (check ctx a).Tast.ty) with - | Some (Types.Option _ as t) -> - let fln = fln_source a.Ast.loc in - Loc.failk "check/kept-when" a.Ast.loc + match else_less a with + | Some form -> + (match ty a with + | Some (Types.Option _ as t) + when List.exists (fun b -> b != a && number b) args -> + let fln = fln_source form.Ast.loc in + let what = + match form.Ast.e with + | Ast.If (_, _, None) -> if fln then "if without an else" else "when" + | Ast.IfLet _ -> "if let without an else" + | _ -> if fln then "if chain without an else" else "chain without an else" + in + Loc.failk "check/kept-when" form.Ast.loc "this %s is an operand of %s, so its value is kept, and there it \ - gives %s: Some of its value when the test holds, None when it \ - does not. %s takes numbers. Give it an else, or unwrap what it \ - gives with match" - (if fln then "if without an else" else "when") name - (tyname a.Ast.loc t) name + gives %s: Some of its value when a test holds, None when none \ + does. The other side is a number. Give it an else, or unwrap \ + what it gives with match" + what name (tyname form.Ast.loc t) | _ -> ()) - | _ -> ()) + | None -> ()) args (* The dyn lowering of a fold: one call per operator application, left to @@ -12604,6 +12691,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = let x, y, rest = match args with x :: y :: rest -> x, y, rest | _ -> assert false in + refuse_kept_when ctx name args; if List.exists (fun a -> peeks_string ctx a) args then string_compare ctx ~want loc name p args else @@ -13732,6 +13820,8 @@ and named_call ?(qualified = false) ctx ~want loc name args = | Types.Map _ -> fail loc "a map's get takes one key, as (get m k), and this has %d" (List.length idx) + | Types.Named "String" -> + (ignore (refuse_string_index (List.hd idx).Ast.loc ~store:false); assert false) | Types.Dyn -> dyn_get ctx ~want loc target idx | _ -> checked_get ctx ~want loc target idx) | [ target; k ] -> @@ -13739,6 +13829,8 @@ and named_call ?(qualified = false) ctx ~want loc name args = (match target.Tast.ty with | Types.Array _ | Types.Slice _ | Types.String | Types.Vec _ -> checked_get ctx ~want loc target [ k ] + (* The same refusal [at] gives: a String is not indexed. *) + | Types.Named "String" -> (ignore (refuse_string_index k.Ast.loc ~store:false); assert false) | Types.Dyn -> dyn_get ctx ~want loc target [ k ] | _ -> (* A dyn map's absence is nil, not None: the typed map can promise an diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 2e6f38dc..3b1e274a 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -4896,22 +4896,22 @@ static int64_t need_index(const uint8_t *loc, int64_t loclen, const char *op, * count the same way. [soft] is [get]'s — an index out of range is nil * rather than a trap. */ static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc, - int64_t loclen, int soft) { + int64_t loclen, int soft, const char *op) { int64_t k; flan_obj *o; /* m[:k] on a map is (get m :k), whatever the key: get's rule, nil when * absent. */ if (is_map(v)) return flan_dyn_get(v, i, loc, loclen); if (!is_text(v) && !is_vec(v)) - trap2(loc, loclen, TYPE_TRAP, "at", "only a text, a vec or a map is indexed", + trap2(loc, loclen, TYPE_TRAP, op, "only a text, a vec or a map is indexed", v, i); - k = need_index(loc, loclen, "at", v, i); + k = need_index(loc, loclen, op, v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { - int64_t len = view_len(loc, loclen, "at", o); + int64_t len = view_len(loc, loclen, op, o); if (k < 0 || k >= len) { if (soft) return flan_dyn_nil(); - trap_range(loc, loclen, "at", v, k, len); + trap_range(loc, loclen, op, v, k, len); } { uint8_t *p = view_elem_at(o, k); @@ -4919,7 +4919,7 @@ static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc, case VIEW_FAST_I64: { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); } case VIEW_FAST_F64: { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } case VIEW_FAST_BOOL: return flan_dyn_from_bool(*p ? 1 : 0); - default: return view_read(loc, loclen, "at", o, o->u.view.desc, p); + default: return view_read(loc, loclen, op, o, o->u.view.desc, p); } } } @@ -4928,7 +4928,7 @@ static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc, int w; if (k < 0 || k >= o->u.i) { if (soft) return flan_dyn_nil(); - trap_range(loc, loclen, "at", v, k, o->u.i); + trap_range(loc, loclen, op, v, k, o->u.i); } off = text_offset(o, k); return dyn_make(BOX_CHAR, @@ -4936,14 +4936,14 @@ static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc, } if (k < 0 || k >= o->len) { if (soft) return flan_dyn_nil(); - trap_range(loc, loclen, "at", v, k, o->len); + trap_range(loc, loclen, op, v, k, o->len); } return o->u.v.items[k]; } flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, int64_t loclen) { - return at_core(v, i, loc, loclen, 0); + return at_core(v, i, loc, loclen, 0, "at"); } /* (slice s lo) and (slice s lo hi) over a text; nil for [hi] is the length. @@ -5192,7 +5192,7 @@ flan_dyn flan_dyn_get_at(flan_dyn v, flan_dyn i, const uint8_t *loc, /* Through [at]'s own body, so however [at] counts a text — by code point — * [get] counts the same. */ if (!is_text(v) && !is_vec(v)) return flan_dyn_get(v, i, loc, loclen); - return at_core(v, i, loc, loclen, 1); + return at_core(v, i, loc, loclen, 1, "get"); } static flan_dyn contains_walk(flan_dyn m, flan_dyn k) { diff --git a/spec-syntax.md b/spec-syntax.md index 71e57328..929ced4a 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -267,6 +267,7 @@ Each item: the proposal, then the reason in one line. - **`if let P = v`** plus a block reads as `(if-let [P v] then)`; `elif` and `else` follow as for `if`, the rest of the chain being the `if-let`'s else. `elif let P = v` is a further `if-let` nested in that else. + Kept with no `else` at the end of its chain, it gives an Option as `when` does. `P` is any `match` pattern, and its names are bound in the block only. One line: `if let Some(g) = o then g else 0`. A pattern that cannot fail, a plain name or `_`, is refused toward `let`. **Built.** diff --git a/test/programs/get-trap.flan b/test/programs/get-trap.flan new file mode 100644 index 00000000..8f84ec2c --- /dev/null +++ b/test/programs/get-trap.flan @@ -0,0 +1,5 @@ +;;;; A dyn get with an index that is not an int traps, in get's own words: +;;;; the message names get and shows the get call, not at. + +(defn main [] () + (println (get (the dyn "héllo") 1.5))) diff --git a/test/programs/if-let-kept.fln b/test/programs/if-let-kept.fln new file mode 100644 index 00000000..48551fd6 --- /dev/null +++ b/test/programs/if-let-kept.fln @@ -0,0 +1,38 @@ +;; A kept if let with no else at the end of its chain gives an Option: Some of +;; the arm that ran, None when none did. + +fn pick(a: Option(i32), k: i32) -> Option(i32) + if let Some(x) = a then x + elif k > 0 then k + +fn only(a: Option(i32)) -> Option(i32) + if let Some(x) = a then x * 2 + +fn lead(k: i32, b: Option(i32)) -> Option(i32) + if k > 5 + k + elif let Some(y) = b + y + +fn dyn_only(a: Option(i32)) -> dyn + if let Some(x) = a then x + +fn show(o: Option(i32)) + match o + Some(v) -> println(v) + None -> println("none") + +fn main() + show(pick(Some(1), 0)) + show(pick(None, 4)) + show(pick(None, 0)) + show(only(Some(3))) + show(only(None)) + show(lead(9, None)) + show(lead(1, Some(2))) + show(lead(1, None)) + println(dyn_only(Some(5))) + println(dyn_only(None)) + ;; As a statement it is unchanged. + if let Some(x) = Some(7) + println(x) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index de6f20e7..c07afbbe 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2245,7 +2245,21 @@ let () = let if_let_out = "5\n100\n0\n9\n1\n20\n100\n0\n1\n7\nabsent\nnorth\n6\n-1\n-2\n14\nwhen block\n" in + let if_let_kept_out = "1\n4\nnone\n6\nnone\n9\n2\nnone\n5\nnil\n7\n" in + outputs "a kept if let chain" "programs/if-let-kept.fln" if_let_kept_out; + outputs ~opt:"-O0" "a kept if let chain, -O0" "programs/if-let-kept.fln" if_let_kept_out; + outputs ~x86:true "a kept if let chain, --x86" "programs/if-let-kept.fln" if_let_kept_out; outputs "if let" "programs/if-let.fln" if_let_out; + (let exe = compile "programs/get-trap.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "dyn get:") + || not (contains text "(get \"h\195\169llo\" 1.5)") + then begin + incr failures; + Printf.printf "FAIL a dyn get's trap names get\n got: %S (exit %d)\n" + text code + end; + (try Sys.remove exe with Sys_error _ -> ())); outputs ~opt:"-O0" "if let, -O0" "programs/if-let.fln" if_let_out; outputs ~x86:true "if let, --x86" "programs/if-let.fln" if_let_out; (* format-f64, the first number formatter a caller can steer. The three diff --git a/test/test_flan.ml b/test/test_flan.ml index c2e16379..711150e7 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -8344,6 +8344,24 @@ let () = rejects_check "on either side" ~needle:"this when is an operand of +, so its value is kept" "(defn main [] () (println (+ (when true 5) 1)))"; + (* Any form with no else at its end, beside a number, is blamed itself. *) + List.iter + (fun (what, e, needle) -> + rejects_check ("a kept " ^ what ^ " beside a number is blamed itself") + ~needle + ("(defn main [] () (let [c true] (println " ^ e ^ ")))")) + [ ("when in <", "(< 1 (when c 5))", "this when is an operand of <, so its value is kept"); + ("when in =", "(= 1 (when c 5))", "this when is an operand of =, so its value is kept"); + ("cond", "(+ 1 (cond c 5))", "this chain without an else is an operand of +"); + ("if ending in a when", "(+ 1 (if c 5 (when c 6)))", + "this chain without an else is an operand of +"); + ("do ending in a when", "(+ 1 (do (when c 5)))", "this when is an operand of +"); + ("if-let", "(+ 1 (if-let [(Some x) (Some c)] 5))", + "this if let without an else is an operand of +") ]; + (* get on a String is refused as at is. *) + rejects_check "get on a String is refused as at is" + ~needle:"a String is not indexed" + "(defn main [] () (let [s (string-new \"abc\")] (println (get s 1))))"; accepts "a lambda's when takes the Option its position wants" "(defn call-it [f (Fn [] (Option i32))] () (println (f)))\n\ (defn main [] () (call-it (fn [] (when true 6))))"; diff --git a/test/test_syntax.ml b/test/test_syntax.ml index a0ef87bd..4dc2392a 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -1161,6 +1161,9 @@ let () = reads "elif let reads as a nested if-let" "if let Some(x) = a\n f(x)\nelif let None = b\n g()\nelse\n h()" "(if-let [(Some x) a] (f x) (if-let [None b] (g) (h)))"; + round "a kept if let chain with no else" + "(defn f [a (Option i32) k i32] (Option i32) (if-let [(Some x) a] (do (g) x) (cond (> k 0) k)))" + " if let Some(x) = a\n g()\n x\n elif k > 0\n k"; round "a kept when" "(defn f [] () (let [w (when (> a 1) 2)] (g w)))" " let w = when a > 1 then 2"; reads "when with a block" "when a\n b()\n c()" "(when a (b) (c))";