diff --git a/lib/check.ml b/lib/check.ml index 6331cba6..03bd3086 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -11583,11 +11583,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) -> @@ -13239,7 +13240,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 [ordered?] is what they want — not [numeric?]. A generic that declares [ordered?] gets both. @@ -13266,15 +13270,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 -> - (* A dyn is refused here as it is in the first pair, rather than - opened at the type so far. *) - match fold_operand ctx ty (check ctx ~want:ty arg) with - | `Typed v -> pick acc v - | `Dyn d -> not_numeric name "numbers" d; acc) - (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 2f28d53e..6247a22e 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5113,6 +5113,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 f7bd7c4a..889c6311 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 f8591676..6b0edee3 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 index e3e80b7f..a485509f 100644 --- a/test/programs/dyn-fold-position.flan +++ b/test/programs/dyn-fold-position.flan @@ -5,7 +5,10 @@ (defn as-i32 [x i32] i32 x) (defn as-f64 [x f64] f64 x) -(defn main [] i32 +(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) @@ -28,6 +31,17 @@ (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 522e9ae8..6b4aff4a 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5615,7 +5615,8 @@ level "1" 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\n7 15\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; @@ -5623,6 +5624,19 @@ level "1" "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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 60ede47d..2e8d3f8b 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -8450,14 +8450,5 @@ let () = "(defn f [n i32] (Option i32) (cond (= n 1) 10 (= n 2) 20))\n(defn main [] ())"; rejects_check "a map's get takes one key" ~needle:"a map's get takes one key" "(defn main [] () (let [m (map-new i32 i32)] (println (get m 1 2))))"; - (* min and max have no dyn lowering: a dyn past the first pair is refused - as one in it is, not opened at the type so far. *) - List.iter - (fun op -> - rejects_check (op ^ " refuses a dyn past its first pair") - ~needle:(op ^ " takes numbers, found dyn") - (Printf.sprintf - "(defn main [] () (let [f (the dyn 2.5)] (println (%s 3 4 f))))" op)) - [ "min"; "max" ]; Test_support.report ()