A dyn opened by an expectation is marked where it is opened, so a bool or an Option beside a dyn stays a dyn, and an operand refused at a type is not asked again, so nested sums and matches check in linear time

lib/check.ml

@@ -4108,6 +4108,17 @@ let box loc (e : Tast.expr) : Tast.expr =
   | Types.LArray _ ->
     no_dyn_yet loc ~into:true e.Tast.ty ""
 
+(* Every dyn an expectation opened ([expect]'s dyn arm), by the node that
+   opened it, and the box: what lets a caller that asked for a typed value
+   see that the value was a dyn, whichever opening the want picked. Keyed by
+   identity and held weakly, so it is gone with the tree. *)
+module Opened = Ephemeron.K1.Make (struct
+    type t = Tast.expr
+    let equal = ( == )
+    let hash = Hashtbl.hash
+  end)
+let opened_by_want : Tast.expr Opened.t = Opened.create 16
+
 let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
   let need sym ty = rt loc ty sym [ e ] in
   match want with
@@ -4485,6 +4496,10 @@ let expect ctx loc ~want (got : Tast.expr) =
       | Types.Dyn, Types.Dyn -> got
       | Types.Dyn, Types.Option t -> box_option ctx loc t got
       | Types.Dyn, _ -> box loc got
+      | Types.Option t, Types.Dyn when not (is_nil_lit got) ->
+        let opened = unbox_option ctx loc t got in
+        Opened.replace opened_by_want opened got;
+        opened
       | Types.Option t, Types.Dyn -> unbox_option ctx loc t got
       (* A bare T has no None to become, and this nil is one the checker can
          actually see — the literal, written right where the mismatch is.
@@ -4496,7 +4511,10 @@ let expect ctx loc ~want (got : Tast.expr) =
            or to dyn itself; wrap the type in Option, or keep the value dyn"
           (Types.to_string w)
       | _, Types.Dyn when Types.fits ~expected:w ~actual:Types.Dyn -> got
-      | _, Types.Dyn -> unbox loc w got
+      | _, Types.Dyn ->
+        let opened = unbox loc w got in
+        Opened.replace opened_by_want opened got;
+        opened
       (* Implicit widening, and this single arm is the whole of its surface.
          [expect] is called by every site that annotates and by nothing else,
          so an argument, a return, a let or defonce with a type, a struct field
@@ -5357,11 +5375,21 @@ let arm_failed :
    the dyn one opened — whichever is written first. *)
 let not_kept = "check/arm-not-kept"
 
-let opened_dyn (v : Tast.expr) =
+let rec opened_dyn (v : Tast.expr) =
   match v.Tast.e with
-  | Tast.Prim (Tast.Rt ("flan_dyn_need_i64" | "flan_dyn_need_f64"), [ inner ])
+  (* A block — a match arm's body — opened its last form. *)
-    when Types.equal inner.Tast.ty Types.Dyn -> Some inner
+  | Tast.Do (_ :: _ as xs) ->
-  | _ -> None
+    let rec split = function
+      | [ l ] -> ([], l)
+      | x :: r -> let i, l = split r in (x :: i, l)
+      | [] -> assert false
+    in
+    let init, last = split xs in
+    Option.map
+      (fun (box : Tast.expr) ->
+         { v with Tast.e = Tast.Do (init @ [ box ]); ty = Types.Dyn })
+      (opened_dyn last)
+  | _ -> Opened.find_opt opened_by_want v
 
 
 (* A Vec or a Map parameter is a copy of the caller's header — Odin's rule —
@@ -13988,6 +14016,25 @@ and join_pair ctx (a : Tast.expr) (y : Ast.expr) (d : Loc.diag) =
      | Some pair -> pair
      | None -> raise (Loc.Error d))
 
+(* [y] checked at [w] in a trial, and a refusal kept ([arm_failed]) so the
+   same operand asked again at the same type, in the same scope, is refused
+   without being walked: a chain of these nested in their second operands is
+   asked once per level above it. *)
+and trial_at ctx (y : Ast.expr) (w : Types.t) =
+  match
+    List.find_opt
+      (fun (n, (sc, r), w', _) ->
+         n == y && r == ctx.ret && Types.equal w' w && same_scope sc ctx.scope)
+      (Hashtbl.find_all arm_failed y.Ast.loc)
+  with
+  | Some (_, _, _, d) -> Error d
+  | None ->
+    (match trial ctx (fun () -> check ctx ~want:w y) with
+     | Ok b -> Ok b
+     | Error d ->
+       Hashtbl.add arm_failed y.Ast.loc (y, (ctx.scope, ctx.ret), w, d);
+       Error d)
+
 and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
   match args with
   | [ x; y ] ->
@@ -14034,9 +14081,7 @@ and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
       let at_a =
         if a.Tast.ty = Types.Dyn then None
         else
-          match trial ctx (fun () -> check ctx ~want:a.Tast.ty y) with
+          Some (trial_at ctx y a.Tast.ty)
-          | Ok b' -> Some (Ok b')
-          | Error d -> Some (Error d)
       in
       match at_a with
       | Some (Ok b') ->
@@ -14066,7 +14111,7 @@ and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
         (match
            match at_a with
            | Some (Error d) -> Error d
-           | _ -> trial ctx (fun () -> check ctx ~want:a.Tast.ty y)
+           | _ -> trial_at ctx y a.Tast.ty
          with
          | Ok b' -> a, b'
          | Error d ->
@@ -14078,10 +14123,16 @@ and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
     end
     else begin
       let a = check ctx ?want x in
-      match trial ctx (fun () -> check ctx ~want:a.Tast.ty y) with
+      match trial_at ctx y a.Tast.ty with
       | Ok b -> a, b
       | Error d ->
-        if join && reconsiderable d then join_pair ctx a y d
+        (* The join moves [a] to something wider, and [a] already has the
+           type asked of the whole: that can only be refused, so y is not
+           walked on its own terms to find it out. *)
+        let doomed =
+          match want with Some w -> Types.equal a.Tast.ty w | None -> false
+        in
+        if join && reconsiderable d && not doomed then join_pair ctx a y d
         else raise (Loc.Error d)
     end
   | _ -> fail loc "%s takes two arguments" name

test/programs/dyn-opened.flan

@@ -0,0 +1,25 @@
+;;;; A dyn beside a typed value is compared, added and joined as a dyn, in
+;;;; either order, whichever conversion asking for the typed value would have
+;;;; opened it with — a bool compared with a dyn int is false, not a trap.
+
+(defn as-dyn [d dyn] dyn d)
+(defn eqb [b bool d dyn] bool (= b d))
+(defn eqi [b i64 d dyn] bool (= b d))
+(defn addf [b f64 d dyn] dyn (+ b d))
+(defn addi [b i64 d dyn] dyn (+ b d))
+(defn mb [o (Option i32) b bool d dyn] dyn (let [v (match o (Some q) b None d)] v))
+(defn mb2 [o (Option i32) b bool d dyn] dyn (let [v (match o None d (Some q) b)] v))
+(defn ib [c bool b bool d dyn] dyn (let [v (if c b d)] v))
+(defn ib2 [c bool b bool d dyn] dyn (let [v (if c d b)] v))
+
+(defn main [] i32
+  (println (eqb true (as-dyn 1)))
+  (println (eqb true (as-dyn true)))
+  (println (eqi 1 (as-dyn 1.0)))
+  (println (addi 1 (as-dyn 1.5)))
+  (println (addf 1.0 (as-dyn 2)))
+  (println (mb None true (as-dyn 5)))
+  (println (mb2 None true (as-dyn 5)))
+  (println (ib false true (as-dyn 5)))
+  (println (ib2 true true (as-dyn 5)))
+  0)

test/test_acceptance.ml

@@ -590,6 +590,11 @@ let () =
       "programs/return-defer.flan" rd_out;
     outputs ~x86:true "a return computes its value before its defers, x86"
       "programs/return-defer.flan" rd_out;
+    (* A dyn opened by the other operand's or arm's type is seen as a dyn. *)
+    let do_out = "false\ntrue\ntrue\n2.5\n3\n5\n5\n5\n5\n" in
+    outputs "a dyn beside a typed value stays a dyn" "programs/dyn-opened.flan" do_out;
+    outputs ~x86:true "a dyn beside a typed value stays a dyn, x86"
+      "programs/dyn-opened.flan" do_out;
     (* An arm is checked at the other arm's type first. *)
     let aw_out =
       "2147483648\n2147483648\n10000000000\n2147483648\n1.5\n2147483648\n\

test/test_flan.ml

@@ -8061,6 +8061,34 @@ let () =
        "(if c p (do (println 1) 7))", "f [bool u8] u8");
       ("a match's nil arm first", "[o (Option i32) p (Option i64)]",
        "(match o None nil (Some z) p)", "f [(Option i32) (Option i64)] (Option i64)") ]);
+  (* Thirty deep, each level's first try refused: a chain of matches whose
+     last arm is wider, and sums nested in their second operands. *)
+  List.iter
+    (fun (what, src) ->
+       let t0 = Unix.gettimeofday () in
+       (match checked src with
+        | _ -> ()
+        | exception Loc.Error { Loc.dmsg; _ } -> check (what ^ ": " ^ dmsg) false);
+       check (what ^ " checks fast") (Unix.gettimeofday () -. t0 < 3.0))
+    (let nest f = let rec go k e = if k = 0 then e else go (k - 1) (f e) in go 30 in
+     [ ("thirty matches whose last arm is wider",
+        "(defn f [o (Option i32) a i64 b i32] i64 (let [v "
+        ^ nest (Printf.sprintf "(match o (Some q) (+ q 1) None (+ b %s))") "a"
+        ^ "] v))");
+       ("thirty matches with the narrow arm last",
+        "(defn f [o (Option i32) a i64 b i32] i64 (let [v "
+        ^ nest (Printf.sprintf "(match o None b (Some q) (+ b %s))") "a"
+        ^ "] v))");
+       ("thirty matches over a dyn at the bottom",
+        "(defn f [o (Option i32) d dyn b i32] dyn (let [v "
+        ^ nest (Printf.sprintf "(match o (Some q) q None (+ b %s))") "d"
+        ^ "] v))");
+       ("thirty sums nested in their second operands",
+        "(defn f [a i64 b i32] i64 (let [v "
+        ^ nest (Printf.sprintf "(+ b %s)") "a" ^ "] v))") ]);
+  rejects_check "an Option compared with a dyn, as before"
+    ~needle:"(Option i64) does not cross into dyn yet"
+    "(defn eqo [b (Option i64) d dyn] bool (= b d))\n(defn main [] ())";
   rejects_check "nil beside a string, as before"
     ~needle:"string"
     "(defn f [c bool s string] string (let [v (if c s nil)] v))\n(defn main [] ())";