diff --git a/TODO.org b/TODO.org index 0c205182..13ed389d 100644 --- a/TODO.org +++ b/TODO.org @@ -10,6 +10,9 @@ pointing at it. A CANCELLED entry carries the one-line reason, because an idea rejected without a record is an idea that gets re-proposed. * Language surface +** CANCELLED rand-int returns i64 +Decided 2026-09-26 (134): rand-int stays u64; write rand-int-range(lo, hi) for a signed +range. ** DONE A literal's reading is fixed where it is bound CLOSED: [2026-09-26] Decision 132, clarifying 117: a vector, map or text literal is typed only when its own @@ -801,9 +804,14 @@ One spelling for one operation; != stays, and not= is refused with a suggestion of !=. * Checker -** TODO A dyn operand past the second in a + fold is converted to the running type -=(+ 1 2 d)= with d a dyn char prints 100: the dyn is unboxed to i32 before adding, where -rule 117 says typed beside dyn gives dyn (=(+ 3 d)= gives =\d=). Predates the char lane. +** 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 9bb94eb6..48360e96 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -11805,21 +11805,30 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args = (* Left to right, each step char arithmetic when a char is in it and the ordinary join when none is: (- \z \a 1) is 25 - 1, and (+ 1 2 \a) is 3 + \a. *) - let step acc (arg : Ast.expr) = - let lit = char_lit arg in - untyped := !untyped && int_lit arg; - if is_char acc || maybe_char ctx arg || lit then - let v = check ctx arg in - if is_char acc || is_char v then char_step ~want:nwant loc name acc v - else mk loc acc.Tast.ty (Tast.Prim (p, [ acc; expect ctx arg.Ast.loc ~want:(Some acc.Tast.ty) v ])) - else - mk loc acc.Tast.ty (Tast.Prim (p, [ acc; check ctx ~want:acc.Tast.ty arg ])) + let rec steps acc = function + | [] -> expect ctx loc ~want acc + | (arg : Ast.expr) :: tl -> + let lit = char_lit arg in + untyped := !untyped && int_lit arg; + if is_char acc || maybe_char ctx arg || lit then + let v = check ctx arg in + if v.Tast.ty = Types.Dyn then dyn_fold ctx ~want loc name [ acc; v ] tl + else if is_char acc || is_char v then + steps (char_step ~want:nwant loc name acc v) tl + else + match fold_operand ctx acc.Tast.ty (expect ctx arg.Ast.loc ~want:(Some acc.Tast.ty) v) 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 + else + match fold_operand ctx acc.Tast.ty (check ctx ~want: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 let first = if is_char a || is_char b then char_step ~want:nwant loc name a b else mk loc a.Tast.ty (Tast.Prim (p, [ a; b ])) in - expect ctx loc ~want (List.fold_left step first rest) + steps first rest else if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then dyn_fold ctx ~want loc name [ a; b ] rest else begin @@ -11835,16 +11844,27 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args = answered again, per copy, at the instantiation. *) if not (ok a.Tast.ty || generic_ty a.Tast.ty) then not_numeric name what a; let ty = a.Tast.ty in - let acc = - List.fold_left - (fun acc arg -> - mk loc ty (Tast.Prim (p, [ acc; check ctx ~want:ty arg ]))) - (mk loc ty (Tast.Prim (p, [ a; b ]))) - rest + let rec steps acc = function + | [] -> expect ctx loc ~want acc + | arg :: tl -> + match fold_operand ctx ty (check ctx ~want: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 - expect ctx loc ~want acc + steps (mk loc ty (Tast.Prim (p, [ a; b ]))) rest end +(* An operand past a fold's first pair, checked at the type so far. A dyn one + is taken back as the dyn it was, not opened at that type: a typed operand + beside a dyn gives dyn (rule 117), so from there on the fold is the dyn + runtime's, and (+ 1 2 d) is (+ 3 d). *) +and fold_operand ctx ty (v : Tast.expr) = + if v.Tast.ty = Types.Dyn && not (Types.equal ty Types.Dyn) then `Dyn v + else + match opened_dyn ~box:(to_dyn ctx) v with + | Some d -> `Dyn d + | None -> `Typed v + (* 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. *) @@ -11941,11 +11961,12 @@ and dyn_fold ctx ~want loc name first rest = | "+" -> "flan_dyn_add" | "-" -> "flan_dyn_sub" | "*" -> "flan_dyn_mul" | "/" -> "flan_dyn_div" | "%" -> "flan_dyn_rem" + | "min" -> "flan_dyn_min" | "max" -> "flan_dyn_max" | _ -> dyn_bits_sym name in (* A bitwise fold takes integers on both sides, and the typed side of a mixed pair can be asked now rather than at run time. *) - let bitwise = not (List.mem name [ "+"; "-"; "*"; "/"; "%" ]) in + let bitwise = not (List.mem name [ "+"; "-"; "*"; "/"; "%"; "min"; "max" ]) in if bitwise then List.iter (fun (v : Tast.expr) -> @@ -13416,7 +13437,8 @@ 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. *) - if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then begin + (* [ops] are every operand, boxed. *) + let dyn_chain ops = let sym = match name with | "=" | "!=" -> "flan_dyn_eq" @@ -13443,15 +13465,15 @@ and named_call ?(qualified = false) ctx ~want loc name args = let r = match rest with | [] -> link (box loc a) (box loc b) - | _ -> - let ops = - box loc a :: box loc b - :: map_lr (fun e -> box loc (check ctx ~want:Types.Dyn e)) rest - in - cmp_over ctx loc Types.Dyn ~pairs ~link ops + | _ -> cmp_over ctx loc Types.Dyn ~pairs ~link (ops ()) in expect ctx loc ~want r - end else begin + 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) + 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 type exists to answer — ordering handles would order a slot index, @@ -13486,8 +13508,18 @@ 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 ops = a :: b :: map_lr (fun e -> check ctx ~want:ty e) rest in - expect ctx loc ~want (cmp_over ctx loc ty ~pairs ~link ops) + let rest = map_lr (fun e -> fold_operand ctx ty (check ctx ~want:ty e)) 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) + else + let ops = + a :: b :: List.map (function `Typed v -> v | `Dyn d -> d) rest in + expect ctx loc ~want (cmp_over ctx loc ty ~pairs ~link ops) end | "not" -> arity ctx loc name 1 args; @@ -13598,7 +13630,10 @@ and named_call ?(qualified = false) ctx ~want loc name args = let x, y, rest = match args with x :: y :: rest -> x, y, rest | _ -> assert false in - let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in + let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) [ x; y ] in + if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then + dyn_fold ctx ~want loc name [ a; b ] rest + else begin (* [min] and [max] are [<] with a pick, so [is-ordered] is what they want — not [is-numeric]. A generic that declares [is-ordered] gets both. @@ -13625,9 +13660,15 @@ and named_call ?(qualified = false) ctx ~want loc name args = mk loc ty (Tast.Let ([ (sa, a); (sb, b) ], [ mk loc ty (Tast.If (test, la, lb)) ])) in - expect ctx loc ~want - (List.fold_left (fun acc arg -> pick acc (check ctx ~want:ty arg)) - (pick a b) rest) + let rec steps acc = function + | [] -> expect ctx loc ~want acc + | arg :: tl -> + match fold_operand ctx ty (check ctx ~want:ty arg) with + | `Typed v -> steps (pick acc v) tl + | `Dyn d -> dyn_fold ctx ~want loc name [ acc; d ] tl + in + steps (pick a b) rest + end (* A type handed to the prelude's slice reductions: the reach for the type-limit constants under the name of the reduction beside them. *) | ("max-of" | "min-of") diff --git a/lib/emit.ml b/lib/emit.ml index 718c5be7..12bf55ca 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5117,6 +5117,8 @@ declare i64 @flan_dyn_lt(i64, i64, ptr, i64) declare i64 @flan_dyn_le(i64, i64, ptr, i64) declare i64 @flan_dyn_gt(i64, i64, ptr, i64) declare i64 @flan_dyn_ge(i64, i64, ptr, i64) +declare i64 @flan_dyn_min(i64, i64, ptr, i64) +declare i64 @flan_dyn_max(i64, i64, ptr, i64) declare i64 @flan_dyn_eq(i64, i64) declare i64 @flan_dyn_len(i64) declare i64 @flan_dyn_eq_at(i64, i64, ptr, i64) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 12ec2950..d3c8fcbf 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -3382,6 +3382,30 @@ flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, return flan_dyn_from_bool(c == 1 || c == 0); } +/* The pick of min and max: numbers by value, keeping the one picked as it is + * (an int stays an int), and chars by code point. Anything else traps, text + * included, since min over text has no typed counterpart. The first is picked + * only when it is strictly less (or greater), so a tie or a NaN answers the + * second, as the typed (if (< a b) a b) does. */ +static flan_dyn pick(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn a, flan_dyn b, int want) { + int both_chars = flan_dyn_tag(a) == FLAN_DYN_TAG_CHAR && + flan_dyn_tag(b) == FLAN_DYN_TAG_CHAR; + if (!both_chars && !(is_num(a) && is_num(b))) + trap2(loc, loclen, TYPE_TRAP, op, + "it picks between two numbers or two chars, and these are neither", + a, b); + return order(loc, loclen, op, a, b) == want ? a : b; +} +flan_dyn flan_dyn_min(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return pick(loc, loclen, "min", a, b, -1); +} +flan_dyn flan_dyn_max(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return pick(loc, loclen, "max", a, b, 1); +} + /* ── Equality ────────────────────────────────────────────────────────── * * Structural, and the only operation here that never traps: two values of diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 2595b756..e7399cca 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -231,6 +231,11 @@ flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +/* Answer whichever of a and b is less (min) or greater (max), b on a tie: + * numbers by value, chars by code point; anything else traps. */ +flan_dyn flan_dyn_min(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_max(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); + /* Structural, and the one operation in this file that never traps: two values * of unrelated tags are not an error, they are unequal. */ flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b); diff --git a/test/programs/dyn-fold-position.flan b/test/programs/dyn-fold-position.flan new file mode 100644 index 00000000..a485509f --- /dev/null +++ b/test/programs/dyn-fold-position.flan @@ -0,0 +1,47 @@ +;;;; A dyn operand anywhere in a fold makes the fold dyn from there on: the +;;;; typed operands before it are folded typed, and the dyn runtime takes the +;;;; rest. (+ 1 2 d) is (+ 3 d), whichever position the dyn is in. + +(defn as-i32 [x i32] i32 x) +(defn as-f64 [x f64] f64 x) + +(defn loud [x i32] i32 (println "i" x) x) +(defn loud-dyn [x dyn] dyn (println "d" x) x) + +(defn main [args [str]] i32 + (let [d (the dyn \a) + f (the dyn 2.5) + n (the dyn 4) + c \a] + ;; + and - over a dyn char: first, middle, last. + (println (+ d 1 2) (+ 1 d 2) (+ 1 2 d)) + (println (- d 1 2) (- 10 n 1) (- 10 1 n)) + ;; A dyn float past an integer pair promotes, as (* 6 f) does. + (println (* f 2 3) (* 2 f 3) (* 2 3 f)) + (println (/ f 2 5) (/ 9 f 2) (/ 9 2 f)) + (println (+ 1 2 3 f) (- 10 1 2 f)) + ;; A char fold with a dyn past the pair. + (println (+ c 1 n) (- c 1 n) (+ c 1 2 n)) + ;; The bitwise folds. + (println (bit-or n 1 2) (bit-or 1 n 2) (bit-or 1 2 n)) + (println (bit-and n 7 6) (bit-and 7 n 6) (bit-and 7 6 n)) + (println (bit-xor n 1 2) (bit-xor 1 n 2) (bit-xor 1 2 n)) + ;; Comparison chains: a float past an integer pair is compared as one. + (println (< f 3 4) (< 1 f 3) (< 1 2 f) (< 1 3 f)) + (println (<= 2 2 f) (> 3 2 f) (>= 3 3 f) (>= 3 3 n)) + (println (= 4 4 n) (= 4 n 4) (= n 4 4) (= 4 4 f)) + (println (!= 1 2 n) (!= 1 4 n) (!= 2 f 3)) + ;; min and max: numbers by value, the one picked kept as it is, and + ;; chars by code point. + (println (min f 3 4) (min 3 f 4) (min 3 4 f) (min 1 2 f)) + (println (max n 1 2) (max 1 n 2) (max 1 2 n) (max 5 6 n)) + (println (min d \c \b) (max \b d \c) (max \b \c d) (min 1.5 2.5 n)) + ;; Each operand is evaluated once, left to right. + (println (min (loud 3) (loud 2) (loud-dyn n) (loud 1))) + (println (max (loud 3) (loud-dyn n) (loud 9))) + ;; With an argument, min over a number and a text traps at the form. + (when (> (length args) 1) + (println (min 1 2 (the dyn "a")))) + ;; At a typed want the dyn answer is opened at the end. + (println (as-i32 (+ 1 2 n)) (as-f64 (* 2 3 f)))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 4f986296..1233fb1c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5638,6 +5638,33 @@ level "1" char_arith_out; outputs ~x86:true "char: arithmetic, --x86" "programs/char-arith.flan" char_arith_out; + (* A dyn anywhere in a fold makes it dyn from there on (rule 117): each + family with the dyn first, in the middle and last. *) + let fold_out = + "d d d\n^ 5 5\n15 15 15\n0.25 1.8 1.6\n8.5 4.5\nf \\ h\n7 7 7\n\ + 4 4 4\n7 7 7\ntrue true true false\ntrue false true false\n\ + true true true false\ntrue false true\n2.5 2.5 2.5 1\n4 4 4 6\n\ + a c c 1.5\ni 3\ni 2\nd 4\ni 1\n1\ni 3\nd 4\ni 9\n9\n7 15\n" + in + outputs "dyn: a dyn in any fold position" "programs/dyn-fold-position.flan" + fold_out; + outputs ~opt:"-O0" "dyn: a dyn in any fold position, -O0" + "programs/dyn-fold-position.flan" fold_out; + outputs ~x86:true "dyn: a dyn in any fold position, --x86" + "programs/dyn-fold-position.flan" fold_out; + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/dyn-fold-position.flan" in + let code, text = run exe (Some "x") in + let want = "programs/dyn-fold-position.flan:44:16: dyn min: int and \ + text, and it picks between two numbers or two chars" in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf "FAIL dyn: min over a number and a text traps%s\n \ + got: %S (exit %d)\n" + (if x86 then ", --x86" else "") text code + end) + [ false; true ]; List.iter (fun x86 -> let exe = compile ~x86 "programs/char-arith.flan" in