From 7dcef05df31e6f3ef3a12c9d9466e893aa7cba34 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 16:47:28 +0700 Subject: [PATCH 01/16] A u64 past the largest i64 traps where it crosses into dyn, a dyn nil past a fold's first pair traps at run time, and an is-numeric $t boxes beside a dyn. --- TODO.org | 8 ---- lib/check.ml | 81 ++++++++++++++++++++++++++------- lib/emit.ml | 1 + runtime/flan_dyn.c | 29 ++++++++---- runtime/flan_dyn.h | 2 + test/programs/dyn-crossing.flan | 59 ++++++++++++++++++++++++ test/test_acceptance.ml | 40 ++++++++++++++++ test/test_flan.ml | 20 ++++++-- 8 files changed, 204 insertions(+), 36 deletions(-) create mode 100644 test/programs/dyn-crossing.flan diff --git a/TODO.org b/TODO.org index e23add54..c1ee43de 100644 --- a/TODO.org +++ b/TODO.org @@ -800,14 +800,6 @@ One spelling for one operation; != stays, and not= is refused with a suggestion of !=. * Checker -** TODO A u64 above the i64 maximum becomes -1 when it crosses into dyn -=(+ z u)= and =(max u 0 z)= with u = u64 max read u as -1, silently. It should trap at -the crossing, as a u64 field read through a view already does. -** TODO A dyn nil past the first pair of a fold is refused at compile time -=(+ 1 2 (the dyn nil))= says nil has no None at i32, while =(+ (the dyn nil) 1 2)= traps -at run time. Both should trap at run time. -** TODO A generic $t beside a dyn operand is refused -"does not cross into a written type yet"; rule 117 says typed beside dyn gives dyn. ** WAIT Checking a wide fold of let operands is slow Parked 2026-09-26: design first; remeasure on a quiet machine, it was timed under load 20. A 2000-operand (bit-and (let …) …) takes 32 s to check (37 s before the bit operators); diff --git a/lib/check.ml b/lib/check.ml index 48360e96..e01bca51 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4415,6 +4415,10 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr = (* Dyn text is immutable and a String is not, so a String crosses as a copy of its bytes rather than as the view any other struct would be. *) | t when is_string_ty t -> dyn "flan_dyn_from_string" [ string_vec loc e ] + (* A dyn int is an i64, so a u64 past the largest i64 has none to become: + read as its bits it would be a different, negative number. It traps + here, at the crossing, as one read through a view does. *) + | Types.Int Types.U64 -> dyn "flan_dyn_from_u64" [ e; here loc ] | Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ] | Types.Float _ -> dyn "flan_dyn_from_f64" [ widen loc dyn_f64 e ] (* The ABI takes an [int32_t], because a C signature that says [_Bool] is a @@ -4435,6 +4439,28 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr = Loc.failk "check/dyn-unit" loc "() does not box into dyn. The absent dyn value is nil — write nil" | Types.Never -> e + (* A [$t] is seen only in a generic's abstract pass; each copy is checked + again at its concrete type, where the value boxes as that type does, and + this node is thrown away with the rest of the pass. Admitting it is sound + only when every type the variable can be at crosses, or a refusal would + move from the definition to whichever call instantiates it at a pointer, + an enum or a function, with no written requirement to blame — the rule + beside [println]'s deferral. Every [is-numeric] type crosses (a u64 past + the largest i64 traps at run time, not at a copy's check), so that bound + admits it. [is-ordered] and [is-equal] do not: both admit an enum, which + has no dyn value. The node is a cast rather than [flan_dyn_nil] because + [is_nil_lit] would read that as a nil literal. *) + | Types.Var v + when (match ctx with + | Some c -> declares c.env.tvpreds v "is-numeric" + | None -> false) -> + mk loc Types.Dyn (Tast.Prim (Tast.Cast Types.Dyn, [ e ])) + | Types.Var _ -> + let t = tyname loc e.Tast.ty in + Loc.failk "check/dyn-type-variable" loc + "%s may be a type with no dyn value, such as a pointer or an enum, so \ + it crosses into dyn only as a number. Write %s at the head of the body" + t (where_text loc "is-numeric" t) (* A view, not a copy: the box holds a small record naming where the storage is and what one element is (its descriptor, [view_desc]), and every read or write goes straight through to the container's own @@ -4522,7 +4548,7 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr = caller that starts doing that gets a sentence instead of a silent mis-lowering. *) | Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _ - | Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Var _ | Types.Len _ + | Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Len _ | Types.LArray _ | Types.Vec _ | Types.Array _ | Types.Slice _ -> no_dyn_yet loc ~into:true e.Tast.ty "" @@ -6812,9 +6838,9 @@ and wide_literal loc ~want n s = | Some Types.Dyn -> Loc.failk literal_at_want loc "expected dyn, found the integer literal %s, which only a u64 holds — a \ - dyn integer is an i64. Write (u64 %s) for the u64, which a dyn holds as \ - the i64 with the same bits, %Ld" - s s n + dyn integer is an i64, and no i64 is this large. Give what holds it \ + the type u64" + s | Some other -> Loc.failk literal_at_want loc "expected %s, found the integer literal %s, which only a u64 holds" @@ -11820,7 +11846,7 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args = | `Typed v -> steps (mk loc acc.Tast.ty (Tast.Prim (p, [ acc; v ]))) tl | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl else - match fold_operand ctx acc.Tast.ty (check ctx ~want:acc.Tast.ty arg) with + match fold_arg ctx acc.Tast.ty arg with | `Typed v -> steps (mk loc acc.Tast.ty (Tast.Prim (p, [ acc; v ]))) tl | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl in @@ -11847,7 +11873,7 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args = let rec steps acc = function | [] -> expect ctx loc ~want acc | arg :: tl -> - match fold_operand ctx ty (check ctx ~want:ty arg) with + match fold_arg ctx ty arg with | `Typed v -> steps (mk loc ty (Tast.Prim (p, [ acc; v ]))) tl | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl in @@ -11865,6 +11891,26 @@ and fold_operand ctx ty (v : Tast.expr) = | Some d -> `Dyn d | None -> `Typed v +(* An operand past a fold's first pair, from the source: at the type so far, + and on its own terms only when that is refused, as [binary_pair] checks + the second of the pair. A dyn it turns out to be joins the fold as a dyn, + so (+ 1 2 (the dyn nil)) traps at run time as (+ (the dyn nil) 1 2) does + instead of being refused for a nil with no value at i32, and a dyn beside + a [$t] is not opened at the variable. Anything else is checked at the type + again, for real, so its refusal is the one it always gave and recovery + records it. *) +and fold_arg ctx ty (arg : Ast.expr) = + match trial_at ctx arg ty with + | Ok v -> fold_operand ctx ty v + | Error _ -> + let own () = + let v = check ctx arg in + if v.Tast.ty = Types.Dyn then v else fail arg.Ast.loc "not a dyn" + in + match trial ctx own with + | Ok v -> `Dyn v + | Error _ -> fold_operand ctx ty (check ctx ~want:ty arg) + (* A pair an arithmetic operator refused, when one operand is a char: that is the refusal to give, rather than the mismatch between the two. Asked only after the refusal, so a pair that checks costs nothing more. *) @@ -11976,10 +12022,10 @@ and dyn_fold ctx ~want loc name first rest = language's type error, and until now it printed with no file, no line and no column — [here loc] is the same string literal [cast_dyn] hands the runtime, and the runtime prints it as a GNU prefix. *) - let apply acc b = rt loc Types.Dyn sym [ acc; box loc b; here loc ] in + let apply acc b = rt loc Types.Dyn sym [ acc; box ~ctx loc b; here loc ] in let acc = match first with - | [ a; b ] -> apply (box loc a) b + | [ a; b ] -> apply (box ~ctx loc a) b | _ -> assert false in let operand arg = @@ -13464,15 +13510,15 @@ and named_call ?(qualified = false) ctx ~want loc name args = in let r = match rest with - | [] -> link (box loc a) (box loc b) + | [] -> link (box ~ctx loc a) (box ~ctx loc b) | _ -> cmp_over ctx loc Types.Dyn ~pairs ~link (ops ()) in expect ctx loc ~want r in if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then dyn_chain (fun () -> - box loc a :: box loc b - :: map_lr (fun e -> box loc (check ctx ~want:Types.Dyn e)) rest) + box ~ctx loc a :: box ~ctx loc b + :: map_lr (fun e -> box ~ctx loc (check ctx ~want:Types.Dyn e)) rest) else begin (* [=] and [!=] admit types [<] does not. A handle is one: a pair of numbers in one word and where being the same entity is the question the @@ -13508,14 +13554,14 @@ and named_call ?(qualified = false) ctx ~want loc name args = | _ -> let ty = a.Tast.ty in let link u v = mk loc Types.Bool (Tast.Prim (p, [ u; v ])) in - let rest = map_lr (fun e -> fold_operand ctx ty (check ctx ~want:ty e)) rest in + let rest = map_lr (fold_arg ctx ty) rest in (* A dyn past the first pair makes the whole chain the dyn runtime's, for [fold_operand]'s reason: a chain is its pairs, and a pair with a dyn in it is a dyn comparison. *) if List.exists (function `Dyn _ -> true | `Typed _ -> false) rest then dyn_chain (fun () -> - box loc a :: box loc b - :: List.map (function `Dyn d -> d | `Typed v -> box loc v) rest) + box ~ctx loc a :: box ~ctx loc b + :: List.map (function `Dyn d -> d | `Typed v -> box ~ctx loc v) rest) else let ops = a :: b :: List.map (function `Typed v -> v | `Dyn d -> d) rest in @@ -13598,7 +13644,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = if v.Tast.ty <> Types.Dyn then bits_operand ctx v.Tast.loc name v) [ a; b ]; expect ctx loc ~want - (rt loc Types.Dyn (dyn_bits_sym name) [ box loc a; box loc b; here loc ]) + (rt loc Types.Dyn (dyn_bits_sym name) [ box ~ctx loc a; box ~ctx loc b; here loc ]) end else begin bits_operand ctx loc name a; (* A shift by the operand's own width or more is poison in LLVM, which at @@ -13663,7 +13709,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = let rec steps acc = function | [] -> expect ctx loc ~want acc | arg :: tl -> - match fold_operand ctx ty (check ctx ~want:ty arg) with + match fold_arg ctx ty arg with | `Typed v -> steps (pick acc v) tl | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl in @@ -20745,6 +20791,9 @@ let memory_class (sym : string) (args : Tast.expr list) = | "flan_dyn_from_i64" when (match args with [ x ] -> int_may_spill x | _ -> true) -> gc "may allocate: an i64 outside ±2^47 does not fit a dyn's payload and \ spills onto the collector's heap" + | "flan_dyn_from_u64" when (match args with x :: _ -> int_may_spill x | [] -> true) -> + gc "may allocate: a u64 above 2^47 does not fit a dyn's payload and \ + spills onto the collector's heap" (* ── An allocator the program named ── *) | "flan_arena_new" -> native "allocates: an arena takes its whole region from the host here" diff --git a/lib/emit.ml b/lib/emit.ml index 12bf55ca..d18cb4c3 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5067,6 +5067,7 @@ declare void @flan_alloc_set_budget(ptr, i64) ; ever looks inside one, so every operation on a dyn value is one of these. declare i64 @flan_dyn_nil() declare i64 @flan_dyn_from_i64(i64) +declare i64 @flan_dyn_from_u64(i64, ptr, i64) declare i64 @flan_dyn_from_f64(double) declare i64 @flan_dyn_from_bool(i32) declare i64 @flan_dyn_from_bytes(ptr, i64) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index d3c8fcbf..455bff6e 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1909,6 +1909,26 @@ flan_dyn flan_dyn_from_i64(int64_t x) { return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } +/* A u64 has a dyn int to become only up to the largest i64; past it the trap + * names the number, which read as an i64 would be a different one. [what] is + * "u64" for a scalar crossing and "u64 element" for one read through a view, + * so both say the same sentence. */ +static flan_dyn u64_to_dyn(const uint8_t *loc, int64_t loclen, const char *op, + const char *what, uint64_t x) { + if (x > (uint64_t)INT64_MAX) { + flan_say(loc, loclen, + "dyn%s%s: this %s is %llu, above the largest dyn int " + "(9223372036854775807), so it has no dyn value", + op[0] ? " " : "", op, what, (unsigned long long)x); + dyn_trap((const uint8_t *)"DynRange", 8); + } + return flan_dyn_from_i64((int64_t)x); +} + +flan_dyn flan_dyn_from_u64(uint64_t x, const uint8_t *loc, int64_t loclen) { + return u64_to_dyn(loc, loclen, "", "u64", x); +} + flan_dyn flan_dyn_from_f64(double x) { flan_dyn v; /* Every NaN becomes the one positive quiet NaN, which is what keeps a @@ -4046,14 +4066,7 @@ static flan_dyn view_read(const uint8_t *loc, int64_t loclen, const char *op, case 'L': { uint64_t x; memcpy(&x, p, 8); - if (x > (uint64_t)INT64_MAX) { - flan_say(loc, loclen, - "dyn %s: this u64 element is %llu, above the largest dyn int " - "(9223372036854775807), so it has no dyn value", - op, (unsigned long long)x); - dyn_trap((const uint8_t *)"DynRange", 8); - } - return flan_dyn_from_i64((int64_t)x); + return u64_to_dyn(loc, loclen, op, "u64 element", x); } case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); } case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index e7399cca..bfb8c85d 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -86,6 +86,8 @@ typedef struct flan_desc { flan_dyn flan_dyn_nil(void); flan_dyn flan_dyn_from_i64(int64_t x); +/* Traps at [loc] on a u64 above the largest i64, which no dyn int holds. */ +flan_dyn flan_dyn_from_u64(uint64_t x, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_from_f64(double x); flan_dyn flan_dyn_from_bool(uint8_t b); diff --git a/test/programs/dyn-crossing.flan b/test/programs/dyn-crossing.flan new file mode 100644 index 00000000..41431fa0 --- /dev/null +++ b/test/programs/dyn-crossing.flan @@ -0,0 +1,59 @@ +;;;; Typed values crossing into dyn beside a dyn operand: a u64, a dyn nil past +;;;; a fold's first pair, and a $t bounded by is-numeric. With an argument, the +;;;; program runs the trap that argument names instead. + +(defn add-dyn [x $t] dyn + {:where (is-numeric $t)} + (+ x (the dyn 1))) + +(defn add-late [x $t d dyn] dyn + {:where (is-numeric $t)} + (+ x 1 d)) + +(defn dyn-first [x $t d dyn] dyn + {:where (is-numeric $t)} + (* d x 2)) + +(defn less-late [x $t d dyn] bool + {:where (is-numeric $t)} + (< x 10 d)) + +(defn biggest [x $t d dyn] dyn + {:where (is-numeric $t)} + (max x d 0)) + +(defn low-bits [x $t d dyn] dyn + {:where (is-integer $t)} + (bit-and x 7 d)) + +(defn boxed [x $t] dyn + {:where (is-numeric $t)} + (the dyn x)) + +(defn main [args [str]] i32 + (let [z (the dyn 0) + n (the dyn 4) + small (the u64 9223372036854775807) + big (the u64 18446744073709551615) + nothing (the dyn nil)] + ;; A u64 up to the largest i64 crosses as its value. + (println (+ z small) (max small 0 z) (the dyn small) (= small (+ z small))) + ;; A $t at i32, f64 and u64, beside a dyn in any position. + (println (add-dyn 2) (add-dyn 2.5) (add-dyn (the u64 7))) + (println (add-late 2 n) (add-late 2.5 n) (dyn-first 3 n) (dyn-first 1.5 n)) + (println (less-late 1 n) (less-late 1 (the dyn 20)) (less-late 0.5 (the dyn 10.5))) + (println (biggest 3 n) (biggest -2.5 (the dyn -1)) (low-bits 13 n) (low-bits (the u8 255) n)) + (println (boxed 7) (boxed 0.25) (boxed small)) + ;; A nil past the pair is compared, not refused. + (println (= 1 1 nothing) (!= 1 2 nothing) (= 1 1 (the dyn nil))) + (when (> (length args) 1) + (let [a (at args 1)] + (when (= a "u64") (println (+ z big))) + (when (= a "u64-max") (println (max big 0 z))) + (when (= a "u64-generic") (println (boxed big))) + (when (= a "nil-first") (println (+ (the dyn nil) 1 2))) + (when (= a "nil-last") (println (+ 1 2 (the dyn nil)))) + (when (= a "nil-less") (println (< 1 2 (the dyn nil)))) + (when (= a "nil-min") (println (min 1 2 nil))) + (when (= a "nil-bits") (println (bit-or 1 2 nothing)))))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1233fb1c..4c35b408 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5665,6 +5665,46 @@ level "1" (if x86 then ", --x86" else "") text code end) [ false; true ]; + (* A u64, a dyn nil past the pair and an is-numeric $t, each beside a + dyn: the typed value crosses, and what cannot cross traps at its site. *) + let crossing_out = + "9223372036854775807 9223372036854775807 9223372036854775807 true\n\ + 3 3.5 8\n7 7.5 24 12\nfalse true true\n4 0 4 4\n\ + 7 0.25 9223372036854775807\nfalse true false\n" + in + outputs "dyn: typed values crossing beside a dyn" "programs/dyn-crossing.flan" + crossing_out; + outputs ~opt:"-O0" "dyn: typed values crossing beside a dyn, -O0" + "programs/dyn-crossing.flan" crossing_out; + outputs ~x86:true "dyn: typed values crossing beside a dyn, --x86" + "programs/dyn-crossing.flan" crossing_out; + let too_big = "dyn: this u64 is 18446744073709551615, above the largest \ + dyn int (9223372036854775807), so it has no dyn value" in + let crossing_traps = + [ "u64", "51:36", too_big; + "u64-max", "52:40", too_big; + "u64-generic", "31:12", too_big; + "nil-first", "54:42", "dyn +: nil and int, and it takes two numbers — (+ nil 1)"; + "nil-last", "55:41", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)"; + "nil-less", "56:41", "dyn <: int and nil"; + "nil-min", "57:40", "dyn min: int and nil"; + "nil-bits", "58:41", "dyn bit-or: int and nil" ] + in + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/dyn-crossing.flan" in + List.iter + (fun (arg, at, msg) -> + let code, text = run exe (Some arg) in + let want = "programs/dyn-crossing.flan:" ^ at ^ ": " ^ msg in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf "FAIL dyn: crossing trap %s%s\n \ + got: %S (exit %d)\n" + arg (if x86 then ", --x86" else "") text code + end) + crossing_traps) + [ false; true ]; List.iter (fun x86 -> let exe = compile ~x86 "programs/char-arith.flan" in diff --git a/test/test_flan.ml b/test/test_flan.ml index 59b8221e..0c7fa3e0 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2066,6 +2066,18 @@ let () = rejects_check "nil at a bare T is refused at compile time" "(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))" ~needle:"nil has no None to become"; + (* A $t crosses into dyn only under a bound every type of which has a dyn + value; an unbounded one could be a pointer, refused at no call site. *) + rejects_check "an unbounded $t does not cross into dyn" + "(defn f [x $t] dyn (+ x (the dyn 1)))\n\ + (defn main [] i32 (println (f 2)) 0)" + ~needle:"$t may be a type with no dyn value, such as a pointer or an \ + enum, so it crosses into dyn only as a number. Write \ + {:where (is-numeric $t)}"; + rejects_check "an is-ordered $t does not cross into dyn" + "(defn f [x $t] dyn {:where (is-ordered $t)} (the dyn x))\n\ + (defn main [] i32 (println (f 2)) 0)" + ~needle:"crosses into dyn only as a number"; rejects_check "nil at a bare T is refused at compile time, return position" "(defn f [] i64 nil)\n(defn main [] i32 0)" ~needle:"nil has no None to become"; @@ -8018,11 +8030,11 @@ let () = parse_rejects "a wide enum member is refused for its range" "(defenum E [A 0xFFFFFFFFFFFFFFFF B])" ~needle:"the member A of E is 0xFFFFFFFFFFFFFFFF, which does not fit i32"; - rejects_check "a wide literal in a dyn global names the u64 cast" + rejects_check "a wide literal in a dyn global names the type u64" "(defonce big 0xFFFFFFFFFFFFFFFF)" - ~needle:"Write (u64 0xFFFFFFFFFFFFFFFF) for the u64"; - accepts "the cast the dyn refusal names compiles" - "(defonce big (u64 0xFFFFFFFFFFFFFFFF))"; + ~needle:"no i64 is this large. Give what holds it the type u64"; + accepts "the type the dyn refusal names compiles" + "(defonce big u64 0xFFFFFFFFFFFFFFFF)"; (* A macro's Form has one integer case; the literal comes back wide all the same, and is refused where it would have been refused unexpanded. *) rejects_check "a wide literal through a macro is still wide" From c1916ed819e7a0ca579c387710528d9fe37c6598 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:07:01 +0700 Subject: [PATCH 02/16] e as g is any test of a condition's and chain, binding g for the rest of the chain and the block. --- TODO.org | 5 ++ emacs/flan-fln-mode.el | 16 +++- emacs/test-flan-fln.el | 10 +++ lib/ast.ml | 15 ++++ lib/check.ml | 83 ++++++++++++++++++- lib/indent_reader.ml | 147 +++++++++++++++++++++------------ lib/load.ml | 4 +- lib/parse.ml | 24 ++++++ spec-syntax.md | 32 +++++-- test/programs/as-chain-dyn.fln | 31 +++++++ test/programs/as-chain.fln | 90 ++++++++++++++++++++ test/test_acceptance.ml | 7 +- test/test_syntax.ml | 48 ++++++++--- 13 files changed, 435 insertions(+), 77 deletions(-) create mode 100644 test/programs/as-chain-dyn.fln create mode 100644 test/programs/as-chain.fln diff --git a/TODO.org b/TODO.org index c54bcdc7..fb813245 100644 --- a/TODO.org +++ b/TODO.org @@ -34,6 +34,11 @@ Decided (133): =x?= is a bool; =if x?=, =elif x?=, =while x?= and the rest of an make a local Option its payload in the block, in place (not a copy). Assigning an Option to it there is refused rather than ending the narrowing; =e? as g= names what a test found. Rules out =if let g = x= over a plain name, which is refused toward these. +** DONE e as g inside an and chain +CLOSED: [2026-09-26] +Decided (136): =e as g= (or =e? as g=) is any test of a condition's =and= chain, binding =g= +for the rest of the chain and the block, and a kept =when= with one is one flat Option. Rules +out =as= as a cast (only an Option or a dyn), and a binding under =or=, =not= or =until=. ** TODO The stepper does not step inside an optional chain =Ast.step_expr= treats a =Chain= as a leaf (its catch-all), so nothing in a chain's body gets a step point of its own. diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index fe93577d..1c53b045 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -1807,6 +1807,19 @@ it, so a block pasted at another depth stays one block." (defun flan-fln--fallback-re (heads) (concat "^" (regexp-opt heads t) "(" flan-fln--name-re)) +(defun flan-fln--as-matcher (limit) + "Find the next `as' of a condition up to LIMIT, `if e as g and ...': an +`as' before a name, on a line an `if', `elif', `while' or `when' comes first on." + (let (found) + (while (and (not found) + (re-search-forward "[ \t]\\(as\\)[ \t]+[^][ \t\n(){},;\":]" limit t)) + (setq found (save-excursion + (save-match-data + (goto-char (match-beginning 1)) + (re-search-backward "\\_<\\(?:if\\|elif\\|while\\|when\\)\\_>" + (line-beginning-position) t))))) + found)) + (defun flan-fln--return-type-matcher (limit) "Find the next return type up to LIMIT: after the `->' of a fn header, a lambda or a `Fn(...)' type, and not after a match arm's." @@ -1881,8 +1894,9 @@ lambda or a `Fn(...)' type, and not after a match arm's." ;; The words inside a line: `for i in range(n)', `if c then a else b', a ;; `where' constraint. ("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face) - ;; A test's `as', `if e? as g'. + ;; A test's `as', `if e? as g', and a condition's, `if e as g and ...'. ("?[ \t]+\\(as\\)[ \t]" 1 font-lock-keyword-face) + (flan-fln--as-matcher 1 font-lock-keyword-face) ;; `if let Some(g) = x', and a value's `if' or `when', `x = when c then a'. ("\\_<\\(?:el\\)?if[ \t]+\\(let\\)[ \t]" 1 font-lock-keyword-face) ("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face) diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 42ec72af..4a6a4fbe 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -938,6 +938,16 @@ defconst(k, 3) (search-forward "g!") (backward-char 1) (test-flan-fln--is "the name at x! is x" (thing-at-point 'symbol t) "g")) +;; A condition's `as' with no `?' before it, twice on a line; an `as' outside +;; a condition is left alone. +(test-flan-fln--in "fn f()\n left = when get(grid, r) as g and b(g) as h then g\n x = as y\n" + (font-lock-ensure) + (let ((face (lambda (needle) + (save-excursion (goto-char (point-min)) (search-forward needle) + (get-text-property (match-beginning 0) 'face))))) + (test-flan-fln--is "a condition's as is a keyword" (funcall face "as g") 'font-lock-keyword-face) + (test-flan-fln--is "and a second one" (funcall face "as h") 'font-lock-keyword-face) + (test-flan-fln--is "an as outside a condition is not" (funcall face "as y") nil))) (test-flan-fln--is "after if x? as g, one level deeper" (test-flan-fln--tabs "fn f() -> ()\n if o? as g\n|" 1) 4) (with-temp-buffer diff --git a/lib/ast.ml b/lib/ast.ml index 2d85db01..e20f43e4 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -632,3 +632,18 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option = in let ds = List.map decl ds in if !hit then Some ds else None + +(* The names the [as] tests of condition [c] bind (decision 136), for the + block [c] guards. [Parse.as_chain] reads the chain to this shape: each + test an [If] with [false] for its else, each [as] an [IfLet] over a plain + name with the rest of the chain as its body and [false] for its else. *) +let as_name g = + g <> "" && (match g.[0] with 'A' .. 'Z' -> false | _ -> true) + && g <> "true" && g <> "false" + +let rec as_binds (c : expr) = + match c.e with + | If (_, q, Some { e = Var "false"; _ }) -> as_binds q + | IfLet (_, { pat = Pctor (g, []); body = [ q ]; _ }, Some { e = Var "false"; _ }) + when as_name g -> g :: as_binds q + | _ -> [] diff --git a/lib/check.ml b/lib/check.ml index 48360e96..8771c299 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -6480,7 +6480,7 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = fail loc "%s is tested with %s? above, so in this block it is %s, and it \ cannot be given an Option here: the block reads it as present \ - throughout. Assign a %s, or test a new name, as in while %s? as \ + throughout. Assign a %s, or test a new name, as in while %s as \ item, and assign %s from that" n n (tyname loc b.bty) (tyname loc b.bty) n n | _ -> raise (Loc.Error d))) @@ -8525,12 +8525,29 @@ and check_if ctx ?(tail = false) ?(used = false) ?want loc c t e = raise ex) and check_if_once ctx ~tail ~used ?want loc c t e = + if as_binds c = [] then check_if_tested ctx ~tail ~used ?want loc c t e + else scoped ctx (fun () -> check_if_tested ctx ~tail ~used ?want loc c t e) + +and check_if_tested ctx ~tail ~used ?want loc c t e = let t = match narrows c with | [] -> t | names -> { t with Ast.e = Ast.Narrow (names, t) } in - let c = check_truthy ctx c in + let c, t = + match as_binds c with + | [] -> (check_truthy ctx c, t) + | _ -> + (* What an [as] named reaches the block through a name no reader can + write, bound in the scope this if was given; the else is checked + without it. *) + let cv, named = as_cond ctx c in + let bnd (g, h) = + { Ast.bname = g; bty = None; bval = { Ast.e = Ast.Var h; loc = t.Ast.loc }; + bloc = t.Ast.loc } + in + (cv, { t with Ast.e = Ast.Let (List.map bnd named, [ t ]) }) + in (* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))] is how nearly every loop is written, and the branch is still the last thing the body does. Both arms are kept when the [if] is. *) @@ -10673,8 +10690,68 @@ and narrows (c : Ast.expr) = match c.Ast.e with | Ast.Call ({ Ast.e = Ast.Var "?"; _ }, [ { Ast.e = Ast.Var x; _ } ]) -> [ x ] | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) -> narrows p @ narrows q + | Ast.IfLet (_, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ }, + Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> narrows q | _ -> [] +and as_binds c = Ast.as_binds c + +and as_name g = Ast.as_name g + +(* A condition with [as] in it, as the bool it tests, and each name it binds + with the hidden name the block reads it through. The chain runs left to + right and stops at the first test that fails, so each value is found + once; what an [as] finds is copied into its name's slot there, and a + later test and the block read that slot. *) +and as_cond ctx (c : Ast.expr) = + let named = ref [] in + let no loc = mk loc Types.Bool (Tast.Bool false) in + let rec go (c : Ast.expr) = + let loc = c.Ast.loc in + match c.Ast.e with + | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) when as_binds q <> [] -> + let pv = check_truthy ctx p in + let qv = with_narrowed ctx (narrows p) (fun () -> go q) in + mk loc Types.Bool (Tast.If (pv, qv, no loc)) + | Ast.IfLet (e, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ }, + Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> + let ev = check ctx e in + let hs = fresh_slot ctx ev.Tast.ty in + let hv = mk loc ev.Tast.ty (Tast.Local hs) in + let test, payload, ty = + match ev.Tast.ty with + | Types.Option t -> (opt_is_some loc hv, opt_payload loc t hv, t) + | Types.Dyn -> (dyn_not_nil loc hv, hv, Types.Dyn) + | t -> + Loc.failk "check/as-not-optional" e.Ast.loc + "%s is %s, which always holds a value, so as has nothing to test. \ + as names what an Option or a dyn holds, when it holds something. \ + It is not a conversion: a number is converted with its type's \ + name, as in i32(x)" + (source_text e) (tyname loc t) + in + let slot, qv = + scoped ctx (fun () -> + let slot = bind ctx g ty ~assignable:false in + (match lookup ctx g with + | Some b -> + incr held_n; + named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named + | None -> ()); + (slot, go q)) + in + mk loc Types.Bool + (Tast.Let ([ (hs, ev) ], + [ mk loc Types.Bool + (Tast.If (test, mk loc Types.Bool (Tast.Let ([ (slot, payload) ], [ qv ])), + no loc)) ])) + | _ -> check_truthy ctx c + in + let cv = go c in + let named = List.rev !named in + List.iter (fun (_, h, b) -> ctx.scope <- (h, b) :: ctx.scope) named; + (cv, List.map (fun (g, h, _) -> (g, h)) named) + (* [f] with each of [names] that is a local (Option T) read as its payload: the same slot, so a field set through it lands in the Option itself. A dyn stays as it is; a name that is not a local is not narrowed. Assigning @@ -10717,7 +10794,7 @@ and with_narrowed : 'a. ctx -> string list -> (unit -> 'a) -> 'a = fun ctx names (Printf.sprintf "%s? does not make %s its payload here: %s's address \ is taken, or a fn assigns it, in this function, so \ - something else could clear it. Write if %s? as g, \ + something else could clear it. Write if %s as g, \ which copies what it holds into g" n n n n) ] } in diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 3898b753..448d3ba8 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -994,7 +994,7 @@ let no_place (e : Form.t) = failk "chain-assign" e.loc "%s is an optional chain, and a chain cannot be assigned to: when it \ holds nothing there is no place to write. Test it first: if %s?, and \ - in the block %s is what it holds, or if %s? as g, then assign through g" + in the block %s is what it holds, or if %s as g, then assign through g" (text_of e) r r r | Form.List [ { v = Form.Sym "!!"; _ }; x ] -> let r = text_of x in @@ -1376,12 +1376,7 @@ and if_expr p = let t = advance p in let word = match t.tok with NAME w -> w | _ -> "if" in let letp = if word = "if" then if_let_head p else None in - let c = match letp with Some m -> m | None -> fst (binary p 1) in - let letp, c = - match letp with - | Some _ -> (letp, c) - | None -> (match as_head p c with Some m when word = "if" -> (Some m, m) | _ -> (None, c)) - in + let c = match letp with Some m -> m | None -> cond_head p in (match (peek p).tok with | NAME "then" -> ignore (advance p) | _ -> @@ -1422,35 +1417,79 @@ and if_let_head p = failk "if-let-name" pat.loc "if let %s = %s has no pattern to test. To test that %s holds a \ value, write if %s?, and in the block it is what it holds; to name \ - what it holds, write if %s? as %s" + what it holds, write if %s as %s" g (text_of v) (text_of v) (text_of v) (text_of v) g | _ -> ()); Some (mk p lt.loc (Form.Vec [ pat; v ])) | _ -> None -(* [e? as g]: after a test [e?], the name what [e] holds is bound to, as - the head [[g e]] an [if let] over a plain name stands as (decision 133). *) -and as_head p (c : Form.t) = +(* A condition, where [e as g] may stand as a test of a top-level [and] + chain (decisions 133, 136): [e] holds a value, and [g] names it for the + rest of the chain and the block. [e? as g] is the same test. Each binding + reads [(as g e)] in its test's place, in one flat [(and ...)]; the checker + gives [g] its scope. It cannot stand under [or] or [not], where the test + holding would not mean [e] held anything. *) +and cond_head p = + let x, lvl = binary p 1 in match (peek p).tok with - | NAME "as" -> - let at = advance p in - (match c.v with - | Form.List [ { v = Form.Sym "?"; _ }; e ] -> - let g = - match (peek p).tok with - | NAME g when g <> "" && g.[0] <> '.' -> - let gt = advance p in - check_name gt g; - sym gt.loc g - | tk -> - failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk) - in - Some (Form.make (Form.Vec [ g; e ]) c.loc) - | _ -> - failk "as-test" at.loc - "as names what a test found, and %s is not one. Write %s? as name" - (text_of c) (text_of c)) - | _ -> None + | NAME "as" -> as_chain p x lvl + | _ -> x + +and as_chain p (x : Form.t) lvl = + let at = advance p in + let refuse_or loc = + failk "as-or" loc + "as names what a test found, for the rest of an and chain and the \ + block. With or, the block can run when that test did not hold, and \ + there would be nothing to name. Bind with as in an if of its own, and \ + test the rest inside it" + in + let items (f : Form.t) = + match f.v with + | Form.List ({ v = Form.Sym "and"; _ } :: (_ :: _ as xs)) -> xs + | _ -> [ f ] + in + if lvl = 1 then refuse_or x.loc; + let before, last = + match List.rev (if lvl = 2 then items x else [ x ]) with + | last :: rb -> (List.rev rb, last) + | [] -> ([], x) + in + (match last.v with + | Form.List ({ v = Form.Sym "not"; _ } :: _) -> + failk "as-not" at.loc + "as names what a test found, and not turns the test around: the \ + block runs when %s holds nothing, so there is nothing to name. Bind \ + with as, and put what runs when it is absent in the else" + (text_of last) + | Form.List ({ v = Form.Sym "or"; _ } :: _) -> refuse_or last.loc + | _ -> ()); + let e = match last.v with Form.List [ { v = Form.Sym "?"; _ }; e ] -> e | _ -> last in + let g = + match (peek p).tok with + | NAME g when g <> "" && g.[0] <> '.' && not (is_op_word g) -> + let gt = advance p in + check_name gt g; + sym gt.loc g + | tk -> failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk) + in + let bound = Form.make (Form.List [ sym at.loc "as"; g; e ]) last.loc in + let rest = + match (peek p).tok with + | NAME "and" -> + ignore (advance p); + let y, ylvl = binary p 1 in + (match (peek p).tok with + | NAME "as" -> items (as_chain p y ylvl) + | _ -> + if ylvl = 1 then refuse_or y.loc; + if ylvl = 2 then items y else [ y ]) + | NAME "or" -> refuse_or (peek p).loc + | _ -> [] + in + match before @ (bound :: rest) with + | [ one ] -> one + | xs -> Form.make (Form.List (sym x.loc "and" :: xs)) x.loc (* The if an [if let] head was read into, rewritten to (if-let [P v] then else): [(if [P v] a b)], [(when [P v] body ...)] and an elif chain's @@ -2691,12 +2730,7 @@ and header (s : st) w : Form.t = form [ alias; path ] | "if" | "when" -> let letp = if w = "if" then if_let_head p else None in - let c = match letp with Some m -> m | None -> fst (binary p 1) in - let letp, c = - match letp with - | Some _ -> (letp, c) - | None -> (match as_head p c with Some m when w = "if" -> (Some m, m) | _ -> (None, c)) - in + let c = match letp with Some m -> m | None -> cond_head p 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. *) @@ -2713,11 +2747,7 @@ and header (s : st) w : Form.t = let c = match if_let_head p with | Some m -> elif_lets := m :: !elif_lets; m - | None -> - let c = fst (binary p 1) in - (match as_head p c with - | Some m -> elif_lets := m :: !elif_lets; m - | None -> c) + | None -> cond_head p in (match (peek p).tok with | NAME "then" when oneline -> @@ -2829,21 +2859,30 @@ and header (s : st) w : Form.t = | KW k, n when n <> NEWLINE -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ] | _ -> [] in - let c, _ = expr p in - (match (if w = "while" then as_head p c else None) with - (* [while e? as g]: [(while true (if-let [g e] (do body) (break)))]. A - break or continue in the body is this loop's. *) - | Some m -> - expect_line_end p ~after:(w ^ " " ^ text_of c ^ " as ..."); - let body = block s ~after:w in + let c = cond_head p in + let binds = + let is_as (f : Form.t) = + match f.v with Form.List ({ v = Form.Sym "as"; _ } :: _) -> true | _ -> false + in + match c.v with + | Form.List ({ v = Form.Sym "and"; _ } :: xs) -> List.exists is_as xs + | _ -> is_as c + in + if binds && w = "until" then + failk "as-until" c.Form.loc + "until runs while its test does not hold, so as would name what a \ + test found when it found nothing. Write while, with the test the \ + other way round"; + expect_line_end p ~after:(w ^ " " ^ text_of c); + let body = block s ~after:w in + if binds then + (* [while c]: [(while true (if c (do body) (break)))], so what [c] + binds reaches the body. A break or continue in the body is this + loop's, and a continue tests [c] again. *) let at = c.Form.loc in let f items = Form.make (Form.List items) at in - form (label @ [ sym at "true"; - f [ sym at "if-let"; m; f (sym at "do" :: body); f [ sym at "break" ] ] ]) - | None -> - expect_line_end p ~after:(w ^ " " ^ text_of c); - let body = block s ~after:w in - form (label @ (c :: body))) + form (label @ [ sym at "true"; f [ sym at "if"; c; f (sym at "do" :: body); f [ sym at "break" ] ] ]) + else form (label @ (c :: body)) | "for" -> let label = match (peek p).tok with diff --git a/lib/load.ml b/lib/load.ml index 1ac7734c..1809fecc 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -255,7 +255,9 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = (bound, []) bs in Ast.Let (List.rev bs, List.map (rename_expr owned alias bound) body) - | Ast.If (c, t, e') -> Ast.If (go c, go t, Option.map go e') + (* What an [as] in the condition binds is bound in the block. *) + | Ast.If (c, t, e') -> + Ast.If (go c, rename_expr owned alias (Ast.as_binds c @ bound) t, Option.map go e') | Ast.While (l, c, body) -> Ast.While (l, go c, gos body) (* A loop's names are its own and are never imported; its initial values and its body are ordinary expressions. *) diff --git a/lib/parse.ml b/lib/parse.ml index 757f8803..f34cefde 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -508,6 +508,8 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | _ -> fail f "?. is (?. [name value] body)") (* Short-circuiting, so they cannot be ordinary calls. *) + | Sym "and" when List.exists is_as args -> as_chain f args + | Sym "as" -> as_chain f [ f ] | Sym "and" -> shortcircuit f args ~is_and:true | Sym "or" -> shortcircuit f args ~is_and:false @@ -1303,6 +1305,28 @@ and cond f (args : Form.t list) : Ast.expr = actually fix it is check_if preferring the arm that is not a compiler temp when it reports, which is check.ml's call. Written up in TODO.org, "and's last operand gets a misdirected caret". *) +(* [(as g e)]: the test that [e] holds a value, naming it [g] (decision + 136). The reader writes one only as a condition or a test of the [and] + chain that is one. Each test of that chain is an [If] whose else is + [false], and each [as] an [IfLet] over the plain name [g] whose body is + the rest of the chain and whose else is [false]; [Check.as_cond] reads + that shape and gives [g] to the block the condition guards as well. *) +and is_as (f : Form.t) = + match f.v with List ({ v = Sym "as"; _ } :: _) -> true | _ -> false + +and as_chain f (args : Form.t list) : Ast.expr = + let no (x : Form.t) = { Ast.e = Ast.Var "false"; loc = x.loc } in + let rec go = function + | [] -> { Ast.e = Ast.Var "true"; loc = f.loc } + | [ x ] when not (is_as x) -> expr x + | ({ v = List [ { v = Sym "as"; _ }; { v = Sym g; _ }; e ]; _ } as x) :: rest -> + let arm = { Ast.pat = Ast.Pctor (g, []); body = [ go rest ]; aloc = x.loc } in + { Ast.e = Ast.IfLet (expr e, arm, Some (no x)); loc = x.loc } + | x :: _ when is_as x -> fail x "as is (as name value)" + | x :: rest -> { Ast.e = Ast.If (expr x, go rest, Some (no x)); loc = x.loc } + in + go args + and shortcircuit f (args : Form.t list) ~is_and : Ast.expr = let mk e = { Ast.e; loc = f.loc } in let rec go = function diff --git a/spec-syntax.md b/spec-syntax.md index d6b13f7d..cca64da6 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -287,7 +287,7 @@ Each item: the proposal, then the reason in one line. 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 plain name, `if let g = o`, is - refused toward `if o?` and `if o? as g` below; `_` is refused toward `let`. + refused toward `if o?` and `if o as g` below; `_` is refused toward `let`. **Built.** - **`x?` tests that a value is present** (decision 133): a bool, true when an Option is `Some` and when a dyn is not `nil`. It reads `(? x)`. In `if x?`, @@ -299,15 +299,33 @@ Each item: the proposal, then the reason in one line. present; giving it an Option is refused, and a parameter or a captured copy is no more assignable than outside it. A local whose address is taken, or that a `fn` assigns, anywhere in the function is not narrowed (something - else could clear it); `if x? as g` copies what it holds instead. A `?` after + else could clear it); `if x as g` copies what it holds instead. A `?` after a chain tests the whole chain: `o?.i?`. A capitalised name before `?` is read as a type, so a local tested this way needs a lowercase name. **Built.** -- **`e? as g`** names what a test found, for an `e` that is not a plain name: - `if get(grid, r, c)? as cell` reads `(if-let [cell (get grid r c)] …)`, an - `if-let` over a plain name, which binds what an Option holds or a dyn that - is not `nil`. It works after `if`, `elif` and `while`; `while e? as g` plus - a block reads `(while true (if-let [g e] (do …) (break)))`. **Built.** +- **`e as g`** tests that `e` holds a value and names it `g` (decisions 133, + 136): an Option that is `Some` binds its payload, a dyn that is not `nil` + binds itself. `e? as g` is the same test. Over any other type it is + refused; `as` is never a conversion, which is written `i32(x)`. It stands + after `if`, `elif`, `while` and a one-line `if … then` or kept `when`, as + the whole condition or as any test of an `and` chain, and `g` is bound for + the rest of that chain and for the block: Swift's `if let g = e, c`. + + ``` + if get(grid, r + 1, c - 1) as g and is-empty-cell(g) + move(g) + if a as x and b as y and x < y + println(x, y) + let left = when get(grid, r + 1, c - 1) as g and is-empty-cell(g) then g + ``` + + The tests run left to right and stop at the first that fails, so each + value is found once. `g` is not bound in the `else`, in an `elif` or after + the block. It is refused under `or` and `not`, and after `until`, where the + block could run with nothing found. `x?` on a plain local narrows beside it + in the same chain. Reads `(as g e)` in the test's place, `(when (and a (as + g e) (f g)) …)`; `while c` with one reads `(while true (if c (do …) + (break)))`. **Built.** - **`while c`, `until c`**, optional label first: `while :outer c`. **Built.** - **`for i in range(n)`**, `range(a, b)`, `range(a, b, step)` read as `dotimes`. `range` here is syntax, not a function. `..` is avoided because diff --git a/test/programs/as-chain-dyn.fln b/test/programs/as-chain-dyn.fln new file mode 100644 index 00000000..d7805607 --- /dev/null +++ b/test/programs/as-chain-dyn.fln @@ -0,0 +1,31 @@ +;; e as g over a dyn inside an and chain (decision 136): g is bound when e +;; is not nil, for the rest of the chain and the block. + +fn pet-name(m) + if m.pet as pet and pet != "cat" + pet + elif m.name as who and who != "bo" + who + else + "nobody" + +fn first-big(xs, lo) + let found = when get(xs, 0) as x and x > lo then x + found + +fn run(m, xs, a, b) + println(pet-name(m), pet-name({:pet "cat" :name "bo"}), pet-name({:name "ann"})) + println(first-big(xs, 0), first-big(xs, 5), first-big([], 0)) + let i = 0 + let total = 0 + while get(xs, i) as x and x > 0 + total += x + i += 1 + println(total, i) + if a? and get(xs, 1) as y and a + y > 4 + println(a + y) + let v = if b as z and z > 1 then z else -1 + println(v) + +fn main() + run({:pet "dog" :name "ann"}, [4, 2, 0, 7], 3, nil) diff --git a/test/programs/as-chain.fln b/test/programs/as-chain.fln new file mode 100644 index 00000000..eda9bc5b --- /dev/null +++ b/test/programs/as-chain.fln @@ -0,0 +1,90 @@ +;; e as g inside an and chain (decision 136): g is bound for the rest of the +;; chain and for the block, and not in the else, an elif or after the block. +;; e? as g is the same test. + +struct Grain + color-idx: i32 + +let calls: i32 = 0 + +fn get-cell(grid: [4 i32], i: i32) -> Grain? + calls += 1 + if i < 0 or i >= 4 + return None + Some(Grain{.color-idx grid[i]}) + +fn is-empty-cell(g: Grain) -> bool + g.color-idx < 0 + +fn tick(n: i32) -> i32 + calls += 1 + print(n, "") + n + +fn half(n: i32) -> i32? + calls += 1 + if n % 2 == 0 then Some(n / 2) else None + +fn classify(grid: [4 i32], i: i32) -> str + if get-cell(grid, i) as g and is-empty-cell(g) + "empty" + elif get-cell(grid, i) as g and g.color-idx > 1 + "big" + elif half(i) as h and h > 0 + "half" + else + "other" + +fn main() + let grid = [1, -1, 2, -3] + ;; A block if, with an else that does not see g. + let g = 100 + if get-cell(grid, 1) as g and is-empty-cell(g) + println("empty", g.color-idx) + if get-cell(grid, 0) as g and is-empty-cell(g) + println("empty", g.color-idx) + else + println("else sees the outer g", g) + println("after", g) + ;; A kept when gives a Grain?. + let left = when get-cell(grid, 3) as g and is-empty-cell(g) then g + println(left!.color-idx) + let none: Grain? = when get-cell(grid, 0)? as g and is-empty-cell(g) then g + println(none?) + ;; Two bindings, and a test over both. + let a: i32? = Some(3) + let b: i32? = Some(5) + if a as x and b as y and x < y + println(x, y) + if a as x and b as y and x > y + println(x, y) + else + println("not less") + ;; One line, in a let. + let v = if half(8) as h and h > 3 then h * 10 else -1 + let w = if half(6) as h and h > 3 then h * 10 else -1 + println(v, w) + ;; An elif chain. + println(classify(grid, 1), classify(grid, 2), classify(grid, 0), classify(grid, 4), classify(grid, 5)) + ;; Each value is found once, left to right, and a failed test stops the chain. + calls = 0 + if tick(1) > 0 and half(tick(2)) as h and tick(3) + h > 0 + println("ran", h) + println(calls) + calls = 0 + if tick(1) > 0 and half(tick(3)) as h and tick(5) + h > 0 + println("ran", h) + else + println("stopped") + println(calls) + ;; x? narrows beside as in one chain. + let n: i32? = Some(40) + if n? and half(n) as h and n + h > 50 + println(n + h) + ;; while: pop while the next cell is empty. + let i = 1 + let seen = 0 + while get-cell(grid, i) as c and is-empty-cell(c) + seen += c.color-idx + i += 2 + println(seen, i) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1233fb1c..1484a776 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2275,7 +2275,12 @@ let () = outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want) [ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out); (* x? tests and narrows, e? as g names what it found (decision 133). *) - ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; + ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n"); + (* e as g inside an and chain, typed and dyn (decision 136). *) + ("as-chain.fln", + "empty -1\nelse sees the outer g 100\nafter 100\n-3\nfalse\n3 5\nnot less\n40 -1\n\ + empty big other half other\n1 2 3 ran 1\n4\n1 3 stopped\n3\n60\n-4 5\n"); + ("as-chain-dyn.fln", "dog nobody ann\n4 nil nil\n6 2\n5\n-1\n") ]; (* x! over nothing traps at its site and names the expression. *) List.iter (fun (x86, arg, want) -> diff --git a/test/test_syntax.ml b/test/test_syntax.ml index d64e413d..8791d8a3 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -1409,21 +1409,49 @@ let () = found; if let over a plain name is refused toward those. *) refuses "if let over a plain name" "if let g = x\n g" "indent/if-let-name" "write if x?, and in the block it is what it holds; to name what it holds, \ - write if x? as g"; + write if x as g"; reads "x? is a test" "y = f(x)? and not z.w?" "(set y (and (? (f x)) (not (? (.w z)))))"; reads "e? as g" "if f(x)? as g\n g\nelif y? as h\n h\nelse\n 0" - "(if-let [g (f x)] g (if-let [h y] h 0))"; - reads "one-line e? as g" "v = if y? as h then h else 0" "(set v (if-let [h y] h 0))"; + "(cond (as g (f x)) g (as h y) h :else 0)"; + reads "one-line e? as g" "v = if y? as h then h else 0" "(set v (if (as h y) h 0))"; reads "while e? as g" "while pop(s)? as x\n f(x)" - "(while true (if-let [x (pop s)] (do (f x)) (break)))"; - refuses "as after no test" "if x as y\n y" "indent/as-test" "Write x? as name"; + "(while true (if (as x (pop s)) (do (f x)) (break)))"; + (* Decision 136: e as g without the ?, and inside an and chain. *) + reads "e as g" "if f(x) as g\n g" "(when (as g (f x)) g)"; + reads "as in an and chain" "if a and f(x) as g and g > 1 and b\n g" + "(when (and a (as g (f x)) (> g 1) b) g)"; + reads "two as in one chain" "v = if a as x and b? as y and x < y then x else y" + "(set v (if (and (as x a) (as y b) (< x y)) x y))"; + reads "a kept when with as" "left = when get(grid, r + 1, c - 1) as g and is-empty-cell(g) then g" + "(set left (when (and (as g (get grid (+ r 1) (- c 1))) (is-empty-cell g)) g))"; + reads "while as and" "while pop(s) as x and x > 0\n f(x)" + "(while true (if (and (as x (pop s)) (> x 0)) (do (f x)) (break)))"; + reads "elif as and" "if a\n 1\nelif f(x) as g and g > 1\n g" + "(cond a 1 (and (as g (f x)) (> g 1)) g)"; + refuses "as under or" "if a or f(x) as g\n g" "indent/as-or" "Bind with as in an if of its own"; + refuses "or after as" "if f(x) as g or b\n g" "indent/as-or" "nothing to name"; + refuses "or later in the chain" "if f(x) as g and a or b\n g" "indent/as-or" "nothing to name"; + refuses "as under not" "if not f(x) as g\n g" "indent/as-not" "not turns the test around"; + refuses "as after until" "until f(x) as g\n g" "indent/as-until" "Write while"; + refused "as-not-optional.fln" "fn main()\n let n = 5\n if n as g and g > 1\n println(g)\n" + [ "n is i32, which always holds a value, so as has nothing to test"; + "It is not a conversion" ]; + refused "as-not-in-else.fln" + "fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n else\n g\n\nfn main()\n println(f(None))\n" + [ "unknown name g" ]; + refused "as-not-in-elif.fln" + "fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n elif g > 0\n 1\n else\n 0\n\nfn main()\n println(f(None))\n" + [ "unknown name g" ]; + refused "as-not-after.fln" + "fn f(o: i32?) -> i32\n if o as g and g > 1\n println(g)\n g\n\nfn main()\n println(f(None))\n" + [ "unknown name g" ]; refused "present-i32.fln" "fn main()\n let x = 5\n println(x?)\n" [ "x is i32, which always holds a value, so x? has nothing to test"; "a yes-or-no name starts with is- or has-, as in is-x" ]; refused "narrowed-set.fln" "fn main()\n let x: i32? = Some(1)\n if x?\n x = None\n println(x ?? 0)\n" [ "x is tested with x? above, so in this block it is i32"; - "while x? as item" ]; + "while x as item" ]; refused "not-narrowed-in-else.fln" "fn main()\n let x: i32? = None\n if x?\n println(x + 1)\n else\n println(x + 1)\n" [ "Option(i32)" ]; @@ -1457,7 +1485,7 @@ let () = reads "a trailing ? tests the whole chain" "y = o?.i?" "(set y (? (?. [~o1 o] (.i ~o1))))"; reads "and ? then as binds the chain's result" "if d?.k? as k\n k" - "(if-let [k (?. [~o1 d] (.k ~o1))] k)"; + "(when (as k (?. [~o1 d] (.k ~o1))) k)"; refused "narrowed-param.fln" "fn f(x: i32?)\n if x?\n x += 100\n\nfn main()\n f(Some(1))\n" [ "x is a parameter, and a parameter is not assignable" ]; @@ -1465,7 +1493,7 @@ let () = "fn main()\n let x: i32? = Some(1)\n if x?\n x.n = 1\n" [ "so here it is what the Option holds, i32, and i32 has no fields" ]; refuses "a chain is no place, and the fix is a test" "q?.x = 5" "indent/chain-assign" - "Test it first: if q?, and in the block q is what it holds, or if q? as g"; + "Test it first: if q?, and in the block q is what it holds, or if q as g"; refused "lowercase-type-arg.fln" "struct grain\n w: i32\n\nfn main()\n let v = vec-new(grain?)\n" [ "grain? here is the test that a value is present, and grain is a type"; @@ -1826,9 +1854,9 @@ let () = | _ -> fail "addr-taken-note.fln checked" | exception (Loc.Error d | Loc.Errors (d :: _)) -> if not (List.exists - (fun (n : Loc.note) -> Test_support.contains n.Loc.nmsg "Write if x? as g") + (fun (n : Loc.note) -> Test_support.contains n.Loc.nmsg "Write if x as g") d.Loc.notes) - then fail "addr-taken-note.fln: no note naming if x? as g on: %s" d.Loc.dmsg + then fail "addr-taken-note.fln: no note naming if x as g on: %s" d.Loc.dmsg | exception e -> fail "addr-taken-note.fln: %s" (diag_text e) let () = Test_support.report ~label:"syntax" () From cb60df1dc06cfe5969fea66642d97ff81962880d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:11:12 +0700 Subject: [PATCH 03/16] A T is wrapped in Some wherever a T? is wanted, one level at a time and never unwrapped back. --- TODO.org | 4 + lib/check.ml | 151 +++++++++++++++++++++++++++++++++++-- spec-syntax.md | 9 +++ test/programs/autowrap.fln | 85 +++++++++++++++++++++ test/test_acceptance.ml | 4 + test/test_flan.ml | 17 +++++ 6 files changed, 262 insertions(+), 8 deletions(-) create mode 100644 test/programs/autowrap.fln diff --git a/TODO.org b/TODO.org index 6fc9c65a..5c72e615 100644 --- a/TODO.org +++ b/TODO.org @@ -39,6 +39,10 @@ Decided (133): =x?= is a bool; =if x?=, =elif x?=, =while x?= and the rest of an make a local Option its payload in the block, in place (not a copy). Assigning an Option to it there is refused rather than ending the narrowing; =e? as g= names what a test found. Rules out =if let g = x= over a plain name, which is refused toward these. +** DONE A T is wrapped where a T? is wanted +CLOSED: [2026-09-26] +Decided (138), like Swift: one level per boundary, the literal built at T first; not +inside a container. Rules out implicit unwrapping: a T? where a T is wanted stays refused. ** TODO The stepper does not step inside an optional chain =Ast.step_expr= treats a =Chain= as a leaf (its catch-all), so nothing in a chain's body gets a step point of its own. diff --git a/lib/check.ml b/lib/check.ml index 48360e96..55f8206f 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -2891,6 +2891,13 @@ let rec bind_ty ?(widen = false) ?(ro = true) subst (pat : Types.t) bind_ty ~ro:(m = Types.Const) subst p a | Types.Vec p, Types.Vec a | Types.Option p, Types.Option a -> inner p a + (* A plain value at a [$t?] parameter binds [$t] to its own type, and + [expect] wraps it (decision 138). At the top of an argument only, as the + widening below: an element of a Vec is never wrapped, so [(Vec $t?)] + meets a [(Vec i32)] as a mismatch. *) + | Types.Option p, a + when widen && (match a with Types.Dyn | Types.Never -> false | _ -> true) -> + bind_ty ~widen subst p a | Types.Array (n, p), Types.Array (m, a) -> Int64.equal n m && inner p a | Types.Map (k, v), Types.Map (k', v') -> inner k k' && inner v v' (* Each function type against its own. *) @@ -3227,6 +3234,10 @@ let rec literal_arith (e : Ast.expr) : int64 option = over literals alone. *) let lone_literal (e : Ast.expr) = is_literal e || literal_arith e <> None +(* [None] as written, which has no type until an Option is asked of it. *) +let is_none_lit (e : Ast.expr) = + match e.Ast.e with Ast.Var "None" -> true | _ -> false + (* A value whose type comes only from defaults — a literal, [nil], [(Some 3)], arithmetic over literals, a [do] ending in one — so it takes the type of whatever meets it. An arm of this kind is checked after the others, at their type, @@ -4960,7 +4971,7 @@ let const_note ?(fln = false) env ~(want : Types.t) ~(got : Types.t) = (Types.spell ~indented:fln want) (Types.spell ~indented:fln got) | _ -> "" -let expect ctx loc ~want (got : Tast.expr) = +let rec expect ctx loc ~want (got : Tast.expr) = match want with | None -> got | Some w -> @@ -5033,6 +5044,21 @@ let expect ctx loc ~want (got : Tast.expr) = | (Types.Slice (Types.Const, _) | Types.Ptr (Types.Const, _)), _ when Types.const_widens ~from:got.Tast.ty ~into:w -> { got with Tast.ty = w } + (* Decision 138, Swift's rule: a T where a (Option T) is wanted is + [Some] of it. One level each time — a T? into a T?? is [Some] of the + Option, never the Option itself — and the payload goes through this + same boundary first, so a T into a T?? is [Some (Some t)] and an i32 + into an (Option i64) is widened, then wrapped. Never the other way: + a T? where a T is wanted is still refused, and a dyn is left to the + nil <-> None arms above. When the payload is refused too, the + refusal below names the Option, as it did before. *) + | Types.Option t, g + when (match g with Types.Dyn | Types.Never -> false | _ -> true) + && not (Types.fits ~expected:w ~actual:g) -> + (match expect ctx loc ~want:(Some t) got with + | v when Types.fits ~expected:t ~actual:v.Tast.ty -> mk loc w (Tast.Some_ v) + | _ -> got + | exception Loc.Error _ -> got) | _ -> got in if Types.fits ~expected:w ~actual:got.Tast.ty then got @@ -5133,8 +5159,16 @@ let arm_join (a : Types.t) (b : Types.t) = match Types.const_join a b with | Some j -> Some j | None -> + (* A T beside a T? meets at the T?, the T wrapped in [Some] + (decision 138). Only the plain side moves, and by one level. *) + let wraps p u = + (match u with Types.Option _ | Types.Unit -> false | _ -> true) + && (Types.equal p u || Types.widens_to ~from:u ~into:p) + in (match a, b with | Types.Dyn, _ | _, Types.Dyn -> Some Types.Dyn + | Types.Option p, u when wraps p u -> Some a + | u, Types.Option p when wraps p u -> Some b | _ -> None) (* The type two untyped literals meet at: the wider of their own types, and an integer beside a float at the float — [(if c 1 2.5)] is an f32, though @@ -6095,6 +6129,18 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = let used = ctx.used || List.memq e ctx.kept in ctx.used <- false; match e.Ast.e with + (* A literal where an (Option T) is wanted is built at T and then wrapped + (decision 138): [s = -1] over an [i64?] is [Some] of an i64 -1. It has + no type until one is asked of it, so it is asked the payload's, rather + than being built at a default and wrapped at the wrong width. *) + | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Call _ | Ast.Arr (_ :: _) + when (match want with Some (Types.Option _) -> true | _ -> false) + && (lone_literal e || (match e.Ast.e with Ast.Arr _ -> true | _ -> false)) -> + let w = Option.get want in + let t = match w with Types.Option t -> t | _ -> assert false in + let v = check ctx ~want:t e in + if Types.fits ~expected:t ~actual:v.Tast.ty then mk loc w (Tast.Some_ v) + else expect ctx loc ~want v (* A negative literal in a generic body, at an instantiation that made it unsigned. The cast the ordinary refusal names would be wrong at every other type the function is called at, so the fix is one that needs no @@ -8571,6 +8617,30 @@ and check_if_once ctx ~tail ~used ?want loc c t e = expect ctx loc ~want (mk loc Types.Dyn (Tast.If (c, t, e))) | ty -> let oty = Types.Option ty in + (* A later arm that is a T? where this one is a T: the arms meet at + T? (decision 138), so the chain is a T??, as it is when the T? + arm comes first. Tried only where the arm is refused at T. *) + let nested = + match want, ty with + | None, (Types.Option _ | Types.Unit) -> None + | None, _ -> + (match trial ctx (fun () -> rest ~used:true ~want:oty ()) with + | Ok e -> Some (Error e) + | Error _ -> + let ooty = Types.Option oty in + (match trial ctx (fun () -> rest ~used:true ~want:ooty ()) with + | Ok e -> Some (Ok e) + | Error _ -> None)) + | _ -> None + in + match nested with + | Some (Ok e) -> + let ooty = Types.Option oty in + let t = mk loc ooty (Tast.Some_ (mk loc oty (Tast.Some_ t))) in + mk loc ooty (Tast.If (c, t, e)) + | Some (Error e) -> + mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e)) + | None -> let e = rest ~used:true ~want:oty () in expect ctx loc ~want (mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e)))) @@ -8585,14 +8655,30 @@ and check_if_once ctx ~tail ~used ?want loc c t e = let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want e)) in mk loc t.Tast.ty (Tast.If (c, t, e)) - | Some e when want = None && adapts t && not (adapts e) + | Some e when want = None && (adapts t || is_none_lit t) + && not (adapts e || is_none_lit e) && not (and_sentinel e) -> (* A literal has no type of its own until something asks, so with no expectation the other arm decides: [(if c 4000000 n)] over an i64 [n] is an i64, as [(+ 4000000 n)] is. *) let e = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in let twant = if e.Tast.ty = Types.Never then None else Some e.Tast.ty in - let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:twant t)) in + let then_at w = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:w t)) in + (* [None] or [Some(1)] beside a plain T: the two meet at T?, the other + arm wrapped (decision 138). Tried only once the arm is refused at T, + so an arm that fits T is never an Option. *) + let t, e = + match e.Tast.ty with + | Types.Option _ | Types.Dyn | Types.Unit | Types.Never -> then_at twant, e + | ety -> + (match trial ctx (fun () -> then_at twant) with + | Ok t -> t, e + | Error _ -> + let oty = Types.Option ety in + (match trial ctx (fun () -> then_at (Some oty)) with + | Ok t -> t, expect ctx e.Tast.loc ~want:(Some oty) e + | Error _ -> then_at twant, e)) + in let ty = if e.Tast.ty = Types.Never then t.Tast.ty else e.Tast.ty in mk loc ty (Tast.If (c, t, e)) | Some e -> @@ -8656,7 +8742,24 @@ and check_if_once ctx ~tail ~used ?want loc c t e = | Some j -> Some (j, expect ctx v.Tast.loc ~want:(Some j) v) | None -> None in - match at_then () with + (* The else arm refused at T and fine at T? — [None], [Some(1)] — + and the two meet at T?, the then arm wrapped (decision 138). *) + let at_option () = + match t.Tast.ty with + | Types.Option _ | Types.Dyn | Types.Unit -> None + | ty -> + let oty = Types.Option ty in + (match + trial ctx (fun () -> + branch ctx (fun () -> in_tail (fun () -> check ctx ~want:oty e))) + with + | Ok v when Types.equal v.Tast.ty oty -> Some (oty, v) + | _ -> None) + in + (* Only where the arms met nowhere else, so nothing that met before + meets differently: a dyn else arm still meets at dyn. *) + match + (match at_then () with | Ok v -> (match opened_dyn ~box:(to_dyn ctx) v with | Some box -> Some (Types.Dyn, box) @@ -8683,7 +8786,10 @@ and check_if_once ctx ~tail ~used ?want loc c t e = | Some r -> Some r | None -> Some (t.Tast.ty, expect ctx v.Tast.loc ~want:(Some t.Tast.ty) v)) - | Error _ -> None) + | Error _ -> None)) + with + | None -> at_option () + | j -> j in match joined with | Some (j, v) -> @@ -9731,6 +9837,14 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = (* A keyword naming one of an enum's members is that member at the enum's type, not a dyn: [let d: Dir = :north]. *) && not (match ty, v.Ast.e with Types.Enum _, Ast.Kw _ -> true | _ -> false) + (* An array literal that is a dyn vector only because its elements do + not agree among themselves — [[1, None]] — is built at the annotation + when every element fits it, as [x: [2 i32?] = [1, None]] (decision + 138). Nothing is converted: the literal is built at T. *) + && not (match v.Ast.e, ty with + | Ast.Arr _, (Types.Array (_, Types.Option _) | Types.Slice (_, Types.Option _)) -> + probe ctx loc (fun () -> ignore (check ctx ~want:ty v)) <> None + | _ -> false) then begin let tn = tyname loc ty in let numeric = match ty with Types.Int _ | Types.Float _ -> true | _ -> false in @@ -10319,6 +10433,19 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals (head, (ctx.scope, ctx.ret), w, d); Error d) in + (* Where it would be refused: an arm fine at T? — [None], + [Some(1)] — meets a T join at T? (decision 138), and + [arm_join] wraps the arms before it. *) + let refused () = + let fallback () = at !want () in + match w with + | Types.Option _ | Types.Dyn | Types.Unit -> fallback () + | _ -> + let oty = Types.Option w in + (match trial ctx (at (Some oty)) with + | Ok b when Types.equal b.Tast.ty oty -> b + | _ -> fallback ()) + in match at_join () with | Ok b -> (match opened_dyn ~box:(to_dyn ctx) b with @@ -10334,10 +10461,10 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals with | Ok b -> b | Error own when String.equal own.Loc.kind not_kept -> - at !want () + refused () | Error own when is_mismatch d && not (is_mismatch own) -> at None () - | Error _ -> at !want ()) + | Error _ -> refused ()) else block ctx ?want:!want a.Ast.aloc a.Ast.body in let body = @@ -16610,6 +16737,12 @@ and generic_call ctx ~want loc name vars pats pret args = call with no type variables in it. *) | _ -> (match subst_ty !subst pat, a.Tast.ty with + (* A plain value at a [$t?] parameter, which [bind_ty] bound + through the Option: wrapped now that $t is known (decision + 138). *) + | Types.Option _ as o, at + when (match at with Types.Option _ | Types.Dyn | Types.Never -> false | _ -> true) -> + expect ctx a.Tast.loc ~want:(Some o) a | Types.Fn (ps, r), Types.CFn (ps', r') -> if Types.equal (Types.Fn (ps, r)) (Types.Fn (ps', r')) then mk a.Tast.loc (Types.Fn (ps, r)) @@ -17565,7 +17698,9 @@ let builtins : (string * string * string) list = (* Option *) ("Some", "Some [T] (Option T)", "Wraps a value as a present Option. None is the other half, and is \ - written as a name rather than as a call."); + written as a name rather than as a call. Where an (Option T) is \ + expected a T is wrapped with no Some written, one level at a time; an \ + Option is never unwrapped that way."); (* the host primitives *) ("bytes", "bytes [str Allocator?] [u8]", diff --git a/spec-syntax.md b/spec-syntax.md index d6b13f7d..3b45f7b0 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -217,6 +217,15 @@ Each item: the proposal, then the reason in one line. holds — `a?.f(x)`, `a?[i]`, `a?.b.c`. A result that is already an Option is not wrapped again, so `a?.b?.c` is one Option. A rest with no value makes the whole a statement. `~o1` is a fresh name no reader produces. + - A `T` where a `T?` is wanted is `Some` of it (decision 138): an + assignment, a `let` with a type, an argument, a return, a struct field, an + array or `Vec` element, and an `if` or `match` arm beside an Option arm. + A literal is built at `T` first, so `s = -1` over an `i64?` is `Some(-1)` + at i64. One level at a time: a `T` into a `T??` is `Some(Some(t))`, a `T?` + into a `T??` is `Some` of it. A `$t` meeting `$u?` binds `$u` to `T`. + Never inside a container (`Vec(i32)` is not a `Vec(i32?)`), and never the + other way: a `T?` where a `T` is wanted still needs `!`, `??`, `x?` or + `as`. A kept chain whose arms are a `T` and a `T?` is a `T??`. **Built.** - **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`, `max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.** diff --git a/test/programs/autowrap.fln b/test/programs/autowrap.fln new file mode 100644 index 00000000..636f94ec --- /dev/null +++ b/test/programs/autowrap.fln @@ -0,0 +1,85 @@ +;; A T where a T? is wanted is Some of it (decision 138): each position, +;; a literal built at the payload's type, nested Options, generics, and the +;; arms of an if, a match and a kept chain. + +struct P + a: i64? + b: i32? + +fn show(o: i32?) -> i32 = o ?? -9 + +fn back(b: bool, x: i32) -> i32? + if b + return x + None + +fn pick(b: bool, x: i32) -> i32? + if b then x else None + +fn pick2(b: bool, x: i32) -> i32? + if b then None else x + +fn two(o: Option(i32?)) -> str + match o + Some(i) -> if i? then "some some" else "some none" + None -> "none" + +fn first(o: $u?) -> $u = o! + +fn wrap(x: $t) -> $t? = x + +fn chain(a: bool, b: bool, opt: i32?) -> Option(i32?) + if a + 1 + elif b + opt + +fn main() + ;; assignment, and a literal at the payload's width + let s: i64? = None + s = -1 + println(s ?? 0) + ;; a let with an annotation, from a literal, a name and arithmetic + let x: i32 = 4 + let a: i32? = x + 1 + let w: i64? = x + let f: f64? = 2 + println(a ?? 0, w ?? 0, f ?? 0.0) + ;; an argument and a return value + println(show(7), back(true, 8) ?? -1, back(false, 8) ?? -1) + ;; a struct field + let p = P{.a 3 .b x} + println(p.a ?? 0, p.b ?? 0) + ;; an array and a Vec element + let xs: [3 i32?] = [1, None, x] + println(xs[0] ?? 0, xs[1] ?? 0, xs[2] ?? 0) + let v: Vec(i32?) = vec-new(i32?) + push(v, 6) + push(v, None) + println(length(v), v[0] ?? 0, v[1] ?? 0) + ;; the arms of an if and a match + println(pick(true, 2) ?? -1, pick(false, 2) ?? -1, pick2(true, 2) ?? -1, pick2(false, 2) ?? -1) + let m = match x + 4 -> x + _ -> None + println(m ?? 0) + ;; nested: a T into a T?? is Some(Some(t)), a T? is Some of it + let nn: Option(i32?) = 5 + let none: i32? = None + let nn2: Option(i32?) = none + println(two(nn), two(nn2)) + ;; a kept chain: a T arm beside a T? arm makes the chain a T?? + println(two(chain(true, false, none)), two(chain(false, true, none)), two(chain(false, false, none))) + let kk = + if x > 9 + none + elif x > 1 + 1 + println(two(kk)) + ;; generics + println(first(9), first(Some(8)), wrap(3) ?? 0) + ;; a narrowed name still takes a payload value + let o: i32? = Some(1) + if o? + o = 10 + println(o) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1233fb1c..7fb8e826 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2274,6 +2274,10 @@ let () = outputs ~opt:"-O0" (path ^ ", -O0") ("programs/" ^ path) want; outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want) [ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out); + (* A T where a T? is wanted is Some of it (decision 138). *) + ("autowrap.fln", + "-1\n5 4 2\n7 8 -1\n3 4\n1 0 4\n2 6 0\n2 -1 -1 2\n4\nsome some some none\n\ + some some some none none\nsome some\n9 8 3\n10\n"); (* x? tests and narrows, e? as g names what it found (decision 133). *) ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; (* x! over nothing traps at its site and names the expression. *) diff --git a/test/test_flan.ml b/test/test_flan.ml index 59b8221e..b7298b55 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -8402,6 +8402,23 @@ let () = parse_rejects "_ in a defgeneric's return slot" ~needle:"defgeneric's methods each have their own" "(defgeneric area [s] _)"; + (* Decision 138: a T is wrapped where a T? is wanted, and never the other + way. The program half is programs/autowrap.fln. *) + accepts "a T is Some of it at a T?" "(defn f [] (Option i64) -1)\n(defn main [] ())"; + rejects_check "a T? is not unwrapped at a T" ~needle:"expected i32, found (Option i32)" + "(defn f [o (Option i32)] i32 o)\n(defn main [] ())"; + rejects_check "a T? argument is not unwrapped" ~needle:"expected i32, found (Option i32)" + "(defn g [x i32] i32 x)\n(defn f [o (Option i32)] i32 (g o))\n(defn main [] ())"; + rejects_check "a payload that does not fit is refused at the Option" + ~needle:"expected (Option i32), found str" + "(defn f [] (Option i32) \"no\")\n(defn main [] ())"; + rejects_check "a narrowing is not wrapped" ~needle:"expected (Option i32), found i64" + "(defn f [x i64] (Option i32) x)\n(defn main [] ())"; + rejects_check "no wrap inside a container" ~needle:"expected (Vec (Option i32)), found (Vec i32)" + "(defn f [v (Vec i32)] (Vec (Option i32)) v)\n(defn main [] ())"; + rejects_check "a narrowed name still refuses an Option" + ~needle:"it cannot be given an Option here" + "(defn main [] () (let [o (the (Option i32) (Some 1))] (when (? o) (set o (Some 2)))))"; (* A plain name binds what an Option or a dyn holds; over anything else it cannot fail, and is refused toward let. The program half is programs/if-let.flan and programs/optionals.fln. *) From 87709618f9fdf501402bc84f4e1884b7d7331621 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:15:24 +0700 Subject: [PATCH 04/16] An as chain's refusals quote the whole condition, and narrowing after an as is tested. --- lib/indent_reader.ml | 4 ++-- test/programs/as-chain.fln | 2 ++ test/test_acceptance.ml | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 448d3ba8..286b95db 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1473,7 +1473,7 @@ and as_chain p (x : Form.t) lvl = sym gt.loc g | tk -> failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk) in - let bound = Form.make (Form.List [ sym at.loc "as"; g; e ]) last.loc in + let bound = mk p last.loc (Form.List [ sym at.loc "as"; g; e ]) in let rest = match (peek p).tok with | NAME "and" -> @@ -1489,7 +1489,7 @@ and as_chain p (x : Form.t) lvl = in match before @ (bound :: rest) with | [ one ] -> one - | xs -> Form.make (Form.List (sym x.loc "and" :: xs)) x.loc + | xs -> mk p x.loc (Form.List (sym x.loc "and" :: xs)) (* The if an [if let] head was read into, rewritten to (if-let [P v] then else): [(if [P v] a b)], [(when [P v] body ...)] and an elif chain's diff --git a/test/programs/as-chain.fln b/test/programs/as-chain.fln index eda9bc5b..4bdd4055 100644 --- a/test/programs/as-chain.fln +++ b/test/programs/as-chain.fln @@ -81,6 +81,8 @@ fn main() let n: i32? = Some(40) if n? and half(n) as h and n + h > 50 println(n + h) + if half(6) as h and n? and n + h > 40 + println(n + h) ;; while: pop while the next cell is empty. let i = 1 let seen = 0 diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1484a776..7fc52f1f 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2279,7 +2279,7 @@ let () = (* e as g inside an and chain, typed and dyn (decision 136). *) ("as-chain.fln", "empty -1\nelse sees the outer g 100\nafter 100\n-3\nfalse\n3 5\nnot less\n40 -1\n\ - empty big other half other\n1 2 3 ran 1\n4\n1 3 stopped\n3\n60\n-4 5\n"); + empty big other half other\n1 2 3 ran 1\n4\n1 3 stopped\n3\n60\n43\n-4 5\n"); ("as-chain-dyn.fln", "dog nobody ann\n4 nil nil\n6 2\n5\n-1\n") ]; (* x! over nothing traps at its site and names the expression. *) List.iter From 09f1e4369fbc1e628cc2ca9b03d9b0954219f619 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:16:16 +0700 Subject: [PATCH 05/16] An Option plus a literal is refused at the operator, the literal having been wrapped. --- test/test_syntax.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/test_syntax.ml b/test/test_syntax.ml index d64e413d..be581142 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -1473,7 +1473,7 @@ let () = refused "addr-taken.fln" "fn clear(p: Ptr(i32?))\n deref(p) = None\n\nfn main()\n let x: i32? = Some(1)\n\ \ let p = addr(x)\n if x?\n clear(p)\n println(x + 1)\n" - [ "expected Option(i32)" ]; + [ "+ takes numbers, found Option(i32)" ]; refused "capital-local.fln" "fn main()\n let X: i32? = Some(1)\n println(X?)\n" [ "To test the local X, give it a lowercase name, as in x?" ]; checks "addr-taken-test.fln" From 4d85cefbe2e4cdad326e08de22ebf3b6e03078d0 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:18:29 +0700 Subject: [PATCH 06/16] A bare nil in a typed fold is refused in every position while a dyn holding nil traps, a fold operand asked on its own terms records no literal-local use, and a wide literal at dyn says it has no dyn value. --- lib/check.ml | 137 ++++++++++++++++++++++++-------- test/programs/dyn-crossing.flan | 13 ++- test/test_acceptance.ml | 4 +- test/test_flan.ml | 66 ++++++++++++++- 4 files changed, 183 insertions(+), 37 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index e01bca51..c6acece6 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4986,6 +4986,56 @@ let const_note ?(fln = false) env ~(want : Types.t) ~(got : Types.t) = (Types.spell ~indented:fln want) (Types.spell ~indented:fln got) | _ -> "" +let nil_has_no_none loc w = + fail loc + "nil has no None to become at %s — nil only converts to (Option T) \ + or to dyn itself; wrap the type in Option, or keep the value dyn" + (tyname loc w) + +(* A literal boxed where a dyn was wanted, and the literal. It brings no dyn + of its own to an operator: (+ nil 1) over a literal 1 checked at dyn is as + typed as (+ nil x) over an i32 x. *) +let boxed_literal (e : Tast.expr) = + match e.Tast.e with + | Tast.Prim (Tast.Rt ("flan_dyn_from_i64" | "flan_dyn_from_f64" + | "flan_dyn_from_char" | "flan_dyn_from_bool"), [ x ]) -> + let x = match x.Tast.e with Tast.Prim (Tast.Cast _, [ y ]) -> y | _ -> x in + (match x.Tast.e with + | Tast.Int (n, _) when x.Tast.ty <> Types.Char -> + (* The type the literal takes where nothing is wanted. *) + let k = + if Int64.compare n (Int64.of_int32 Int32.max_int) > 0 + || Int64.compare n (Int64.of_int32 Int32.min_int) < 0 + then Types.I64 else Types.I32 + in + Some (Types.Int k) + | Tast.Int _ | Tast.Float _ | Tast.Bool _ -> Some x.Tast.ty + | _ -> None) + | _ -> None + +(* The operands of an arithmetic, bitwise or ordering operator gone dyn, + before they are boxed: a literal [nil] among them with nothing else dyn is + refused as [expect] refuses it at a typed want, whichever position it is + in and whether or not the form has a want. A dyn that holds nil is the + run-time trap's, so (+ 1 2 nil) is refused and (+ 1 2 (the dyn nil)) + traps. [=] and [!=] ask no such question: nil is unequal to a number. *) +let no_bare_nil (ops : Tast.expr list) = + match List.find_opt is_nil_lit ops with + | None -> () + | Some nil -> + let makes_dyn (e : Tast.expr) = + e.Tast.ty = Types.Dyn && not (is_nil_lit e) && boxed_literal e = None + in + if not (List.exists makes_dyn ops) then + match + List.find_map + (fun (e : Tast.expr) -> + if e.Tast.ty <> Types.Dyn then Some e.Tast.ty else boxed_literal e) + ops + with + | Some t -> nil_has_no_none nil.Tast.loc t + | None -> () + let expect ctx loc ~want (got : Tast.expr) = match want with | None -> got @@ -5009,11 +5059,7 @@ let expect ctx loc ~want (got : Tast.expr) = actually see — the literal, written right where the mismatch is. Refused here, at the offending line, instead of waiting for the runtime trap [unbox] would otherwise reach for two arms down. *) - | w, Types.Dyn when is_nil_lit got -> - fail loc - "nil has no None to become at %s — nil only converts to (Option T) \ - or to dyn itself; wrap the type in Option, or keep the value dyn" - (tyname loc w) + | w, Types.Dyn when is_nil_lit got -> nil_has_no_none loc w | _, Types.Dyn when Types.fits ~expected:w ~actual:Types.Dyn -> got | (Types.String | Types.Slice _ | Types.Array _), Types.Dyn -> let opened = into_typed ctx loc w got in @@ -6817,6 +6863,13 @@ and int_literal loc ~want ?(preds = []) ?(default = Types.I32) n = (tyname loc other) n | _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default)) +(* A wide literal where a dyn is wanted. A global's initialiser adds the fix + (its type); anywhere else there is nothing to retype. *) +and wide_at_dyn s = + Printf.sprintf + "expected dyn, found the integer literal %s, which is above the largest \ + dyn int (9223372036854775807), so it has no dyn value" s + (* An integer written at or above 2^63, in decimal or in hex. Only a u64 holds one, so it is accepted there and refused everywhere else, in the spelling it was written in — its pattern read as an i64 is a different number. *) @@ -6835,12 +6888,7 @@ and wide_literal loc ~want n s = "%s does not fit in i32, the type an integer literal takes when nothing \ says otherwise — write (u64 %s) for a u64" s s - | Some Types.Dyn -> - Loc.failk literal_at_want loc - "expected dyn, found the integer literal %s, which only a u64 holds — a \ - dyn integer is an i64, and no i64 is this large. Give what holds it \ - the type u64" - s + | Some Types.Dyn -> Loc.failk literal_at_want loc "%s" (wide_at_dyn s) | Some other -> Loc.failk literal_at_want loc "expected %s, found the integer literal %s, which only a u64 holds" @@ -9806,6 +9854,10 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = v.Ast.loc items | _ -> expect ctx v.Ast.loc ~want:(Some ty) (check ctx ~want:ty v) in + (* (the dyn nil) is a dyn value that holds nil, not the literal: at a typed + want it traps at run time as any dyn holding nil does, where a bare nil + is refused ([is_nil_lit] sees through nothing, so the [Do] hides it). *) + let r = if is_nil_lit r && ty = Types.Dyn then mk loc Types.Dyn (Tast.Do [ r ]) else r in expect ctx loc ~want r (* [f] run for its answer alone: whatever it wrote into the context is put @@ -11903,13 +11955,24 @@ and fold_arg ctx ty (arg : Ast.expr) = match trial_at ctx arg ty with | Ok v -> fold_operand ctx ty v | Error _ -> - let own () = - let v = check ctx arg in - if v.Tast.ty = Types.Dyn then v else fail arg.Ast.loc "not a dyn" + (* Only asked, and asked with the literal locals' uses unrecorded: a + [trial] does not take back what the session recorded, and the operand + on its own terms is not how the program reads it unless it is a dyn — + (+ x y) over an int x and a float y would merge the two and move the + refusal onto x. A dyn is then checked again, recorded. *) + let unrecorded f = + match ctx.lits with + | Some s when s.recording -> + s.recording <- false; + Fun.protect ~finally:(fun () -> s.recording <- true) f + | _ -> f () in - match trial ctx own with - | Ok v -> `Dyn v - | Error _ -> fold_operand ctx ty (check ctx ~want:ty arg) + let is_dyn = + probe ctx arg.Ast.loc (fun () -> unrecorded (fun () -> (check ctx arg).Tast.ty)) + = Some Types.Dyn + in + if is_dyn then `Dyn (to_dyn ctx (check ctx arg)) + else fold_operand ctx ty (check ctx ~want:ty arg) (* A pair an arithmetic operator refused, when one operand is a char: that is the refusal to give, rather than the mismatch between the two. Asked @@ -12023,11 +12086,6 @@ and dyn_fold ctx ~want loc name first rest = no column — [here loc] is the same string literal [cast_dyn] hands the runtime, and the runtime prints it as a GNU prefix. *) let apply acc b = rt loc Types.Dyn sym [ acc; box ~ctx loc b; here loc ] in - let acc = - match first with - | [ a; b ] -> apply (box ~ctx loc a) b - | _ -> assert false - in let operand arg = if bitwise then begin let v = check ctx arg in @@ -12036,7 +12094,14 @@ and dyn_fold ctx ~want loc name first rest = end else check ctx ~want:Types.Dyn arg in - let acc = List.fold_left (fun acc arg -> apply acc (operand arg)) acc rest in + let rest = map_lr operand rest in + no_bare_nil (first @ rest); + let acc = + match first with + | [ a; b ] -> apply (box ~ctx loc a) b + | _ -> assert false + in + let acc = List.fold_left apply acc rest in expect ctx loc ~want acc (* The runtime's entry point for each bit operation on a dyn int. *) @@ -13483,7 +13548,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = two things being unalike is the answer to "are these equal", not an error. The orderings do trap, and rightly — there is no true answer to whether a string is less than a vector. *) - (* [ops] are every operand, boxed. *) + (* [ops] are every operand, not yet boxed. *) let dyn_chain ops = let sym = match name with @@ -13508,17 +13573,22 @@ and named_call ?(qualified = false) ctx ~want loc name args = mk loc Types.Bool (Tast.Prim (Tast.Not, [ cmp ])) else cmp in - let r = + let ops = match rest with - | [] -> link (box ~ctx loc a) (box ~ctx loc b) - | _ -> cmp_over ctx loc Types.Dyn ~pairs ~link (ops ()) + | [] -> [ a; b ] + | _ -> ops () + in + if not (String.equal sym "flan_dyn_eq") then no_bare_nil ops; + let r = + match List.map (box ~ctx loc) ops with + | [ a; b ] -> link a b + | ops -> cmp_over ctx loc Types.Dyn ~pairs ~link ops in expect ctx loc ~want r in if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then dyn_chain (fun () -> - box ~ctx loc a :: box ~ctx loc b - :: map_lr (fun e -> box ~ctx loc (check ctx ~want:Types.Dyn e)) rest) + a :: b :: map_lr (fun e -> check ctx ~want:Types.Dyn e) rest) else begin (* [=] and [!=] admit types [<] does not. A handle is one: a pair of numbers in one word and where being the same entity is the question the @@ -13560,8 +13630,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = dyn in it is a dyn comparison. *) if List.exists (function `Dyn _ -> true | `Typed _ -> false) rest then dyn_chain (fun () -> - box ~ctx loc a :: box ~ctx loc b - :: List.map (function `Dyn d -> d | `Typed v -> box ~ctx loc v) rest) + a :: b :: List.map (function `Dyn d -> d | `Typed v -> v) rest) else let ops = a :: b :: List.map (function `Typed v -> v | `Dyn d -> d) rest in @@ -13643,6 +13712,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = (fun (v : Tast.expr) -> if v.Tast.ty <> Types.Dyn then bits_operand ctx v.Tast.loc name v) [ a; b ]; + no_bare_nil [ a; b ]; expect ctx loc ~want (rt loc Types.Dyn (dyn_bits_sym name) [ box ~ctx loc a; box ~ctx loc b; here loc ]) end else begin @@ -19471,6 +19541,11 @@ let check_global env (d : Ast.decl) : Tast.global option = { Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc } | Ast.Init v -> let c = ctx () in + (match v.Ast.e with + | Ast.UInt (_, s) when ty = Types.Dyn -> + Loc.failk literal_at_want v.Ast.loc "%s. Give %s the type u64" + (wide_at_dyn s) n + | _ -> ()); let v = view_global_init := Some (n, kind); Fun.protect ~finally:(fun () -> view_global_init := None) diff --git a/test/programs/dyn-crossing.flan b/test/programs/dyn-crossing.flan index 41431fa0..4b80b47c 100644 --- a/test/programs/dyn-crossing.flan +++ b/test/programs/dyn-crossing.flan @@ -1,6 +1,6 @@ ;;;; Typed values crossing into dyn beside a dyn operand: a u64, a dyn nil past -;;;; a fold's first pair, and a $t bounded by is-numeric. With an argument, the -;;;; program runs the trap that argument names instead. +;;;; a fold's pair (a bare nil is refused, see test_flan), and an is-numeric $t. +;;;; With an argument, the program runs the trap that argument names instead. (defn add-dyn [x $t] dyn {:where (is-numeric $t)} @@ -54,6 +54,11 @@ (when (= a "nil-first") (println (+ (the dyn nil) 1 2))) (when (= a "nil-last") (println (+ 1 2 (the dyn nil)))) (when (= a "nil-less") (println (< 1 2 (the dyn nil)))) - (when (= a "nil-min") (println (min 1 2 nil))) - (when (= a "nil-bits") (println (bit-or 1 2 nothing)))))) + (when (= a "nil-min") (println (min 1 2 nothing))) + (when (= a "nil-bits") (println (bit-or 1 2 nothing))) + ;; At a typed want too: the dyn nil traps in any position. + (let [r (the i32 0)] + (when (= a "nil-want-first") (set r (+ (the dyn nil) 1 2))) + (when (= a "nil-want-last") (set r (+ 1 2 (the dyn nil)))) + (println r))))) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 4c35b408..c75a53ff 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5688,7 +5688,9 @@ level "1" "nil-last", "55:41", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)"; "nil-less", "56:41", "dyn <: int and nil"; "nil-min", "57:40", "dyn min: int and nil"; - "nil-bits", "58:41", "dyn bit-or: int and nil" ] + "nil-bits", "58:41", "dyn bit-or: int and nil"; + "nil-want-first", "61:50", "dyn: an i32 is wanted here, and this is nil"; + "nil-want-last", "62:46", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)" ] in List.iter (fun x86 -> diff --git a/test/test_flan.ml b/test/test_flan.ml index 0c7fa3e0..836e7433 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2066,6 +2066,70 @@ let () = rejects_check "nil at a bare T is refused at compile time" "(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))" ~needle:"nil has no None to become"; + (* A bare nil in an arithmetic, bitwise or ordering operator with nothing + else dyn is refused in every position, with or without a want; a dyn that + holds nil is left to trap at run time (dyn-crossing.flan). *) + (* The 1-based column of [sub] in [form], placed at column [base]. *) + let col_of base form sub = + let n = String.length sub in + let rec at i = if String.sub form i n = sub then i else at (i + 1) in + base + at 0 + in + List.iter + (fun form -> + List.iter + (fun (what, base, src) -> + let col = col_of base form "nil" in + match + (try ignore (checked src); None with Loc.Error d -> Some d) + with + | Some d when contains d.Loc.dmsg "nil has no None to become at i32" + && d.Loc.dloc.Loc.col = col -> () + | Some d -> + incr failures; + Printf.printf "FAIL a bare nil in %s, %s: got %d: %s\n" form what + d.Loc.dloc.Loc.col d.Loc.dmsg + | None -> + incr failures; + Printf.printf "FAIL a bare nil in %s, %s: accepted\n" form what) + [ "at a want", 16, + Printf.sprintf "(defn f [] i32 %s)\n(defn main [] i32 (f))" form; + "with none", 25, + Printf.sprintf "(defn f [] i32 (println %s) 0)\n(defn main [] i32 (f))" form ]) + [ "(+ nil 1 2)"; "(+ 1 nil 2)"; "(+ 1 2 nil)"; "(+ 1 nil)"; + "(< nil 1 2)"; "(< 1 2 nil)"; "(min 1 2 nil)"; "(bit-or nil 1 2)"; + "(bit-or 1 2 nil)" ]; + accepts "a dyn holding nil in a fold is left to the run time" + "(defn f [p dyn] i32 (+ 1 2 p (the dyn nil)))\n\ + (defn g [] i32 (let [r (the i32 0)] (set r (+ (the dyn nil) 1 2)) r))\n\ + (defn main [] i32 (println (< 1 2 (the dyn nil))) 0)"; + accepts "nil beside a real dyn in a fold is left to the run time" + "(defn f [p dyn] dyn (+ 1 2 p nil))\n(defn main [] i32 0)"; + (* An operand past the pair asked on its own terms records nothing: the + float y is blamed, not the int x it would have merged with. *) + List.iter + (fun form -> + let col = col_of 45 form "y)" in + match + (try ignore (checked ("(defn main [] i32 (let [x 5 y 2.5] (println " + ^ form ^ ")) 0)")); None + with Loc.Error d -> Some d) + with + | Some d when d.Loc.dloc.Loc.col = col -> () + | Some d -> + incr failures; + Printf.printf "FAIL %s blames col %d, not y at %d: %s\n" form + d.Loc.dloc.Loc.col col d.Loc.dmsg + | None -> incr failures; Printf.printf "FAIL %s: accepted\n" form) + [ "(+ (the i64 1) 2 (+ x y))"; "(* (the i64 1) 2 (* x y))"; + "(max (the i64 1) 2 (max x y))"; "(< (the i64 1) 2 (+ x y))" ]; + rejects_check "a wide literal at dyn with nothing to retype" + "(defn main [] i32 (println (the dyn 0xFFFFFFFFFFFFFFFF)) 0)" + ~needle:"0xFFFFFFFFFFFFFFFF, which is above the largest dyn int \ + (9223372036854775807), so it has no dyn value"; + rejects_check "a wide literal beside a dyn" + "(defn main [] i32 (println (+ (the dyn 0) 0xFFFFFFFFFFFFFFFF)) 0)" + ~needle:"so it has no dyn value"; (* A $t crosses into dyn only under a bound every type of which has a dyn value; an unbounded one could be a pointer, refused at no call site. *) rejects_check "an unbounded $t does not cross into dyn" @@ -8032,7 +8096,7 @@ let () = ~needle:"the member A of E is 0xFFFFFFFFFFFFFFFF, which does not fit i32"; rejects_check "a wide literal in a dyn global names the type u64" "(defonce big 0xFFFFFFFFFFFFFFFF)" - ~needle:"no i64 is this large. Give what holds it the type u64"; + ~needle:"so it has no dyn value. Give big the type u64"; accepts "the type the dyn refusal names compiles" "(defonce big u64 0xFFFFFFFFFFFFFFFF)"; (* A macro's Form has one integer case; the literal comes back wide all the From 89d54a47f45061e48345da5c274d7b8bfb2ffa42 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:21:06 +0700 Subject: [PATCH 07/16] A None arm written first in a match meets the other arms at their Option. --- lib/check.ml | 20 ++++++++++++++++++-- test/programs/autowrap.fln | 17 ++++++++++++++++- test/test_acceptance.ml | 4 ++-- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 55f8206f..38a04523 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -10367,8 +10367,24 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals let idx = List.mapi (fun i r -> (i, r)) resolved in if !want <> None then idx else - List.filter (fun (_, r) -> not (literal_arm r)) idx - @ List.filter (fun (_, r) -> literal_arm r) idx + let typed = List.filter (fun (_, r) -> not (literal_arm r)) idx in + (* A bare [None] that would be checked first has nothing to take its + type from and was always refused; it goes after the others, so it + meets their T at T? (decision 138). Only the leading ones move, so + no order that checked before changes. *) + let none_arm (_, ((a : Ast.arm), _, _)) = + match List.rev a.Ast.body with last :: _ -> is_none_lit last | [] -> false + in + let rec lead acc = function + | x :: rest when none_arm x -> lead (x :: acc) rest + | rest -> (List.rev acc, rest) + in + let nones, typed = + match lead [] typed with + | _ :: _ as nones, rest when List.length nones < List.length idx -> nones, rest + | _ -> [], typed + in + typed @ List.filter (fun (_, r) -> literal_arm r) idx @ nones in let checked = map_lr diff --git a/test/programs/autowrap.fln b/test/programs/autowrap.fln index 636f94ec..7b839efb 100644 --- a/test/programs/autowrap.fln +++ b/test/programs/autowrap.fln @@ -28,6 +28,16 @@ fn first(o: $u?) -> $u = o! fn wrap(x: $t) -> $t? = x +;; A generic body's own $t handed to a $u? parameter. +fn through(x: $t) -> $t = first(x) + +;; A None arm first takes its type from the arms after it. +fn arms(k: i32, x: i32) -> i32? + match k + 5 -> None + 4 -> x + _ -> 0 + fn chain(a: bool, b: bool, opt: i32?) -> Option(i32?) if a 1 @@ -50,9 +60,13 @@ fn main() ;; a struct field let p = P{.a 3 .b x} println(p.a ?? 0, p.b ?? 0) + p.b = 7 + println(p.b ?? 0) ;; an array and a Vec element let xs: [3 i32?] = [1, None, x] println(xs[0] ?? 0, xs[1] ?? 0, xs[2] ?? 0) + xs[1] = 5 + println(xs[1] ?? 0) let v: Vec(i32?) = vec-new(i32?) push(v, 6) push(v, None) @@ -63,6 +77,7 @@ fn main() 4 -> x _ -> None println(m ?? 0) + println(arms(5, 3) ?? -1, arms(4, 3) ?? -1, arms(1, 3) ?? -1) ;; nested: a T into a T?? is Some(Some(t)), a T? is Some of it let nn: Option(i32?) = 5 let none: i32? = None @@ -77,7 +92,7 @@ fn main() 1 println(two(kk)) ;; generics - println(first(9), first(Some(8)), wrap(3) ?? 0) + println(first(9), first(Some(8)), wrap(3) ?? 0, through(5)) ;; a narrowed name still takes a payload value let o: i32? = Some(1) if o? diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 7fb8e826..0f64c275 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2276,8 +2276,8 @@ let () = [ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out); (* A T where a T? is wanted is Some of it (decision 138). *) ("autowrap.fln", - "-1\n5 4 2\n7 8 -1\n3 4\n1 0 4\n2 6 0\n2 -1 -1 2\n4\nsome some some none\n\ - some some some none none\nsome some\n9 8 3\n10\n"); + "-1\n5 4 2\n7 8 -1\n3 4\n7\n1 0 4\n5\n2 6 0\n2 -1 -1 2\n4\n-1 3 0\n\ + some some some none\nsome some some none none\nsome some\n9 8 3 5\n10\n"); (* x? tests and narrows, e? as g names what it found (decision 133). *) ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; (* x! over nothing traps at its site and names the expression. *) From c60cc33b9516f8f2c1a9c4dece82cc2c6d7aefcd Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:30:44 +0700 Subject: [PATCH 08/16] A dyn operand in a fold's first pair keeps the form dyn at a typed want, so only the answer is opened and every position gives the same result. --- lib/check.ml | 15 ++++++++++++--- test/programs/dyn-crossing.flan | 17 +++++++++++++++++ test/test_acceptance.ml | 16 ++++++++++++++-- 3 files changed, 43 insertions(+), 5 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index c6acece6..84dd80ba 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -17212,8 +17212,17 @@ and binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want (x : Ast.expr) (y : Ast.exp let needs_want (f : Ast.expr) = is_literal f || (match f.Ast.e with Ast.Kw _ -> true | _ -> false) in + (* A dyn the want opened is put back: beside a dyn a typed operand gives + dyn (rule 117), so the pair is the dyn runtime's and only its answer + is opened at the want. Opening the operand first made (+ p 1 1) at an + i32 want an i32 add that wraps, where (+ 1 1 p) was a dyn add whose + answer traps at the i32. *) + let reopen (v : Tast.expr) = + if not dyn_ok then v + else match opened_dyn ~box:(to_dyn ctx) v with Some d -> d | None -> v + in if y_decides then begin - let b = check ctx ?want y in + let b = reopen (check ctx ?want y) in (* An integer literal before a char, under [+] or [-], is an integer: the pair is char arithmetic ([char_step]). *) let a = @@ -17240,7 +17249,7 @@ and binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want (x : Ast.expr) (y : Ast.exp what [needs_want] settles — a literal still gets the first operand's type, so [(+ x 1)] over a dyn x goes on building an i64 one. *) else if dyn_ok && not (needs_want y) then begin - let a = check ctx ?want x in + let a = reopen (check ctx ?want x) in (* y at [a]'s type first, and on its own terms only if that is refused: checking it both ways every time made a chain of these nested in their second operands twice as slow per level. A dyn @@ -17289,7 +17298,7 @@ and binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want (x : Ast.expr) (y : Ast.exp | None -> raise (Loc.Error d))) end else begin - let a = check ctx ?want x in + let a = reopen (check ctx ?want x) in match trial_at ctx y a.Tast.ty with | Ok b -> a, b | Error d -> diff --git a/test/programs/dyn-crossing.flan b/test/programs/dyn-crossing.flan index 4b80b47c..def9fecb 100644 --- a/test/programs/dyn-crossing.flan +++ b/test/programs/dyn-crossing.flan @@ -60,5 +60,22 @@ (let [r (the i32 0)] (when (= a "nil-want-first") (set r (+ (the dyn nil) 1 2))) (when (= a "nil-want-last") (set r (+ 1 2 (the dyn nil)))) + (set r (+ r (at-i32 a))) (println r))))) 0) + +;; A dyn beside typed operands at an i32 want: the whole form is dyn, and only +;; its answer is opened at i32, so every position wraps nowhere and traps alike. +(defn at-i32 [a str] i32 + (let [big (the dyn 2147483647) + none (the dyn nil)] + (cond + (= a "big-first") (+ big 1 1) + (= a "big-mid") (+ 1 big 1) + (= a "big-last") (+ 1 1 big) + (= a "big-pair") (+ 1 big) + (= a "big-shift") (<< big 1) + (= a "i32-nil-first") (+ none 1 1) + (= a "i32-nil-mid") (+ 1 none 1) + (= a "i32-nil-last") (+ 1 1 none) + :else 0))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 045f1acd..c10ec35e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5686,6 +5686,8 @@ level "1" "programs/dyn-crossing.flan" crossing_out; let too_big = "dyn: this u64 is 18446744073709551615, above the largest \ dyn int (9223372036854775807), so it has no dyn value" in + let too_wide n = + "dyn: an i32 is wanted here, and the int " ^ n ^ " is outside an i32's range" in let crossing_traps = [ "u64", "51:36", too_big; "u64-max", "52:40", too_big; @@ -5695,8 +5697,18 @@ level "1" "nil-less", "56:41", "dyn <: int and nil"; "nil-min", "57:40", "dyn min: int and nil"; "nil-bits", "58:41", "dyn bit-or: int and nil"; - "nil-want-first", "61:50", "dyn: an i32 is wanted here, and this is nil"; - "nil-want-last", "62:46", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)" ] + "nil-want-first", "61:47", "dyn +: nil and int, and it takes two numbers — (+ nil 1)"; + "nil-want-last", "62:46", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)"; + (* At an i32 want the form is dyn in every position and only its + answer is opened: no position wraps. *) + "big-first", "73:25", too_wide "2147483649"; + "big-mid", "74:23", too_wide "2147483649"; + "big-last", "75:24", too_wide "2147483649"; + "big-pair", "76:24", too_wide "2147483648"; + "big-shift", "77:25", too_wide "4294967294"; + "i32-nil-first", "78:29", "dyn +: nil and int, and it takes two numbers — (+ nil 1)"; + "i32-nil-mid", "79:27", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; + "i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)" ] in List.iter (fun x86 -> From d14cffa23af9a5522dd098b78c0e3d8c1ae93214 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:44:27 +0700 Subject: [PATCH 09/16] (the dyn ) beside nil traps at run time, and a dyn opened at f64 or bool traps at its site. --- lib/check.ml | 16 +++++++++++----- lib/emit.ml | 2 ++ runtime/flan_dyn.c | 12 ++++++++---- runtime/flan_dyn.h | 3 +++ test/programs/dyn-crossing.flan | 15 ++++++++++++++- test/test_acceptance.ml | 10 +++++++++- test/test_flan.ml | 4 ++++ 7 files changed, 51 insertions(+), 11 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 84dd80ba..fc987993 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4573,14 +4573,14 @@ module Found = Ephemeron.K1.Make (struct let mismatch_found : Types.t Found.t = Found.create 16 let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = - let need sym ty = rt loc ty sym [ e ] in + let need sym ty = rt loc ty sym [ e; here loc ] in match want with - | Types.Float Types.F64 -> need "flan_dyn_need_f64" dyn_f64 + | Types.Float Types.F64 -> need "flan_dyn_need_f64_at" dyn_f64 | Types.Bool -> (* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the language's own cast and cannot fail — the runtime already decided the value was a bool, so what comes back is 0 or 1. *) - widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32)) + widen loc Types.Bool (need "flan_dyn_need_bool_at" (Types.Int Types.I32)) (* Only a dyn char: an int is a number until (char n) converts it. *) | Types.Char -> rt loc Types.Char "flan_dyn_need_char" [ e; here loc ] (* Any integer width, checked at run time at this site (TODO.org, "Dyn @@ -9856,8 +9856,14 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = in (* (the dyn nil) is a dyn value that holds nil, not the literal: at a typed want it traps at run time as any dyn holding nil does, where a bare nil - is refused ([is_nil_lit] sees through nothing, so the [Do] hides it). *) - let r = if is_nil_lit r && ty = Types.Dyn then mk loc Types.Dyn (Tast.Do [ r ]) else r in + is refused. (the dyn 1) is likewise a dyn, not a literal that brings + nothing dyn to an operator ([no_bare_nil]). [is_nil_lit] and + [boxed_literal] see through nothing, so the [Do] hides both. *) + let r = + if ty = Types.Dyn && (is_nil_lit r || boxed_literal r <> None) then + mk loc Types.Dyn (Tast.Do [ r ]) + else r + in expect ctx loc ~want r (* [f] run for its answer alone: whatever it wrote into the context is put diff --git a/lib/emit.ml b/lib/emit.ml index d18cb4c3..c519af35 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5149,6 +5149,8 @@ declare ptr @flan_dev_literal(ptr, i64) declare i64 @flan_dyn_need_i64(i64) declare double @flan_dyn_need_f64(i64) declare i32 @flan_dyn_need_bool(i64) +declare double @flan_dyn_need_f64_at(i64, ptr, i64) +declare i32 @flan_dyn_need_bool_at(i64, ptr, i64) declare i32 @flan_dyn_need_i32(i64, ptr, i64) declare i64 @flan_dyn_need_int(i64, i32, ptr, i64) declare i64 @flan_dyn_int_of(i64) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 455bff6e..78a91b30 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -2817,11 +2817,14 @@ int64_t flan_dyn_need_i64(flan_dyn v) { * makes rather than a surprise somebody meets. Softening the check here is the * option not to take: this function sees a tag and nothing else, so it could * not tell (g 1) from (g (length xs)). */ -double flan_dyn_need_f64(flan_dyn v) { +/* The _at forms trap at the site the checker hands over; the plain ones are + * for C callers that have none. */ +double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) - trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); + trap1(loc, loclen, TYPE_TRAP, "f64", "a float was wanted", v); return dyn_num_value(v); } +double flan_dyn_need_f64(flan_dyn v) { return flan_dyn_need_f64_at(v, NULL, 0); } static const char *an(const char *w); /* forward: "a" or "an" */ @@ -2914,11 +2917,12 @@ uint32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) { flan_trap((const uint8_t *)"DynType", 7); } -uint8_t flan_dyn_need_bool(flan_dyn v) { +uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) - trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); + trap1(loc, loclen, TYPE_TRAP, "bool", "a bool was wanted", v); return (uint8_t)(dyn_payload(v) ? 1 : 0); } +uint8_t flan_dyn_need_bool(flan_dyn v) { return flan_dyn_need_bool_at(v, NULL, 0); } /* ── A numeric cast opening a box ─────────────────────────────────────── * diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index bfb8c85d..d938545c 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -306,6 +306,9 @@ void flan_dyn_emit_watch(flan_dyn v); int64_t flan_dyn_need_i64(flan_dyn v); double flan_dyn_need_f64(flan_dyn v); uint8_t flan_dyn_need_bool(flan_dyn v); +/* The same, trapping at the site [loc] names. */ +double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen); +uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen); /* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64 * u64: an int in range, or a char's code point where it fits (ASCII only * into a byte), as an i64 the caller narrows. Anything else traps at [loc]. diff --git a/test/programs/dyn-crossing.flan b/test/programs/dyn-crossing.flan index def9fecb..f4f61684 100644 --- a/test/programs/dyn-crossing.flan +++ b/test/programs/dyn-crossing.flan @@ -60,7 +60,7 @@ (let [r (the i32 0)] (when (= a "nil-want-first") (set r (+ (the dyn nil) 1 2))) (when (= a "nil-want-last") (set r (+ 1 2 (the dyn nil)))) - (set r (+ r (at-i32 a))) + (set r (+ r (at-i32 a))) (the-literal a) (println r))))) 0) @@ -79,3 +79,16 @@ (= a "i32-nil-mid") (+ 1 none 1) (= a "i32-nil-last") (+ 1 1 none) :else 0))) + +;; (the dyn ) is a dyn like any other: beside nil it traps at run +;; time, as a dyn bound to a name does. And opening one at f64 or bool names +;; its site. +(defn the-literal [a str] () + (let [x (the f64 0.0) + b false] + (when (= a "lit-int") (println (+ (the dyn 1) nil))) + (when (= a "lit-float") (println (+ (the dyn 1.5) nil))) + (when (= a "lit-bool") (println (+ (the dyn true) nil))) + (when (= a "lit-let") (let [d (the dyn 1)] (println (+ d nil)))) + (when (= a "want-f64") (set x (the dyn 3)) (println x)) + (when (= a "want-bool") (set b (the dyn 3)) (println b)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index c10ec35e..6cb47fec 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5708,7 +5708,15 @@ level "1" "big-shift", "77:25", too_wide "4294967294"; "i32-nil-first", "78:29", "dyn +: nil and int, and it takes two numbers — (+ nil 1)"; "i32-nil-mid", "79:27", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; - "i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)" ] + "i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)"; + (* (the dyn ) beside nil traps as a named dyn does, and an + f64 or bool opening names its site. *) + "lit-int", "89:36", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; + "lit-float", "90:38", "dyn +: float and nil, and it takes two numbers — (+ 1.5 nil)"; + "lit-bool", "91:37", "dyn +: bool and nil, and it takes two numbers — (+ true nil)"; + "lit-let", "92:57", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)"; + "want-f64", "93:35", "dyn f64: int, and a float was wanted — (f64 3)"; + "want-bool", "94:36", "dyn bool: int, and a bool was wanted — (bool 3)" ] in List.iter (fun x86 -> diff --git a/test/test_flan.ml b/test/test_flan.ml index 836e7433..9154491e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2103,6 +2103,10 @@ let () = "(defn f [p dyn] i32 (+ 1 2 p (the dyn nil)))\n\ (defn g [] i32 (let [r (the i32 0)] (set r (+ (the dyn nil) 1 2)) r))\n\ (defn main [] i32 (println (< 1 2 (the dyn nil))) 0)"; + accepts "nil beside (the dyn ) is left to the run time" + "(defn main [] i32\n\ + (println (+ (the dyn 1) nil) (+ (the dyn 1.5) nil) (+ (the dyn true) nil)\n\ + (< (the dyn 1) nil) (min 2 (the dyn 1.5) nil)) 0)"; accepts "nil beside a real dyn in a fold is left to the run time" "(defn f [p dyn] dyn (+ 1 2 p nil))\n(defn main [] i32 0)"; (* An operand past the pair asked on its own terms records nothing: the From b8e68a48f7ce4a80ca2cae056292a2bc5935424e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:45:44 +0700 Subject: [PATCH 10/16] A literal local read at T? takes T, None may come first in an if, an Option around an array of Options takes a literal, and a literal refused at T? names the Option. --- lib/check.ml | 55 +++++++++++++++++++++++++++++--------- test/programs/autowrap.fln | 29 ++++++++++++++++++++ test/test_acceptance.ml | 3 ++- test/test_flan.ml | 3 +++ 4 files changed, 77 insertions(+), 13 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 38a04523..d1816a4a 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3234,6 +3234,10 @@ let rec literal_arith (e : Ast.expr) : int64 option = over literals alone. *) let lone_literal (e : Ast.expr) = is_literal e || literal_arith e <> None +(* Set for one [check_value] entry: the literal is checked at the Option + itself, not wrapped, so a refusal names the Option (decision 138). *) +let skip_wrap = ref false + (* [None] as written, which has no type until an Option is asked of it. *) let is_none_lit (e : Ast.expr) = match e.Ast.e with Ast.Var "None" -> true | _ -> false @@ -3822,6 +3826,12 @@ let lit_admits kind (t : Types.t) = | `Box, t -> not (Types.equal t Types.Dyn) | _ -> false +(* What a use at [t] says about a literal local: an (Option T) wanted of it + says T, since the local is built at T and then wrapped (decision 138), so + [let w: i64? = x] makes [x] the i64 [let w: i64 = x] does. *) +let rec lit_payload (t : Types.t) = + match t with Types.Option p -> lit_payload p | t -> t + (* The rounds a session may take before its last guesses are checked as they stand. Merging makes two the usual count; the bound only stops a pathological program from looping. *) @@ -6128,19 +6138,26 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = ctx.tail <- false; let used = ctx.used || List.memq e ctx.kept in ctx.used <- false; + let skipping = !skip_wrap in + skip_wrap := false; match e.Ast.e with (* A literal where an (Option T) is wanted is built at T and then wrapped (decision 138): [s = -1] over an [i64?] is [Some] of an i64 -1. It has no type until one is asked of it, so it is asked the payload's, rather than being built at a default and wrapped at the wrong width. *) | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Call _ | Ast.Arr (_ :: _) - when (match want with Some (Types.Option _) -> true | _ -> false) + when (match want with Some (Types.Option _) -> not skipping | _ -> false) && (lone_literal e || (match e.Ast.e with Ast.Arr _ -> true | _ -> false)) -> let w = Option.get want in let t = match w with Types.Option t -> t | _ -> assert false in - let v = check ctx ~want:t e in - if Types.fits ~expected:t ~actual:v.Tast.ty then mk loc w (Tast.Some_ v) - else expect ctx loc ~want v + (match trial ctx (fun () -> check ctx ~want:t e) with + | Ok v when Types.fits ~expected:t ~actual:v.Tast.ty -> mk loc w (Tast.Some_ v) + | Ok v -> expect ctx loc ~want v + (* Refused at T: checked again at the Option as it was before 138, so + the refusal names what was wanted, [str?], and not only its payload. *) + | Error _ -> + skip_wrap := true; + check ctx ?want e) (* A negative literal in a generic body, at an instantiation that made it unsigned. The cast the ordinary refusal names would be wrong at every other type the function is called at, so the fix is one that needs no @@ -6991,18 +7008,19 @@ and var ctx ?(qualified = false) loc ~want name = | Some ({ blit = Some key; _ } as b) when (match ctx.lits, want with | Some s, Some t -> + let t = lit_payload t in s.recording && not !lit_quiet && (Types.equal t Types.Dyn || lit_admits (Option.value (lit_kind key) ~default:`Int) t) | _ -> false) -> - let s = Option.get ctx.lits and t = Option.get want in + let s = Option.get ctx.lits and t = lit_payload (Option.get want) in let operand = List.memq loc !lit_operand_locs in let c = if operand || Types.equal t Types.Dyn then Hint else Up in lit_add s key (c, t, loc); (try expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot)) with Loc.Error _ when lit_kind key <> Some `Box && not operand -> s.dirty <- true; - mk loc t (Tast.Local b.slot)) + expect ctx loc ~want (mk loc t (Tast.Local b.slot))) | Some b -> expect ctx loc ~want (local_of loc b) (* A local of the enclosing function, in a body that was lifted out of it: @@ -8655,8 +8673,11 @@ and check_if_once ctx ~tail ~used ?want loc c t e = let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want e)) in mk loc t.Tast.ty (Tast.If (c, t, e)) - | Some e when want = None && (adapts t || is_none_lit t) - && not (adapts e || is_none_lit e) + | Some e when want = None + && ((adapts t && not (adapts e || is_none_lit e)) + (* [if c then None else 5]: the else arm decides T, and + None meets it at T? below, as the other order does. *) + || (is_none_lit t && not (is_none_lit e))) && not (and_sentinel e) -> (* A literal has no type of its own until something asks, so with no expectation the other arm decides: [(if c 4000000 n)] over an i64 [n] @@ -9841,10 +9862,20 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = not agree among themselves — [[1, None]] — is built at the annotation when every element fits it, as [x: [2 i32?] = [1, None]] (decision 138). Nothing is converted: the literal is built at T. *) - && not (match v.Ast.e, ty with - | Ast.Arr _, (Types.Array (_, Types.Option _) | Types.Slice (_, Types.Option _)) -> - probe ctx loc (fun () -> ignore (check ctx ~want:ty v)) <> None - | _ -> false) + && not (let rec holds_option = function + | Types.Option _ -> true + | Types.Array (_, t) | Types.Slice (_, t) -> holds_option t + | _ -> false + in + let rec elems_option = function + | Types.Array (_, t) | Types.Slice (_, t) -> holds_option t + | Types.Option t -> elems_option t + | _ -> false + in + match v.Ast.e with + | Ast.Arr _ when elems_option ty -> + probe ctx loc (fun () -> ignore (check ctx ~want:ty v)) <> None + | _ -> false) then begin let tn = tyname loc ty in let numeric = match ty with Types.Int _ | Types.Float _ -> true | _ -> false in diff --git a/test/programs/autowrap.fln b/test/programs/autowrap.fln index 7b839efb..0db6c6ea 100644 --- a/test/programs/autowrap.fln +++ b/test/programs/autowrap.fln @@ -38,6 +38,8 @@ fn arms(k: i32, x: i32) -> i32? 4 -> x _ -> 0 +fn big(x: i64?) -> i64 = x ?? 0 + fn chain(a: bool, b: bool, opt: i32?) -> Option(i32?) if a 1 @@ -93,6 +95,33 @@ fn main() println(two(kk)) ;; generics println(first(9), first(Some(8)), wrap(3) ?? 0, through(5)) + ;; a literal local takes the payload's type from an Option use, as it + ;; takes T from a T use: each pair prints the same + let la = 4 + let wa: i64? = la + let lb = 4 + let wb: i64 = lb + println(la * 1000000000, lb * 1000000000, wa ?? 0, wb) + let lc = 4 + println(big(lc), lc * 1000000000) + let lf = 7 + let wf: f64? = lf + let lg = 7 + let wg: f64 = lg + println(lf / 2, lg / 2, wf ?? 0.0, wg) + let lu = 200 + let wu: u8? = lu + let lv = 200 + let wv: u8 = lv + println(wu ?? 0, wv) + ;; None first in an if, as in a match + let e1 = if x > 1 then None else 5 + let e2 = if x > 1 then 5 else None + println(e1 ?? -1, e2 ?? -1) + ;; an Option around an array of Options + let ao: [2 i32?]? = [1, None] + let ai = ao! + println(ai[0] ?? 0, ai[1] ?? 0) ;; a narrowed name still takes a payload value let o: i32? = Some(1) if o? diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 7504b036..09dfbad6 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2277,7 +2277,8 @@ let () = (* A T where a T? is wanted is Some of it (decision 138). *) ("autowrap.fln", "-1\n5 4 2\n7 8 -1\n3 4\n7\n1 0 4\n5\n2 6 0\n2 -1 -1 2\n4\n-1 3 0\n\ - some some some none\nsome some some none none\nsome some\n9 8 3 5\n10\n"); + some some some none\nsome some some none none\nsome some\n9 8 3 5\n\ + 4000000000 4000000000 4 4\n4 4000000000\n3.5 3.5 7 7\n200 200\n-1 5\n1 0\n10\n"); (* x? tests and narrows, e? as g names what it found (decision 133). *) ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; (* The pipe (decision 137): chains, multi-line, qualified, dyn, and the diff --git a/test/test_flan.ml b/test/test_flan.ml index b7298b55..0889c686 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -8412,6 +8412,9 @@ let () = rejects_check "a payload that does not fit is refused at the Option" ~needle:"expected (Option i32), found str" "(defn f [] (Option i32) \"no\")\n(defn main [] ())"; + rejects_check "a literal that does not fit is refused at the Option" + ~needle:"expected (Option string), found the integer literal 5" + "(defn f [] (Option string) 5)\n(defn main [] ())"; rejects_check "a narrowing is not wrapped" ~needle:"expected (Option i32), found i64" "(defn f [x i64] (Option i32) x)\n(defn main [] ())"; rejects_check "no wrap inside a container" ~needle:"expected (Vec (Option i32)), found (Vec i32)" From e4d0e9c60eed160de750f5d2ed90b044056b121f Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:52:06 +0700 Subject: [PATCH 11/16] A pause mark on any column of a condition keeps what it binds, an as in parentheses gets its own refusal, and what an as finds is held in one slot. --- TODO.org | 4 +++ lib/ast.ml | 25 +++++++++++++++++- lib/check.ml | 61 ++++++++++++++++++++++++++------------------ lib/indent_reader.ml | 7 +++++ lib/load.ml | 3 ++- lib/parse.ml | 9 +++++-- test/test_session.ml | 53 ++++++++++++++++++++++++++++++++++++++ test/test_syntax.ml | 4 +++ 8 files changed, 137 insertions(+), 29 deletions(-) diff --git a/TODO.org b/TODO.org index 8e81f037..de5fdfa9 100644 --- a/TODO.org +++ b/TODO.org @@ -819,6 +819,10 @@ One spelling for one operation; != stays, and not= is refused with a suggestion of !=. * Checker +** TODO An error in a callee's condition adds a bogus one at main +=fn f(a)= with a refused condition (=if n + 1= over an i32), and =fn main()= calling =f(3)= +last, also reports "main returns i32 or nothing, not Never": the recovered body reads as +Never and main's last form inherits it. ** TODO A u64 above the i64 maximum becomes -1 when it crosses into dyn =(+ z u)= and =(max u 0 z)= with u = u64 max read u as -1, silently. It should trap at the crossing, as a u64 field read through a view already does. diff --git a/lib/ast.ml b/lib/ast.ml index e20f43e4..a494b837 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -91,6 +91,10 @@ and expr_kind = (Option T) tested by [x?] in the condition above it, read as its payload ([if x?] narrowing, decision 133). *) | Narrow of string list * expr + (* Made by the checker, never read: [body] with each [(g, h)] reading [g] + as the binding of the hidden name [h], what an [as] in the condition + above found (decision 136). *) + | Alias of (string * string) list * expr | Struct of string * (string * expr) list (* (Cursor {.src s}) *) (* {.src s .pos 0} with no type written in front of it. The fields alone do not name a type, so this node carries no name and is only checkable where @@ -480,6 +484,7 @@ let map_children f (e : expr) : expr = | IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e) | Chain (n, v, b) -> Chain (n, ex v, ex b) | Narrow (ns, b) -> Narrow (ns, ex b) + | Alias (ps, b) -> Alias (ps, ex b) | Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs) | Bare fs -> Bare (List.map (fun (n, v) -> (n, ex v)) fs) | MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs) @@ -604,7 +609,14 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option = reports, and the line DWARF names, nowhere. *) { e with e = Do [ pause_call ?fn e.loc; e ] } end - else map_children walk e + else + match e.e with + (* A call's name is not a form of its own: a mark on it, the [?] of + [x?] or the [>] of [(> a b)], stops before the call. *) + | Call ({ e = Var _; loc = hl }, _) when at hl -> + hit := true; + { e with e = Do [ pause_call ?fn e.loc; e ] } + | _ -> map_children walk e in let body es = List.map walk es in let decl (d : decl) = @@ -641,7 +653,18 @@ let as_name g = g <> "" && (match g.[0] with 'A' .. 'Z' -> false | _ -> true) && g <> "true" && g <> "false" +(* [x] when [c] is [x] with a pause mark in front of it, [Do [pause; x]]: + [mark_pause] wraps whatever starts at the column marked, a test of a + condition's chain included, and the chain still means what it did. *) +let unpause (c : expr) = + match c.e with + | Do [ { e = Call ({ e = Var _; _ }, []); loc }; x ] when loc = x.loc -> Some x + | _ -> None + let rec as_binds (c : expr) = + match unpause c with + | Some x -> as_binds x + | None -> match c.e with | If (_, q, Some { e = Var "false"; _ }) -> as_binds q | IfLet (_, { pat = Pctor (g, []); body = [ q ]; _ }, Some { e = Var "false"; _ }) diff --git a/lib/check.ml b/lib/check.ml index 8771c299..9df157fb 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3184,8 +3184,12 @@ let unnarrowable_in (body : Ast.expr list) = List.iter (walk ~in_fn:false) body; !out +(* A name an [as] bound to what an Option held: the slot holding the Option, + read as its payload, as a narrowed local is, but not assignable. *) +let as_tag = "~as" + let local_of loc (b : binding) = - if b.bwhat = Some narrowed_tag then + if b.bwhat = Some narrowed_tag || b.bwhat = Some as_tag then mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1)) else mk loc b.bty (Tast.Local b.slot) @@ -6559,6 +6563,15 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = | Ast.Narrow (names, body) -> with_narrowed ctx names (fun () -> ctx.tail <- tail; ctx.used <- used; check ctx ?want body) + | Ast.Alias (pairs, body) -> + scoped ctx (fun () -> + List.iter + (fun (g, h) -> + match lookup ctx h with + | Some b -> ctx.scope <- (g, b) :: ctx.scope + | None -> ()) + pairs; + ctx.tail <- tail; ctx.used <- used; check ctx ?want body) (* Constant integer arithmetic where a type variable is wanted is folded to the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever [(+ x 3)] is. The instantiation re-checks the form unfolded, at a concrete @@ -8542,11 +8555,7 @@ and check_if_tested ctx ~tail ~used ?want loc c t e = write, bound in the scope this if was given; the else is checked without it. *) let cv, named = as_cond ctx c in - let bnd (g, h) = - { Ast.bname = g; bty = None; bval = { Ast.e = Ast.Var h; loc = t.Ast.loc }; - bloc = t.Ast.loc } - in - (cv, { t with Ast.e = Ast.Let (List.map bnd named, [ t ]) }) + (cv, { t with Ast.e = Ast.Alias (named, t) }) in (* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))] is how nearly every loop is written, and the branch is still the last @@ -10687,6 +10696,9 @@ and if_let_name ctx ~tail ~used ?want loc scrutinee n (arm : Ast.arm) els = in the block it guards (decision 133). Not through [or] or [not], where the test holding says nothing about [x]. *) and narrows (c : Ast.expr) = + match Ast.unpause c with + | Some x -> narrows x + | None -> match c.Ast.e with | Ast.Call ({ Ast.e = Ast.Var "?"; _ }, [ { Ast.e = Ast.Var x; _ } ]) -> [ x ] | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) -> narrows p @ narrows q @@ -10701,13 +10713,21 @@ and as_name g = Ast.as_name g (* A condition with [as] in it, as the bool it tests, and each name it binds with the hidden name the block reads it through. The chain runs left to right and stops at the first test that fails, so each value is found - once; what an [as] finds is copied into its name's slot there, and a - later test and the block read that slot. *) + once. What an [as] tests is held in one slot, and its name reads that + slot: the payload of an Option held there, or the dyn itself. *) and as_cond ctx (c : Ast.expr) = let named = ref [] in let no loc = mk loc Types.Bool (Tast.Bool false) in let rec go (c : Ast.expr) = let loc = c.Ast.loc in + match Ast.unpause c, c.Ast.e with + (* A pause mark on a test of the chain stops before it and leaves the + chain as it was. *) + | Some x, Ast.Do [ pause; _ ] -> + let pv = check ctx pause in + let xv = go x in + mk loc Types.Bool (Tast.Do [ pv; xv ]) + | _, _ -> match c.Ast.e with | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) when as_binds q <> [] -> let pv = check_truthy ctx p in @@ -10718,10 +10738,10 @@ and as_cond ctx (c : Ast.expr) = let ev = check ctx e in let hs = fresh_slot ctx ev.Tast.ty in let hv = mk loc ev.Tast.ty (Tast.Local hs) in - let test, payload, ty = + let test, what, ty = match ev.Tast.ty with - | Types.Option t -> (opt_is_some loc hv, opt_payload loc t hv, t) - | Types.Dyn -> (dyn_not_nil loc hv, hv, Types.Dyn) + | Types.Option t -> (opt_is_some loc hv, Some as_tag, t) + | Types.Dyn -> (dyn_not_nil loc hv, None, Types.Dyn) | t -> Loc.failk "check/as-not-optional" e.Ast.loc "%s is %s, which always holds a value, so as has nothing to test. \ @@ -10730,21 +10750,12 @@ and as_cond ctx (c : Ast.expr) = name, as in i32(x)" (source_text e) (tyname loc t) in - let slot, qv = - scoped ctx (fun () -> - let slot = bind ctx g ty ~assignable:false in - (match lookup ctx g with - | Some b -> - incr held_n; - named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named - | None -> ()); - (slot, go q)) - in + let b = { slot = hs; bty = ty; assignable = false; bwhat = what; blit = None } in + incr held_n; + named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; + let qv = scoped ctx (fun () -> ctx.scope <- (g, b) :: ctx.scope; go q) in mk loc Types.Bool - (Tast.Let ([ (hs, ev) ], - [ mk loc Types.Bool - (Tast.If (test, mk loc Types.Bool (Tast.Let ([ (slot, payload) ], [ qv ])), - no loc)) ])) + (Tast.Let ([ (hs, ev) ], [ mk loc Types.Bool (Tast.If (test, qv, no loc)) ])) | _ -> check_truthy ctx c in let cv = go c in diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 25e6f1c6..c2e39c01 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1456,6 +1456,13 @@ and primary p : Form.t * int = (match (peek p).tok with | RP -> ignore (advance p) | EOF -> unclosed p '(' l0 + | NAME "as" -> + failk "as-paren" (peek p).loc + "as names what a test found for the block of the if, elif, while \ + or when it is a test of, so it stands in that condition's and \ + chain and not inside parentheses. Write it without them: if %s as \ + g and ..." + (text_of e) | COMMA -> failk "tuple" (peek p).loc "parentheses group one value, and this comma starts a second. \ diff --git a/lib/load.ml b/lib/load.ml index 1809fecc..bf2e9515 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -297,6 +297,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = | Ast.Chain (n, v, b) -> Ast.Chain (n, go v, rename_expr owned alias (n :: bound) b) | Ast.Narrow (ns, b) -> Ast.Narrow (ns, go b) + | Ast.Alias (ps, b) -> Ast.Alias (ps, go b) (* A quoted symbol naming something the package declares. [(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is the one place a package's name survives into a *string* — which is @@ -860,7 +861,7 @@ let rec expr_uses acc (e : Ast.expr) = go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms | Ast.IfLet (sc, a, e') -> go sc; gos a.Ast.body; Option.iter go e' | Ast.Chain (_, v, b) -> go v; go b - | Ast.Narrow (_, b) -> go b + | Ast.Narrow (_, b) | Ast.Alias (_, b) -> go b | Ast.Struct (n, kvs) -> acc := (n, e.Ast.loc) :: !acc; List.iter (fun (_, v) -> go v) kvs diff --git a/lib/parse.ml b/lib/parse.ml index f34cefde..ca461c4f 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1315,7 +1315,9 @@ and is_as (f : Form.t) = match f.v with List ({ v = Sym "as"; _ } :: _) -> true | _ -> false and as_chain f (args : Form.t list) : Ast.expr = - let no (x : Form.t) = { Ast.e = Ast.Var "false"; loc = x.loc } in + (* At no position, so a pause mark cannot land on the chain's own + [false]: it has none in the source. *) + let no (_ : Form.t) = { Ast.e = Ast.Var "false"; loc = Loc.unknown } in let rec go = function | [] -> { Ast.e = Ast.Var "true"; loc = f.loc } | [ x ] when not (is_as x) -> expr x @@ -1325,7 +1327,10 @@ and as_chain f (args : Form.t list) : Ast.expr = | x :: _ when is_as x -> fail x "as is (as name value)" | x :: rest -> { Ast.e = Ast.If (expr x, go rest, Some (no x)); loc = x.loc } in - go args + (* The chain's own node is at the [and], so a pause mark there has a form + to stop before. *) + let top = go args in + { top with Ast.loc = f.loc } and shortcircuit f (args : Form.t list) ~is_and : Ast.expr = let mk e = { Ast.e; loc = f.loc } in diff --git a/test/test_session.ml b/test/test_session.ml index f7bbcc17..463038eb 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -2038,4 +2038,57 @@ let () = | exception Loc.Error _ -> () | exception Loc.Errors _ -> fail "one error came as a list")); + (* A pause mark at any column of a condition leaves what it binds bound: + an [as] (decision 136), and an [x?] narrowing through [and] (133). + [mark_pause] wraps a test of the chain in [(do (pause) test)]. *) + (let t, _ = Session.create ~file:"programs/reload.flan" () in + let marks name origin src line = + let text = List.nth (String.split_on_char '\n' src) (line - 1) in + let hits = ref 0 in + for col = 1 to String.length text do + let syntax = if Filename.check_suffix origin ".fln" then Source.Indented else Source.Paren in + match + Source.with_code ~syntax ~at:None (fun () -> + Session.eval ~origin ~pause:(line, col) t src) + with + | _ -> incr hits + | exception Loc.Error d when has d.Loc.dmsg "nothing to pause" -> () + | exception Loc.Error d -> + fail "%s, a mark at %d:%d: %s" name line col d.Loc.dmsg + | exception e -> fail "%s, a mark at %d:%d: %s" name line col (Printexc.to_string e) + done; + if !hits < 3 then fail "%s: only %d columns took a mark" name !hits + in + marks "if o? as g" "mark-a.fln" "fn pa(o: i32?) -> i32\n if o? as g then g else 0\n" 2; + marks "if o as g and" "mark-b.fln" "fn pb(o: i32?) -> i32\n if o as g and g > 1 then g else 0\n" 2; + marks "if o? and" "mark-c.fln" "fn pc(o: i32?) -> i32\n if o? and o > 1 then o else 0\n" 2; + let paren = "(defn pd [o (Option i32)] i32 (if (and (as g o) (> g 1)) g 0))" in + marks "(and (as g o) ...)" "" paren 1; + (* The chain has a node of its own at the [(and]. *) + let col = + let rec find i = if String.sub paren i 4 = "(and" then i + 1 else find (i + 1) in + find 0 + in + (match Session.eval ~pause:(1, col) t paren with + | _ -> () + | exception Loc.Error d -> fail "a mark at (and: %s" d.Loc.dmsg); + (* What an as finds is held once, and its name reads that slot: one + binding in the function, where a copy into g's own slot and another + into the block's would be three. *) + ignore + (Source.with_code ~syntax:Source.Indented ~at:None (fun () -> + Session.eval ~origin:"copies.fln" t + "fn pe(o: i32?) -> i32\n if o? as g and g > 1 then g + 1 else 0\n")); + match + List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "pe") t.Session.program.Tast.fns + with + | None -> fail "pe was not installed" + | Some f -> + let n = ref 0 in + List.iter + (Tast.walk (fun (e : Tast.expr) -> + match e.Tast.e with Tast.Let (bs, _) -> n := !n + List.length bs | _ -> ())) + f.Tast.body; + if !n <> 1 then fail "if o? as g binds %d slots, wanted 1" !n); + Test_support.report ~label:"session" () diff --git a/test/test_syntax.ml b/test/test_syntax.ml index c8659741..ce15fe57 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -1432,6 +1432,10 @@ let () = refuses "or after as" "if f(x) as g or b\n g" "indent/as-or" "nothing to name"; refuses "or later in the chain" "if f(x) as g and a or b\n g" "indent/as-or" "nothing to name"; refuses "as under not" "if not f(x) as g\n g" "indent/as-not" "not turns the test around"; + refuses "as in parentheses under not" "if not (a as g)\n g" "indent/as-paren" + "not inside parentheses"; + refuses "as in a bracketed chain" "if (a as g and g > 1) and b\n g" "indent/as-paren" + "if a as g and"; refuses "as after until" "until f(x) as g\n g" "indent/as-until" "Write while"; refused "as-not-optional.fln" "fn main()\n let n = 5\n if n as g and g > 1\n println(g)\n" [ "n is i32, which always holds a value, so as has nothing to test"; From 83bb65957d24241386558f002a232c8bfa22a395 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 17:59:59 +0700 Subject: [PATCH 12/16] Each name an as binds is a slot of its own under its name, so the break loop's locals show it with what the test found. --- lib/check.ml | 66 +++++++++++++++++++++++--------------- test/programs/dev-as.fln | 26 +++++++++++++++ test/test_dev.ml | 69 ++++++++++++++++++++++++++++++++++++++++ test/test_session.ml | 10 +++--- 4 files changed, 141 insertions(+), 30 deletions(-) create mode 100644 test/programs/dev-as.fln diff --git a/lib/check.ml b/lib/check.ml index 17c04445..b69a6d3e 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3184,12 +3184,8 @@ let unnarrowable_in (body : Ast.expr list) = List.iter (walk ~in_fn:false) body; !out -(* A name an [as] bound to what an Option held: the slot holding the Option, - read as its payload, as a narrowed local is, but not assignable. *) -let as_tag = "~as" - let local_of loc (b : binding) = - if b.bwhat = Some narrowed_tag || b.bwhat = Some as_tag then + if b.bwhat = Some narrowed_tag then mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1)) else mk loc b.bty (Tast.Local b.slot) @@ -10797,8 +10793,8 @@ and as_name g = Ast.as_name g (* A condition with [as] in it, as the bool it tests, and each name it binds with the hidden name the block reads it through. The chain runs left to right and stops at the first test that fails, so each value is found - once. What an [as] tests is held in one slot, and its name reads that - slot: the payload of an Option held there, or the dyn itself. *) + once. Each name an [as] binds is one slot, read by the rest of the chain + and, through [Ast.Alias], by the block. *) and as_cond ctx (c : Ast.expr) = let named = ref [] in let no loc = mk loc Types.Bool (Tast.Bool false) in @@ -10820,26 +10816,44 @@ and as_cond ctx (c : Ast.expr) = | Ast.IfLet (e, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ }, Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> let ev = check ctx e in - let hs = fresh_slot ctx ev.Tast.ty in - let hv = mk loc ev.Tast.ty (Tast.Local hs) in - let test, what, ty = - match ev.Tast.ty with - | Types.Option t -> (opt_is_some loc hv, Some as_tag, t) - | Types.Dyn -> (dyn_not_nil loc hv, None, Types.Dyn) - | t -> - Loc.failk "check/as-not-optional" e.Ast.loc - "%s is %s, which always holds a value, so as has nothing to test. \ - as names what an Option or a dyn holds, when it holds something. \ - It is not a conversion: a number is converted with its type's \ - name, as in i32(x)" - (source_text e) (tyname loc t) + let refuse t = + Loc.failk "check/as-not-optional" e.Ast.loc + "%s is %s, which always holds a value, so as has nothing to test. \ + as names what an Option or a dyn holds, when it holds something. \ + It is not a conversion: a number is converted with its type's \ + name, as in i32(x)" + (source_text e) (tyname loc t) in - let b = { slot = hs; bty = ty; assignable = false; bwhat = what; blit = None } in - incr held_n; - named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; - let qv = scoped ctx (fun () -> ctx.scope <- (g, b) :: ctx.scope; go q) in - mk loc Types.Bool - (Tast.Let ([ (hs, ev) ], [ mk loc Types.Bool (Tast.If (test, qv, no loc)) ])) + (* [g] is a slot of its own under its own name, so locals, the stepper, + the inspector and the watch view show it as the program reads it. A + dyn is held there directly; an Option is held in a hidden slot and + its payload copied into [g]'s once the test holds. *) + let bound ty = + scoped ctx (fun () -> + let slot = bind ctx g ty ~assignable:false in + let b = Option.get (lookup ctx g) in + incr held_n; + named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; + (slot, go q)) + in + (match ev.Tast.ty with + | Types.Option t -> + let hs = fresh_slot ctx ev.Tast.ty in + let hv = mk loc ev.Tast.ty (Tast.Local hs) in + let slot, qv = bound t in + mk loc Types.Bool + (Tast.Let ([ (hs, ev) ], + [ mk loc Types.Bool + (Tast.If (opt_is_some loc hv, + mk loc Types.Bool + (Tast.Let ([ (slot, opt_payload loc t hv) ], [ qv ])), + no loc)) ])) + | Types.Dyn -> + let slot, qv = bound Types.Dyn in + let sv = mk loc Types.Dyn (Tast.Local slot) in + mk loc Types.Bool + (Tast.Let ([ (slot, ev) ], [ mk loc Types.Bool (Tast.If (dyn_not_nil loc sv, qv, no loc)) ])) + | t -> refuse t) | _ -> check_truthy ctx c in let cv = go c in diff --git a/test/programs/dev-as.fln b/test/programs/dev-as.fln new file mode 100644 index 00000000..ebd78c8a --- /dev/null +++ b/test/programs/dev-as.fln @@ -0,0 +1,26 @@ +;; A program that stops inside an if o as g block (decision 136): the break +;; loop's locals list g, with the value the test found, on both backends. +import agent "vendor:agent" + +struct Boom + why: i32 + +let ticks: i64 = 0 + +fn look(o: i32?, d) -> i64 + if o as g and g > 1 and d as e + restart-case + error(Boom{.why g}) + 0 + restart carry-on() + 5 + else + 0 + +fn main() -> i32 + agent/start("/tmp/flan-dev-as-fallback.sock") + println(look(Some(41), "hi")) + for i in range(4000) + agent/wait(5) + ticks += 1 + 0 diff --git a/test/test_dev.ml b/test/test_dev.ml index e7940991..31bff637 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2483,6 +2483,75 @@ let () = null_park "--llvm"; null_park "--x86"; + (* A stop inside an [if o as g and ... and d as e] block (decision 136): + each name an [as] binds is a slot of its own under its name, so the + locals list it with what the test found. *) + let as_locals backend = + let asock = tmp ("as" ^ backend ^ ".sock") and aout = tmp ("as" ^ backend ^ ".out") in + (try Sys.remove asock with Sys_error _ -> ()); + let afd = Unix.openfile aout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let apid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-as.fln"; "-s"; asock; backend |] + Unix.stdin afd Unix.stderr + in + Unix.close afd; + if not (listening ~pid:apid asock) then begin + fail "the as daemon (%s) %s" backend !listen_why; + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect asock in + let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the as program never stopped (%s)" backend + else begin + let r = ask "(:op \"locals\" :frame 0)" in + let rows = + match Wire.field r "locals" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List ({ Form.v = Form.Str n; _ } :: { Form.v = Form.Str ty; _ } + :: { Form.v = Form.Str v; _ } :: _) -> Some (n, (ty, v)) + | _ -> None) + l + | _ -> [] + in + (match List.assoc_opt "g" rows with + | Some ("i32", "41") -> () + | Some (ty, v) -> fail "locals show g as %s %s (%s)" ty v backend + | None -> + fail "locals do not show g (%s): %s" backend + (String.concat " " (List.map fst rows))); + (match List.assoc_opt "e" rows with + | Some ("dyn", v) when Test_support.contains v "hi" -> () + | Some (ty, v) -> fail "locals show e as %s %s (%s)" ty v backend + | None -> fail "locals do not show e (%s)" backend) + end; + ignore (ask "(:op \"close\")"); + Unix.close c; + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] apid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] apid) with Unix.Unix_error _ -> ()) + end + end + in + as_locals "--llvm"; + as_locals "--x86"; + (* ── The locals of a stopped frame ─────────────────────────────── *) (* A third daemon, over a program that stops with something worth looking diff --git a/test/test_session.ml b/test/test_session.ml index 463038eb..6df9c9d2 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -2072,9 +2072,9 @@ let () = (match Session.eval ~pause:(1, col) t paren with | _ -> () | exception Loc.Error d -> fail "a mark at (and: %s" d.Loc.dmsg); - (* What an as finds is held once, and its name reads that slot: one - binding in the function, where a copy into g's own slot and another - into the block's would be three. *) + (* What an as finds is copied once, into g's own named slot, which the + rest of the chain and the block read: two bindings, the Option held + and g, where another copy into the block's would be three. *) ignore (Source.with_code ~syntax:Source.Indented ~at:None (fun () -> Session.eval ~origin:"copies.fln" t @@ -2089,6 +2089,8 @@ let () = (Tast.walk (fun (e : Tast.expr) -> match e.Tast.e with Tast.Let (bs, _) -> n := !n + List.length bs | _ -> ())) f.Tast.body; - if !n <> 1 then fail "if o? as g binds %d slots, wanted 1" !n); + if !n <> 2 then fail "if o? as g binds %d slots, wanted 2" !n; + if not (Array.exists (fun x -> x = Some "g") f.Tast.snames) then + fail "if o? as g has no slot named g"); Test_support.report ~label:"session" () From b814aca187619169d6463bb806f8d319e5d03788 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 18:02:43 +0700 Subject: [PATCH 13/16] A kept when or else-less chain over an Option arm is that Option, flattened one level, unless an Option of it is wanted. --- TODO.org | 10 +++- lib/check.ml | 109 ++++++++++++++++++++++------------ spec-syntax.md | 11 +++- test/programs/autowrap.fln | 17 +++++- test/programs/if-let-kept.fln | 31 ++++++++++ test/programs/when-value.flan | 16 ++++- test/test_acceptance.ml | 9 +-- 7 files changed, 153 insertions(+), 50 deletions(-) diff --git a/TODO.org b/TODO.org index c59863e3..e8c909bd 100644 --- a/TODO.org +++ b/TODO.org @@ -49,6 +49,12 @@ found. Rules out =if let g = x= over a plain name, which is refused toward these CLOSED: [2026-09-26] Decided (138), like Swift: one level per boundary, the literal built at T first; not inside a container. Rules out implicit unwrapping: a T? where a T is wanted stays refused. +** DONE A kept when over an Option body flattens one level +CLOSED: [2026-09-26] +Decided (140), reversing 125a: a kept =when=, else-less =if=/=elif= or =if let= chain whose +arm is already a =T?= is a =T?=, and =T= beside =T?= arms is =T?=; a =T??= arm stays =T??=. +Where =T??= is wanted the arm is Some of it. Rules out telling "no branch matched" apart +from "a branch gave None" without asking for =T??=. ** TODO The stepper does not step inside an optional chain =Ast.step_expr= treats a =Chain= as a leaf (its catch-all), so nothing in a chain's body gets a step point of its own. @@ -68,8 +74,8 @@ Option or a dyn holds (130); over any other type, and =_=, it is refused toward ** 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 -call's argument, a lambda's return — it is =Option(T)=, nested over an Option body -(Rust's =bool::then=), and body-or-nil where a dyn is wanted. A =_=-inferred return's +call's argument, a lambda's return — it is =Option(T)=, and body-or-nil where a dyn is +wanted. Over an Option body it was nested (Rust's =bool::then=, 125a); 140 reversed that. A =_=-inferred return's last form is not kept. =get= over dyn text or vec is nil when out of range; =.field= still traps. ** NEXT str and String diff --git a/lib/check.ml b/lib/check.ml index d1816a4a..da0617d2 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8618,12 +8618,31 @@ and check_if_once ctx ~tail ~used ?want loc c t e = | Some Types.Dyn -> Some Types.Dyn | _ -> None in - let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:tw t)) in + let arm w = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:w t)) in + (* At an Option want the arm is asked the payload first, and the chain + wraps it; refused there, it is asked the Option itself, which it + then is (decision 140). So a T?? wanted of a T? arm is Some of it, + and the chain's own None stays the outer one. *) + let t, at_payload = + match want with + | Some (Types.Option _) -> + (match trial ctx (fun () -> arm tw) with + | Ok t -> t, true + | Error d -> + (match trial ctx (fun () -> arm want) with + | Ok t -> t, false + | Error _ -> raise (Loc.Error d))) + | _ -> arm tw, false + in let rest ~used ?want () = branch ctx (fun () -> ctx.tail <- tail; ctx.used <- used; check ctx ?want e) in match t.Tast.ty with + | ty when at_payload && not (Types.equal ty Types.Never) -> + let oty = Option.get want in + let e = rest ~used:true ~want:oty () in + mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e)) | Types.Unit -> expect ctx loc ~want (mk loc Types.Unit (Tast.If (c, t, rest ~used:false ()))) @@ -8633,32 +8652,14 @@ and check_if_once ctx ~tail ~used ?want loc c t e = | Types.Dyn -> let e = rest ~used:true ~want:Types.Dyn () in expect ctx loc ~want (mk loc Types.Dyn (Tast.If (c, t, e))) + (* An arm that is already an Option is the chain's value as it is, + and [None] when no test holds — one level flattened (decision + 140): an arm's None and no arm running are one answer. *) + | Types.Option _ as o -> + let e = rest ~used:true ~want:o () in + expect ctx loc ~want (mk loc o (Tast.If (c, t, e))) | ty -> let oty = Types.Option ty in - (* A later arm that is a T? where this one is a T: the arms meet at - T? (decision 138), so the chain is a T??, as it is when the T? - arm comes first. Tried only where the arm is refused at T. *) - let nested = - match want, ty with - | None, (Types.Option _ | Types.Unit) -> None - | None, _ -> - (match trial ctx (fun () -> rest ~used:true ~want:oty ()) with - | Ok e -> Some (Error e) - | Error _ -> - let ooty = Types.Option oty in - (match trial ctx (fun () -> rest ~used:true ~want:ooty ()) with - | Ok e -> Some (Ok e) - | Error _ -> None)) - | _ -> None - in - match nested with - | Some (Ok e) -> - let ooty = Types.Option oty in - let t = mk loc ooty (Tast.Some_ (mk loc oty (Tast.Some_ t))) in - mk loc ooty (Tast.If (c, t, e)) - | Some (Error e) -> - mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e)) - | None -> let e = rest ~used:true ~want:oty () in expect ctx loc ~want (mk loc oty (Tast.If (c, mk loc oty (Tast.Some_ t), e)))) @@ -8899,9 +8900,9 @@ and check_if_once ctx ~tail ~used ?want loc c t e = branch evaluates to. Kept — a [let]'s value, an argument, a return, or anything else with a type wanted of it — it answers (Option T): [Some] of the branch when the test held and [None] when it did not. A branch that - is already an Option is not flattened: the answer is (Option (Option T)), - Rust's [bool::then], so [None] from the branch and a failed test stay two - answers. + is already an Option is that Option, flattened one level (decision 140, + Kotlin's [?.] rather than Rust's [bool::then]): [None] from the branch and + a failed test are one answer. A (Option (Option T)) branch stays one. Dyn has no Option. Where a dyn is wanted, or the branch is a dyn, a false test answers nil and a true one the branch's value — one absence, as a @@ -8921,17 +8922,26 @@ and check_when ctx ~used ?want loc c | Some Types.Dyn -> let t = branch_at ~want:Types.Dyn () in mk loc Types.Dyn (Tast.If (c, t, nil ())) - | Some (Types.Option inner) -> - let t = branch_at ~want:inner () in - let oty = Types.Option inner in - let some = if t.Tast.ty = Types.Never then t else mk loc oty (Tast.Some_ t) in - mk loc oty (Tast.If (c, some, mk loc oty Tast.None_)) + | Some (Types.Option inner as oty) -> + (* The payload first, wrapped; refused there, the Option itself, which + the branch then is (decision 140). *) + let t = + match trial ctx (fun () -> branch_at ~want:inner ()) with + | Ok t -> if t.Tast.ty = Types.Never then t else mk loc oty (Tast.Some_ t) + | Error d -> + (match trial ctx (fun () -> branch_at ~want:oty ()) with + | Ok t -> if t.Tast.ty = Types.Never then t else expect ctx loc ~want:(Some oty) t + | Error _ -> raise (Loc.Error d)) + in + mk loc oty (Tast.If (c, t, mk loc oty Tast.None_)) | None when not used -> stmt (branch_at ()) | _ -> let t = branch_at () in if valueless t then stmt t else if Types.equal t.Tast.ty Types.Dyn then expect ctx loc ~want (mk loc Types.Dyn (Tast.If (c, t, nil ()))) + else if (match t.Tast.ty with Types.Option _ -> true | _ -> false) then + expect ctx loc ~want (mk loc t.Tast.ty (Tast.If (c, t, mk loc t.Tast.ty Tast.None_))) else let oty = Types.Option t.Tast.ty in expect ctx loc ~want @@ -10021,7 +10031,7 @@ and check_array_gen ctx ~want loc dims f = ~element:(fun idxs -> mk loc elem (Tast.CallPtr (fv, idxs)))) and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = false) - ?opt_rest ?want loc scrutinee arms = + ?(flat = false) ?opt_rest ?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. [opt] is one that is kept: its arm answers [Some], and the arm with no body [None]. *) @@ -10030,7 +10040,11 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals let want0 = want in let want = if stmt then None - else if opt then (match want with Some (Types.Option i) -> Some i | _ -> None) + else if opt then + (match want with + | Some (Types.Option _) when flat -> want + | Some (Types.Option i) -> Some i + | _ -> None) else want in let s = check ctx scrutinee in @@ -10629,6 +10643,14 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals match r with | Some e -> e | None -> rt a.Ast.aloc Types.Dyn "flan_dyn_nil" []) + (* Already an Option: the whole, one level flattened (decision 140). *) + | Some (Types.Option _ as o) when flat || want0 = None -> + opt_result := Some o; + let r = rest ~used:true ~want:o () in + fill Fun.id (fun a -> + match r with + | Some e -> e + | None -> mk a.Ast.aloc o Tast.None_) | Some t -> let oty = Types.Option t in opt_result := Some oty; @@ -10791,9 +10813,22 @@ and check_if_let ctx ~tail ~used ?want loc scrutinee (arm : Ast.arm) els = ctx.tail <- tail; ctx.used <- used; check ctx ?want e)) els in + (* The arm at the payload first, as [check_when] asks it; refused + there, at the Option itself (decision 140). *) + let go ~flat () = + check_match ctx ~tail ~used:true ~opt:true ~flat ?opt_rest ?want loc scrutinee + [ arm; wild [] ] + in expect ctx loc ~want - (check_match ctx ~tail ~used:true ~opt:true ?opt_rest ?want loc scrutinee - [ arm; wild [] ])) + (match want with + | Some (Types.Option _) -> + (match trial ctx (go ~flat:false) with + | Ok r -> r + | Error d -> + (match trial ctx (go ~flat:true) with + | Ok r -> r + | Error _ -> raise (Loc.Error d))) + | _ -> go ~flat:false ())) | Some e -> check_match ctx ~tail ~used ?want loc scrutinee [ arm; wild [ e ] ] | None -> diff --git a/spec-syntax.md b/spec-syntax.md index 9f922c86..7c85a91f 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -252,7 +252,8 @@ Each item: the proposal, then the reason in one line. into a `T??` is `Some` of it. A `$t` meeting `$u?` binds `$u` to `T`. Never inside a container (`Vec(i32)` is not a `Vec(i32?)`), and never the other way: a `T?` where a `T` is wanted still needs `!`, `??`, `x?` or - `as`. A kept chain whose arms are a `T` and a `T?` is a `T??`. **Built.** + `as`. A kept chain whose arms are a `T` and a `T?` is a `T?` (decision + 140, under `when c`). **Built.** - **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`, `max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.** @@ -316,7 +317,13 @@ Each item: the proposal, then the reason in one line. A `when` whose value is kept (a `let`'s value, an argument, a return) gives `Some(a)` when `c` holds and `None` when it does not; where a `dyn` is wanted, `a` or `nil`. As a statement it gives nothing. An `if`/`elif` chain - with no `else` is the same when kept: `None` when no test holds. **Built.** + with no `else` is the same when kept: `None` when no test holds. When `a` + is already an Option it is not wrapped again (decision 140): `when c then + o` over an `i32?` is an `i32?`, `None` when `c` fails or `o` is `None`, and + a chain mixing `T` and `T?` arms is a `T?`. One level only: an arm that is + a `T??` gives a `T??`. Where an Option of the arm's type is wanted, as a + `T??` over a `T?` arm, the arm is `Some` of its value and a failed test is + the outer `None`. `if let` with no `else` follows the same rule. **Built.** - **`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. diff --git a/test/programs/autowrap.fln b/test/programs/autowrap.fln index 0db6c6ea..ef62defb 100644 --- a/test/programs/autowrap.fln +++ b/test/programs/autowrap.fln @@ -40,12 +40,24 @@ fn arms(k: i32, x: i32) -> i32? fn big(x: i64?) -> i64 = x ?? 0 +;; A T?? is wanted, so each arm is Some of its value and the chain's None is +;; the outer one. fn chain(a: bool, b: bool, opt: i32?) -> Option(i32?) if a 1 elif b opt +;; Nothing wanted: a T arm beside a T? arm makes the chain a T?, flattened +;; one level (decision 140). +fn flat(a: bool, b: bool, opt: i32?) -> i32? + let r = + if a + 1 + elif b + opt + r + fn main() ;; assignment, and a literal at the payload's width let s: i64? = None @@ -85,14 +97,15 @@ fn main() let none: i32? = None let nn2: Option(i32?) = none println(two(nn), two(nn2)) - ;; a kept chain: a T arm beside a T? arm makes the chain a T?? + ;; kept chains over T and T? arms println(two(chain(true, false, none)), two(chain(false, true, none)), two(chain(false, false, none))) + println(flat(true, false, none) ?? -1, flat(false, true, Some(6)) ?? -1, flat(false, true, none) ?? -1, flat(false, false, none) ?? -1) let kk = if x > 9 none elif x > 1 1 - println(two(kk)) + println(kk ?? -1) ;; generics println(first(9), first(Some(8)), wrap(3) ?? 0, through(5)) ;; a literal local takes the payload's type from an Option use, as it diff --git a/test/programs/if-let-kept.fln b/test/programs/if-let-kept.fln index 0fb4714c..bf27e7c1 100644 --- a/test/programs/if-let-kept.fln +++ b/test/programs/if-let-kept.fln @@ -21,6 +21,28 @@ fn early(a: Option(i32)) -> Option(i32) elif true 3 +;; An arm that is already an Option is the whole, flattened (decision 140). +fn flat(a: Option(i32), o: Option(i32)) -> Option(i32) + if let Some(x) = a then o + +;; An Option of it wanted: the arm is Some of its value, and no match is the +;; outer None. +fn nest(a: Option(i32), o: Option(i32)) -> Option(Option(i32)) + if let Some(x) = a then o + +fn level(oo: Option(Option(i32))) + match oo + Some(o) -> if o? then println(o) else println("some none") + None -> println("none") + +fn flat_chain(a: Option(i32), k: i32) + let r = + if let Some(x) = a + x + elif k > 0 + None + show(r) + fn dyn_only(a: Option(i32)) -> dyn if let Some(x) = a then x @@ -40,6 +62,15 @@ fn main() show(lead(1, None)) show(early(None)) show(early(Some(1))) + show(flat(Some(1), Some(4))) + show(flat(Some(1), None)) + show(flat(None, Some(4))) + level(nest(Some(1), Some(4))) + level(nest(Some(1), None)) + level(nest(None, Some(4))) + flat_chain(Some(3), 0) + flat_chain(None, 1) + flat_chain(None, 0) println(dyn_only(Some(5))) println(dyn_only(None)) ;; As a statement it is unchanged. diff --git a/test/programs/when-value.flan b/test/programs/when-value.flan index c1c907b4..ce3ecb23 100644 --- a/test/programs/when-value.flan +++ b/test/programs/when-value.flan @@ -1,7 +1,8 @@ ;;;; A when whose value is kept answers an Option: Some of its body when the ;;;; test holds, None when it does not. As a statement it answers nothing. ;;;; Where a dyn is wanted it answers the body or nil, since dyn has no -;;;; Option. A body that is already an Option is not flattened. +;;;; Option. A body that is already an Option is that Option, flattened one +;;;; level (decision 140), unless an Option of it is what is wanted. (defn show [o (Option i32)] () (match o (Some v) (println v) None (println "none"))) @@ -9,10 +10,13 @@ ;; Returned: the return type is the want. (defn half [n i32] (Option i32) (when (= 0 (% n 2)) (/ n 2))) -;; Nested, as Rust's bool::then: None from the body stays apart from a -;; failed test. +;; An (Option (Option i32)) is wanted, so the body is Some of it and the +;; failed test is the outer None. (defn wrap [c bool o (Option i32)] (Option (Option i32)) (when c o)) +;; Flattened: None from the body and a failed test are one answer. +(defn flat [c bool o (Option i32)] (Option i32) (when c o)) + (defn level [oo (Option (Option i32))] () (match oo (Some o) (match o (Some v) (println v) None (println "some none")) @@ -45,6 +49,12 @@ (level (wrap true (Some 1))) (level (wrap true None)) (level (wrap false (Some 1))) + (show (flat true (Some 4))) + (show (flat true None)) + (show (flat false (Some 4))) + (let [o (the (Option i32) (Some 8)) + f (when true o)] + (show f)) (println (dyn-when true)) (println (dyn-when nil)) (show (early None)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 09dfbad6..e2328216 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2226,8 +2226,8 @@ let () = dyn_if_truthy_out; (* A kept when is an Option; get is a checked lookup; if let. *) let when_value_out = - "5\nnone\n42\nnone\n9\n1\nsome none\nnone\n5\nnil\n3\nnone\n6\nnone\n20\nnone\n2\n\ - a\nnil\ncond stmt\nran\nend\n" + "5\nnone\n42\nnone\n9\n1\nsome none\nnone\n4\nnone\nnone\n8\n5\nnil\n3\nnone\n6\nnone\n\ + 20\nnone\n2\na\nnil\ncond stmt\nran\nend\n" in outputs "when as a value" "programs/when-value.flan" when_value_out; outputs ~opt:"-O0" "when as a value, -O0" "programs/when-value.flan" when_value_out; @@ -2246,7 +2246,8 @@ let () = "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\n3\nnone\n5\nnil\n7\n" + "1\n4\nnone\n6\nnone\n9\n2\nnone\n3\nnone\n4\nnone\nnone\n4\nsome none\nnone\n\ + 3\nnone\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; @@ -2277,7 +2278,7 @@ let () = (* A T where a T? is wanted is Some of it (decision 138). *) ("autowrap.fln", "-1\n5 4 2\n7 8 -1\n3 4\n7\n1 0 4\n5\n2 6 0\n2 -1 -1 2\n4\n-1 3 0\n\ - some some some none\nsome some some none none\nsome some\n9 8 3 5\n\ + some some some none\nsome some some none none\n1 6 -1 -1\n1\n9 8 3 5\n\ 4000000000 4000000000 4 4\n4 4000000000\n3.5 3.5 7 7\n200 200\n-1 5\n1 0\n10\n"); (* x? tests and narrows, e? as g names what it found (decision 133). *) ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; From 8333ba017d083d40b7ca0bbce059ef7741b44f8a Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 18:06:29 +0700 Subject: [PATCH 14/16] A literal local read as a typed array's element takes that element's type, and the Option str refusal test names str. --- lib/check.ml | 11 ++++++++++- test/programs/autowrap.fln | 6 ++++++ test/test_acceptance.ml | 2 +- test/test_flan.ml | 4 ++-- 4 files changed, 19 insertions(+), 4 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index da0617d2..44a9d7e1 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -9863,8 +9863,17 @@ and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = | _ -> ty in let is_nil = match v.Ast.e with Ast.Var "nil" -> true | _ -> false in + (* Quietly: what [v] is on its own terms is not a use of a literal local + inside it — [[x]] read with no want would pin x at its guess, and the + annotation's want below is the use that says what x is. *) + let own_ty () = + let was = !lit_quiet in + lit_quiet := true; + Fun.protect ~finally:(fun () -> lit_quiet := was) (fun () -> + probe ctx loc (fun () -> (check ctx v).Tast.ty)) + in if ty <> Types.Dyn && not is_nil - && probe ctx loc (fun () -> (check ctx v).Tast.ty) = Some Types.Dyn + && own_ty () = Some Types.Dyn (* A keyword naming one of an enum's members is that member at the enum's type, not a dyn: [let d: Dir = :north]. *) && not (match ty, v.Ast.e with Types.Enum _, Ast.Kw _ -> true | _ -> false) diff --git a/test/programs/autowrap.fln b/test/programs/autowrap.fln index ef62defb..a63a82a6 100644 --- a/test/programs/autowrap.fln +++ b/test/programs/autowrap.fln @@ -127,6 +127,12 @@ fn main() let lv = 200 let wv: u8 = lv println(wu ?? 0, wv) + ;; and from a typed array's element, with or without an Option + let la2 = 3 + let xa: [1 i64] = [la2] + let lb2 = 3 + let xb: [2 i64?] = [lb2, None] + println(la2 * 1000000000, lb2 * 1000000000, xa[0], xb[0] ?? 0) ;; None first in an if, as in a match let e1 = if x > 1 then None else 5 let e2 = if x > 1 then 5 else None diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index e2328216..6d81ae30 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2279,7 +2279,7 @@ let () = ("autowrap.fln", "-1\n5 4 2\n7 8 -1\n3 4\n7\n1 0 4\n5\n2 6 0\n2 -1 -1 2\n4\n-1 3 0\n\ some some some none\nsome some some none none\n1 6 -1 -1\n1\n9 8 3 5\n\ - 4000000000 4000000000 4 4\n4 4000000000\n3.5 3.5 7 7\n200 200\n-1 5\n1 0\n10\n"); + 4000000000 4000000000 4 4\n4 4000000000\n3.5 3.5 7 7\n200 200\n3000000000 3000000000 3 3\n-1 5\n1 0\n10\n"); (* x? tests and narrows, e? as g names what it found (decision 133). *) ("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ]; (* The pipe (decision 137): chains, multi-line, qualified, dyn, and the diff --git a/test/test_flan.ml b/test/test_flan.ml index 0889c686..b1170336 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -8413,8 +8413,8 @@ let () = ~needle:"expected (Option i32), found str" "(defn f [] (Option i32) \"no\")\n(defn main [] ())"; rejects_check "a literal that does not fit is refused at the Option" - ~needle:"expected (Option string), found the integer literal 5" - "(defn f [] (Option string) 5)\n(defn main [] ())"; + ~needle:"expected (Option str), found the integer literal 5" + "(defn f [] (Option str) 5)\n(defn main [] ())"; rejects_check "a narrowing is not wrapped" ~needle:"expected (Option i32), found i64" "(defn f [x i64] (Option i32) x)\n(defn main [] ())"; rejects_check "no wrap inside a container" ~needle:"expected (Vec (Option i32)), found (Vec i32)" From d6c33928f52ed19fb6f8e46eb8541113bdb4bbd6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 18:16:13 +0700 Subject: [PATCH 15/16] A name an as bound is refused as itself when assigned, in the program and in a stopped frame alike. --- lib/check.ml | 48 ++++++++++++++++++++++++++++---------------- lib/emit.ml | 2 +- lib/session.ml | 16 ++++++++++----- lib/tast.ml | 4 ++++ test/test_dev.ml | 31 +++++++++++++++++++++++++++- test/test_flan.ml | 9 +++++++++ test/test_session.ml | 2 +- 7 files changed, 87 insertions(+), 25 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index b69a6d3e..751b538a 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -834,6 +834,8 @@ type ctx = { here rather than recovered later because this scope list is the only place that ever knows it. *) mutable slot_names : string option list; + (* The slots an [as] bound in this function: [Tast.fn.as_slots]. *) + mutable as_slots : int list; mutable scope : (string * binding) list; (* innermost first *) (* Deferred forms, most recently registered first — which is also the order they run in. [defer] is function-scoped, so this list belongs to the @@ -3184,6 +3186,10 @@ let unnarrowable_in (body : Ast.expr list) = List.iter (walk ~in_fn:false) body; !out +(* The [bwhat] of a name an [as] bound (decision 136), for the refusal to + assign it. *) +let as_tag = "~as" + let local_of loc (b : binding) = if b.bwhat = Some narrowed_tag then mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1)) @@ -4919,7 +4925,7 @@ let thick_thunk env loc ps r = env.lifted <- { Tast.name; params = ps; slots = Array.of_list (ps @ [ fty ]); - snames = Array.make (n + 1) None; + snames = Array.make (n + 1) None; as_slots = []; ret = r; body = [ mk loc r (Tast.CallPtr (callee, args)) ]; fdefers = []; fenv = Some n; fparent = Some ""; floc = loc } :: env.lifted; @@ -5277,7 +5283,7 @@ let with_recovery env ~on f = end let invented_ctx env ret = - { env; ret; lits = None; slots = 0; slot_tys = []; slot_names = []; scope = []; + { env; ret; lits = None; slots = 0; slot_tys = []; slot_names = []; as_slots = []; scope = []; defers = []; defer_slot = None; outer = []; outer_what = None; caught = []; place_ok = false; envslot = None; parent = None; in_frames = None; loops = []; tail = false; used = false; kept = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "" } @@ -5337,7 +5343,7 @@ let condition_desc ctx loc name = ctx.env.lifted <- { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ]; slots = Array.of_list (List.rev hctx.slot_tys); - snames = Array.of_list (List.rev hctx.slot_names); + snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots; ret = Types.Unit; body; fdefers = []; fenv = None; fparent = Some ctx.owner; floc = loc } :: ctx.env.lifted; @@ -5457,7 +5463,7 @@ and struct_key_pair env loc n = The body is filled in below; nothing can call these in between. *) let placeholder name ret params = { Tast.name; params; slots = Array.of_list params; - snames = Array.make (List.length params) None; + snames = Array.make (List.length params) None; as_slots = []; ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- @@ -5540,7 +5546,7 @@ and struct_key_pair env loc n = let finish name ret params ctx body = { Tast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); - snames = Array.of_list (List.rev ctx.slot_names); + snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots; ret; body; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- @@ -5588,7 +5594,7 @@ and array_key_pair env loc n e = let eparams = [ pty; pty; Types.Int Types.I64 ] in let placeholder name ret params = { Tast.name; params; slots = Array.of_list params; - snames = Array.make (List.length params) None; + snames = Array.make (List.length params) None; as_slots = []; ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- @@ -5663,7 +5669,7 @@ and array_key_pair env loc n e = let finish name ret params ctx body = { Tast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); - snames = Array.of_list (List.rev ctx.slot_names); + snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots; ret; body; fdefers = []; fenv = None; fparent = None; floc = loc } in env.lifted <- @@ -7321,7 +7327,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body = let lifted = { Tast.name = fname; params = pts; slots = Array.of_list (List.rev fctx.slot_tys); - snames = Array.of_list (List.rev fctx.slot_names); + snames = Array.of_list (List.rev fctx.slot_names); as_slots = fctx.as_slots; ret; body = prefix fbody; fdefers = []; fenv; fparent = Some ctx.owner; floc = loc } in @@ -7444,7 +7450,7 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body = let lifted = { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ]; slots = Array.of_list (List.rev hctx.slot_tys); - snames = Array.of_list (List.rev hctx.slot_names); + snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots; ret = Types.Unit; body = prefix hbody; fdefers = []; fenv; fparent = Some ctx.owner; floc = c.Ast.hloc } in @@ -10830,7 +10836,8 @@ and as_cond ctx (c : Ast.expr) = its payload copied into [g]'s once the test holds. *) let bound ty = scoped ctx (fun () -> - let slot = bind ctx g ty ~assignable:false in + let slot = bind ctx ~what:as_tag g ty ~assignable:false in + ctx.as_slots <- slot :: ctx.as_slots; let b = Option.get (lookup ctx g) in incr held_n; named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named; @@ -11318,7 +11325,7 @@ and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string = "%s is tested with %s? above, so here it is what the Option \ holds, %s, and %s has no fields" n n (tyname target.Ast.loc other) (tyname target.Ast.loc other) - | Some { bwhat = Some w; _ } -> + | Some { bwhat = Some w; _ } when w <> as_tag -> 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" @@ -11402,6 +11409,11 @@ and check_place ?(store = true) ctx loc (p : Ast.place) : Tast.place * Types.t = (match List.assoc_opt name ctx.caught with | Some (_, slot) when slot = b.slot -> captured_set ctx loc name | _ -> ()); + if b.bwhat = Some as_tag then + fail loc + "%s names what an as test found, and it cannot be given a new \ + value. To change it, copy it into a local first: let %s2 = %s" + name name name; fail loc "%s is a parameter, and a parameter is not assignable — bind a \ local with let" name @@ -17172,7 +17184,7 @@ and trial ctx f = Only [Loc.Error] is caught. A timeout or a stack overflow is not a refusal to reconsider, and silently continuing past one would turn a resource failure into a wrong answer. *) - let[@warning "+9"] { env = _; ret = _; lits = _; slots; slot_tys; slot_names; scope; + let[@warning "+9"] { env = _; ret = _; lits = _; slots; slot_tys; slot_names; as_slots; scope; defers; defer_slot; defer_ok; defer_block; outer = _; outer_what; caught; place_ok; envslot; parent = _; in_frames; loops; tail; used; kept; in_defer; @@ -17183,7 +17195,7 @@ and trial ctx f = | exception Loc.Error d -> undo (); ctx.slots <- slots; ctx.slot_tys <- slot_tys; - ctx.slot_names <- slot_names; ctx.scope <- scope; + ctx.slot_names <- slot_names; ctx.as_slots <- as_slots; ctx.scope <- scope; ctx.defers <- defers; ctx.defer_slot <- defer_slot; ctx.defer_ok <- defer_ok; ctx.defer_block <- defer_block; ctx.outer_what <- outer_what; ctx.in_frames <- in_frames; @@ -18960,7 +18972,7 @@ let rec check_fn ?sign env (fn : Ast.fn) : Tast.fn = let checked = { Tast.name = fn.Ast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); - snames = Array.of_list (List.rev ctx.slot_names); + snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots; (* The same defers again, for the transfer exit path §5 describes. The normal path has them spliced into [body] above; this one is guarded on the count, because a transfer can start above a defer that the text has @@ -19591,7 +19603,7 @@ let lift_ginit ctx loc n ty (v : Tast.expr) = ctx.env.lifted <- { Tast.name = fname; params = []; slots = Array.of_list (List.rev ctx.slot_tys); - snames = Array.of_list (List.rev ctx.slot_names); + snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots; (* An initialiser is a nested form as far as [defer_ok] is concerned, so nothing can register one here and both of these are empty. Written the same way [check_fn] writes them anyway, so that the day the rule @@ -20772,13 +20784,15 @@ let expressions env (es : (Types.t option * Ast.expr) list) : expression's own frame, and which slot is answered beside the name, so the caller can point every use of it at the stopped frame's storage instead ([Tast.rewrite_locals]). *) -let expression_in_scope env ~(scope : (string * Types.t * bool) list) +let expression_in_scope env ~(scope : (string * Types.t * bool * bool) list) (e : Ast.expr) : Tast.expr * Types.t array * string option array * (string * int) list = let ctx = invented_ctx env Types.Unit in let bound = List.map - (fun (name, ty, assignable) -> (name, bind ctx name ty ~assignable)) + (fun (name, ty, assignable, by_as) -> + let what = if by_as then Some as_tag else None in + (name, bind ctx ?what name ty ~assignable:(assignable && not by_as))) scope in let t = expect ctx e.Ast.loc ~want:None (check ctx e) in diff --git a/lib/emit.ml b/lib/emit.ml index c519af35..73c595aa 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -4876,7 +4876,7 @@ let emit_startup m ?(hidden = false) (globals : Tast.global list) = own to live in. *) List.iter (emit_global m ~hidden) flags; emit_fn m ~hidden - { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; + { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; as_slots = []; ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None; floc = (List.hd computed).Tast.ginit.Tast.loc }; true diff --git a/lib/session.ml b/lib/session.ml index 30f426b2..4363b65a 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1371,7 +1371,7 @@ let eval ?(origin = "") ?base ?forms ?pause ?(step = false) ?(running = tr { Tast.name = Printf.sprintf "install/%d" t.thunks; params = []; ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None; floc = loc; - slots = [||]; snames = [||] } + slots = [||]; snames = [||]; as_slots = [] } in let ir = match run_thunk with @@ -2122,7 +2122,8 @@ let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path scratch and have none to keep. *) snames = Array.append bnames - (Array.make (List.length !extra) None) } + (Array.make (List.length !extra) None); + as_slots = [] } in (* A struct copy the values named first, laid out in this module and kept, as [eval_expr] keeps one. *) @@ -2258,7 +2259,8 @@ let arm_restart ?(origin = "") t ~index ~(params : Types.t list) @ [ nullary "flan/dev-end" ]; fdefers = []; fenv = None; fparent = None; floc = loc; slots = Array.append base (Array.of_list (List.rev !extra)); - snames = Array.append bnames (Array.make (List.length !extra) None) } + snames = Array.append bnames (Array.make (List.length !extra) None); + as_slots = [] } in let copies = Check.fresh_copies t.env t.program.Tast.structs in let program = @@ -2310,7 +2312,10 @@ let in_frame t ~frame:(index, (fn : Tast.fn), bound) (parsed : Ast.expr) = @ List.filter (fun (i, _) -> List.mem i bound) named in let scope = - List.map (fun (i, name) -> (name, fn.Tast.slots.(i), i >= nparams)) order + List.map + (fun (i, name) -> + (name, fn.Tast.slots.(i), i >= nparams, List.mem i fn.Tast.as_slots)) + order in let checked, base, bnames, syn = Check.expression_in_scope t.env ~scope parsed in let table = List.map2 (fun (i, name) (_, j) -> (j, (i, name))) order syn in @@ -2436,7 +2441,8 @@ let eval_expr ?(origin = "") ?(pause = false) ?frame t src : change = slots = Array.append base (Array.of_list (List.rev !extra)); (* The expression's own [let]s keep their names; the slots [render] added behind them are the walk's own scratch and have none to keep. *) - snames = Array.append bnames (Array.make (List.length !extra) None) } + snames = Array.append bnames (Array.make (List.length !extra) None); + as_slots = [] } in (* Built against the program but never spliced into it: an evaluation is not a declaration, and adding one would leave the session carrying an eval/N diff --git a/lib/tast.ml b/lib/tast.ml index e297c882..2d806b90 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -354,6 +354,10 @@ type fn = { backend is free to ignore it entirely -- nothing is *resolved* through it, and a slot is still only ever referred to by index. *) snames : string option array; + (* The slots an [as] bound (decision 136): named, and read-only, so + evaluating in a stopped frame may read them and may not assign them, + as the program itself may not. *) + as_slots : int list; ret : Types.t; body : expr list; (* The defers again, innermost first. [body] already has them spliced onto diff --git a/test/test_dev.ml b/test/test_dev.ml index 31bff637..3b77dbc7 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2533,7 +2533,36 @@ let () = (match List.assoc_opt "e" rows with | Some ("dyn", v) when Test_support.contains v "hi" -> () | Some (ty, v) -> fail "locals show e as %s %s (%s)" ty v backend - | None -> fail "locals do not show e (%s)" backend) + | None -> fail "locals do not show e (%s)" backend); + (* Eval-in-frame reads them and, as the program may not, cannot + assign them. *) + let eval code = + ask + (Printf.sprintf "(:op \"eval-expr\" :frame 0 :code %s :syntax \"indented\")" + (Wire.quote code)) + in + let r = eval "g + 1" in + if Wire.string_field r "value" <> Some "42" then + fail "eval-in-frame g + 1 (%s): %s" backend + (Option.value ~default:(status r) (Wire.string_field r "message")); + List.iter + (fun (code, name) -> + let r = eval code in + if status r = "ok" then + fail "eval-in-frame %s was accepted (%s)" code backend + else if + not + (Test_support.contains + (Option.value ~default:"" (Wire.string_field r "message")) + (name ^ " names what an as test found")) + then + fail "eval-in-frame %s (%s) said: %s" code backend + (Option.value ~default:"" (Wire.string_field r "message"))) + [ ("g = 7", "g"); ("e = 1", "e") ]; + let r = eval "g" in + if Wire.string_field r "value" <> Some "41" then + fail "g changed after a refused assignment (%s): %s" backend + (Option.value ~default:(status r) (Wire.string_field r "value")) end; ignore (ask "(:op \"close\")"); Unix.close c; diff --git a/test/test_flan.ml b/test/test_flan.ml index 9154491e..d736e89f 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1507,6 +1507,15 @@ let () = refuses_all ~fln:true "~~ in .fln" "fn f(a: bool) -> i32\n ~~a\n" "~~ works on the bits"; refuses_all ~fln:true "^^ in .fln" "fn f(a: bool, b: bool) -> bool\n a ^^ b == 0\n" "write a != b"; + (* A name an as bound is read-only, and says so as itself, not as a + parameter (decision 136). *) + refuses_all ~fln:true "assigning an as name" + "fn f(o: i32?, d) -> i32\n if o as g and d as e\n g = 5\n g\n else\n 0\n" + "g names what an as test found, and it cannot be given a new value. To \ + change it, copy it into a local first: let g2 = g"; + refuses_all ~fln:true "assigning a dyn as name" + "fn f(o: i32?, d) -> i32\n if o as g and d as e\n e = 5\n g\n else\n 0\n" + "e names what an as test found"; rejects_check "popcount of a float" "(defn f [a f64] f64 (popcount a))" ~needle:"popcount takes integers, found f64"; rejects_check "a rotation's count does not widen the value" diff --git a/test/test_session.ml b/test/test_session.ml index 6df9c9d2..4b6dc915 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -1805,7 +1805,7 @@ let () = { Tast.name = "f"; params = []; ret = Types.Unit; body = []; fdefers = []; fenv = None; fparent = None; floc = Loc.unknown; slots = Array.make (Array.length snames) (Types.Int Types.I32); - snames } + snames; as_slots = [] } in (match Session.shown_names (fn [| Some "k~2"; None |]) with | [| Some "k"; None |] -> () From 5a8e7fa87b9f84ad28174dec472daff9d0224e41 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 18:21:09 +0700 Subject: [PATCH 16/16] TODO.org records that eval-in-frame can assign loop indices and pattern bindings. --- TODO.org | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TODO.org b/TODO.org index 4ce1c9ce..0b8fcdc2 100644 --- a/TODO.org +++ b/TODO.org @@ -1646,6 +1646,9 @@ are a dyn vector, except numbers with no common type, which are refused. Rules out the first element typing the rest. * Dev loop +** TODO eval-in-frame can assign names the program cannot +A loop index or a pattern binding in a stopped frame takes =x = …= through eval-expr, where +the program refuses it; only =as= names are marked read-only (=Tast.fn.as_slots=). ** WAIT Three dev-session tests fail intermittently under load Parked 2026-09-26 until the features land: "a restart accepted with a read queued behind it" (test_agent), "a parked session with no main" (test-flan.el), and a connect ENOENT in