A bit operator's operand of any shape that answers a bool gets the and, or or not hint, found by a check that is thrown away.

lib/check.ml

@@ -606,6 +606,9 @@ let builtin_names : string list ref = ref []
    twenty thousand calls. Filled beside the list. *)
 let builtin_set : (string, unit) Hashtbl.t = Hashtbl.create 128
 
+(* Set while [bool_operands] asks an operand its type; see there. *)
+let probing = ref false
+
 (* ── builtin/, the reserved qualifier ──────────────────────────────────
    [builtin/length] is the builtin [length], whatever else the program has
    decided [length] means. It is the way out of the dead end shadowing used to leave: a
@@ -10264,28 +10267,40 @@ and bits_operand ctx loc name (v : Tast.expr) =
 
 (* A bool operand is refused before the operands are joined, and not left to
    [bits_operand]: the join sees a bool beside an integer as a plain mismatch,
-   "expected i32, found bool", which says nothing of [and]. Only the operands
-   that are plainly bools are asked about, because asking is a second check
-   and these are free of side effects: a comparison or a [not], a name, a
-   field of one. Any other bool still arrives at [bits_operand]. *)
+   "expected i32, found bool", which says nothing of [and]. Each operand's own
+   type is asked in a trial that is always abandoned, so the check leaves no
+   trace — no slot, no lifted lambda, no recorded refusal — and the real check
+   below is the only one that counts. A literal is never a bool, and a call to
+   an arithmetic or bit operator answers a number or a dyn, so neither is
+   asked. Nor is anything asked while a probe is running: the probe wants a
+   type, and asking again inside it would check a nest of these once per
+   level for every level above it, which doubles with each level. *)
 and bool_operands ctx name (args : Ast.expr list) =
-  let rec plain (a : Ast.expr) =
+  if not !probing then
+  let never_bool (a : Ast.expr) =
     match a.Ast.e with
-    | Ast.Var _ -> true
-    | Ast.Field (t, _) -> plain t
+    | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ ->
+      true
+    | Ast.Call ({ Ast.e = Ast.Var h; _ }, _) ->
+      List.mem h
+        [ "+"; "-"; "*"; "/"; "%"; "bit-and"; "bit-or"; "bit-xor"; "bit-not";
+          "&&"; "||"; "^^"; "~~"; "<<"; ">>"; "rotate-left"; "rotate-right";
+          "popcount"; "leading-zeros"; "trailing-zeros" ]
+      && not (shadows_builtin ctx a.Ast.loc h)
     | _ -> false
   in
   let is_bool (a : Ast.expr) =
-    match a.Ast.e with
-    | Ast.Call ({ Ast.e = Ast.Var h; _ }, _)
-      when List.mem h [ "="; "!="; "<"; "<="; ">"; ">="; "not" ]
-           && not (shadows_builtin ctx a.Ast.loc h) ->
-      true
-    | _ when plain a ->
-      (match speculate ctx.env (fun () -> check ctx a) with
-       | v -> v.Tast.ty = Types.Bool
-       | exception Loc.Error _ -> false)
-    | _ -> false
+    (not (never_bool a))
+    &&
+    let ty = ref None in
+    probing := true;
+    Fun.protect ~finally:(fun () -> probing := false) (fun () ->
+        ignore
+          (trial ctx (fun () ->
+               let v = check ctx a in
+               ty := Some v.Tast.ty;
+               Loc.failk "check/probe" a.Ast.loc "abandoned")));
+    !ty = Some Types.Bool
   in
   List.iter (fun a -> if is_bool a then bool_bits a.Ast.loc name) args
 

test/test_flan.ml

@@ -1435,6 +1435,18 @@ let () =
     "(defn f [x i32 y i32] i32 (bit-and x (= x y)))" "write (and a b)";
   refuses_all "a bool field" "(defstruct S [on bool]) (defn f [s S] i32 (bit-or 1 (.on s)))"
     "write (or a b)";
+  refuses_all "a call that answers a bool"
+    "(defn p? [x i32] bool (> x 0)) (defn f [x i32] i32 (bit-and x (p? x)))"
+    "write (and a b)";
+  refuses_all "an if whose type is bool"
+    "(defn f [x i32 c bool] i32 (bit-or 1 (if c true false)))" "write (or a b)";
+  refuses_all "a dyn function's typed bool result"
+    "(defn p? [x] bool (> x 0)) (defn f [d dyn] i32 (<< 1 (p? d)))"
+    "combined with and, or and not";
+  refuses_all "a bool inside a nest of bit operations"
+    "(defn p? [x i32] bool (> x 0)) \
+     (defn f [x i32] i32 (bit-and x (bit-or x (bit-xor x (p? x)))))"
+    "write (!= a b)";
   refuses_all ~fln:true "&& in .fln, the bool first"
     "fn f(flag: bool, x: i32) -> i32\n  flag && x\n" "For true and false, write a and b";
   refuses_all ~fln:true "&& in .fln, a literal first"