Detect uses of variant-only Is_int on non-variant values

middle_end/flambda2/types/provers.ml

@@ -77,8 +77,8 @@ let prove_equals_to_simple_of_kind_value env t : Simple.t proof_of_property =
       | simple -> Proved simple)
 
 (* Note: this function is used for simplifying Obj.is_int, so should not assume
-   that the argument represents a variant *)
-let prove_is_int_generic env t : bool generic_proof =
+   that the argument represents a variant, unless [variant_only] is [true] *)
+let prove_is_int_generic ~variant_only env t : bool generic_proof =
   match expand_head env t with
   | Value (Ok (Variant blocks_imms)) -> (
     match blocks_imms.blocks, blocks_imms.immediates with
@@ -93,19 +93,23 @@ let prove_is_int_generic env t : bool generic_proof =
       else if is_bottom env imms
       then Proved false
       else Unknown)
+  | Value (Ok (Mutable_block _)) -> Proved false
   | Value
       (Ok
-        ( Mutable_block _ | Boxed_float _ | Boxed_int32 _ | Boxed_int64 _
-        | Boxed_vec128 _ | Boxed_nativeint _ | Closures _ | String _ | Array _
-          )) ->
-    Proved false
+        ( Boxed_float _ | Boxed_int32 _ | Boxed_int64 _ | Boxed_vec128 _
+        | Boxed_nativeint _ | Closures _ | String _ | Array _ )) ->
+    if variant_only then Invalid else Proved false
   | Value Unknown -> Unknown
   | Value Bottom -> Invalid
   | Naked_immediate _ | Naked_float _ | Naked_int32 _ | Naked_int64 _
   | Naked_nativeint _ | Naked_vec128 _ | Rec_info _ | Region _ ->
     wrong_kind "Value" t
 
-let prove_is_int env t = as_property (prove_is_int_generic env t)
+let prove_is_int env t =
+  as_property (prove_is_int_generic ~variant_only:false env t)
+
+let meet_is_int_variant_only env t =
+  as_meet_shortcut (prove_is_int_generic ~variant_only:true env t)
 
 (* Note: this function returns a generic proof because we want to propagate the
    Invalid cases to prove_naked_immediates_generic, but it's not suitable for
@@ -152,7 +156,7 @@ let prove_naked_immediates_generic env t : Targetint_31_63.Set.t generic_proof =
   | Naked_immediate (Ok (Naked_immediates is)) ->
     if Targetint_31_63.Set.is_empty is then Invalid else Proved is
   | Naked_immediate (Ok (Is_int scrutinee_ty)) -> (
-    match prove_is_int_generic env scrutinee_ty with
+    match prove_is_int_generic ~variant_only:true env scrutinee_ty with
     | Proved true ->
       Proved (Targetint_31_63.Set.singleton Targetint_31_63.bool_true)
     | Proved false ->

middle_end/flambda2/types/provers.mli

@@ -114,6 +114,9 @@ val prove_unique_tag_and_size :
 
 val prove_is_int : Typing_env.t -> Type_grammar.t -> bool proof_of_property
 
+val meet_is_int_variant_only :
+  Typing_env.t -> Type_grammar.t -> bool meet_shortcut
+
 val prove_get_tag :
   Typing_env.t -> Type_grammar.t -> Tag.Set.t proof_of_property
 

middle_end/flambda2/types/reify.ml

@@ -351,10 +351,11 @@ let reify ~allowed_if_free_vars_defined_in ~var_is_defined_at_toplevel
       | None -> try_canonical_simple ()
       | Some i -> Simple (Simple.const (Reg_width_const.naked_immediate i)))
     | Naked_immediate (Ok (Is_int scrutinee_ty)) -> (
-      match Provers.prove_is_int env scrutinee_ty with
-      | Proved true -> Simple Simple.untagged_const_true
-      | Proved false -> Simple Simple.untagged_const_false
-      | Unknown -> try_canonical_simple ())
+      match Provers.meet_is_int_variant_only env scrutinee_ty with
+      | Known_result true -> Simple Simple.untagged_const_true
+      | Known_result false -> Simple Simple.untagged_const_false
+      | Need_meet -> try_canonical_simple ()
+      | Invalid -> Invalid)
     | Naked_immediate (Ok (Get_tag block_ty)) -> (
       match Provers.prove_get_tag env block_ty with
       | Proved tags -> (

ocaml/testsuite/tests/flambda/is_int_string.ml

@@ -0,0 +1,18 @@
+(* TEST
+   * flambda2
+   flags = "-flambda2-advanced-meet"
+   ** native
+*)
+
+type _ opt_or_string =
+ | S : string opt_or_string
+ | O : string option opt_or_string
+
+let to_string (type a) (x : a opt_or_string) (y : a) : string =
+  match x, y with
+  | S, s -> s
+  | O, None -> ""
+  | O, Some s -> s
+
+let test () =
+  to_string (Sys.opaque_identity S) "foo"