diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs
index a510f8034d33..8667119c08ad 100644
--- a/compilerlibs/Makefile.compilerlibs
+++ b/compilerlibs/Makefile.compilerlibs
@@ -262,6 +262,7 @@ MIDDLE_END_FLAMBDA_TYPES=\
   middle_end/flambda/types/basic/or_bottom.cmo \
   middle_end/flambda/types/basic/string_info.cmo \
   middle_end/flambda/types/basic/or_unknown_or_bottom.cmo \
+  middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.cmo \
   middle_end/flambda/types/structures/code_age_relation.cmo \
   middle_end/flambda/types/structures/type_structure_intf.cmo \
   middle_end/flambda/types/structures/product_intf.cmo \
diff --git a/flambdatest/mlexamples/unboxing_need_poison.ml b/flambdatest/mlexamples/unboxing_need_poison.ml
new file mode 100644
index 000000000000..89a11f762e8d
--- /dev/null
+++ b/flambdatest/mlexamples/unboxing_need_poison.ml
@@ -0,0 +1,17 @@
+type ('a, 'b) t = A of int * 'a | B of 'b
+
+let[@inline] f b y z g =
+  let v =
+    if b then
+      A (42, g y)
+    else
+      B (g z)
+  in
+  match v with
+  | A (_, a) -> a + 2
+  | B c -> c + 2
+
+let[@inline] g x = 12
+
+let test b y z =
+  f b y z g
diff --git a/middle_end/flambda/basic/reg_width_const.ml b/middle_end/flambda/basic/reg_width_const.ml
index 024aff05f087..77ef407fb333 100644
--- a/middle_end/flambda/basic/reg_width_const.ml
+++ b/middle_end/flambda/basic/reg_width_const.ml
@@ -27,6 +27,15 @@ let kind t =
   | Naked_int32 _ -> K.naked_int32
   | Naked_int64 _ -> K.naked_int64
   | Naked_nativeint _ -> K.naked_nativeint
+  | Poison k -> begin
+      match k with
+      | Naked_immediate -> K.naked_immediate
+      | Value -> K.value
+      | Naked_float -> K.naked_float
+      | Naked_int32 -> K.naked_int32
+      | Naked_int64 -> K.naked_int64
+      | Naked_nativeint -> K.naked_nativeint
+    end
 
 let of_descr (descr : Descr.t) =
   match descr with
@@ -36,3 +45,9 @@ let of_descr (descr : Descr.t) =
   | Naked_int32 i -> naked_int32 i
   | Naked_int64 i -> naked_int64 i
   | Naked_nativeint i -> naked_nativeint i
+  | Poison Naked_immediate -> naked_immediate_poison
+  | Poison Value -> value_poison
+  | Poison Naked_float -> naked_float_poison
+  | Poison Naked_int32 -> naked_int32_poison
+  | Poison Naked_int64 -> naked_int64_poison
+  | Poison Naked_nativeint -> naked_nativeint_poison
diff --git a/middle_end/flambda/compilenv_deps/reg_width_things.ml b/middle_end/flambda/compilenv_deps/reg_width_things.ml
index fd9787f60c8e..df7ed7a99e72 100644
--- a/middle_end/flambda/compilenv_deps/reg_width_things.ml
+++ b/middle_end/flambda/compilenv_deps/reg_width_things.ml
@@ -26,6 +26,48 @@ let const_flags = 2
 let simple_flags = 3
 
 module Const_data = struct
+  module Kind = struct
+    type t =
+      | Value
+      | Naked_immediate
+      | Naked_float
+      | Naked_int32
+      | Naked_int64
+      | Naked_nativeint
+
+    let compare t1 t2 =
+      match t1, t2 with
+      | Value, Value -> 0
+      | Value, _ -> 1
+      | _, Value -> -1
+      | Naked_immediate, Naked_immediate -> 0
+      | Naked_immediate, _ -> 1
+      | _, Naked_immediate -> -1
+      | Naked_float, Naked_float -> 0
+      | Naked_float, _ -> 1
+      | _, Naked_float -> -1
+      | Naked_int32, Naked_int32 -> 0
+      | Naked_int32, _ -> 1
+      | _, Naked_int32 -> -1
+      | Naked_int64, Naked_int64 -> 0
+      | Naked_int64, _ -> 1
+      | _, Naked_int64 -> -1
+      | Naked_nativeint, Naked_nativeint -> 0
+
+    let equal k1 k2 =
+      match k1, k2 with
+      | Value, Value
+      | Naked_immediate, Naked_immediate
+      | Naked_float, Naked_float
+      | Naked_int32, Naked_int32
+      | Naked_int64, Naked_int64
+      | Naked_nativeint, Naked_nativeint ->
+        true
+      | ( Value | Naked_immediate | Naked_float
+        | Naked_int32 | Naked_int64 | Naked_nativeint ), _ ->
+        false
+  end
+
   type t =
     | Naked_immediate of Target_imm.t
     | Tagged_immediate of Target_imm.t
@@ -33,6 +75,7 @@ module Const_data = struct
     | Naked_int32 of Int32.t
     | Naked_int64 of Int64.t
     | Naked_nativeint of Targetint.t
+    | Poison of Kind.t
 
   let flags = const_flags
 
@@ -71,6 +114,24 @@ module Const_data = struct
           (Flambda_colours.naked_number ())
           Targetint.print n
           (Flambda_colours.normal ())
+      | Poison kind ->
+        let colour =
+          match kind with
+          | Value -> Flambda_colours.tagged_immediate
+          | Naked_immediate | Naked_float | Naked_int32
+          | Naked_int64 | Naked_nativeint ->
+            Flambda_colours.naked_number
+        in
+        let poison =
+          if !Clflags.flambda_unicode then
+            "\u{2620}"
+          else
+            "Poison"
+        in
+        Format.fprintf ppf "@<0>%s%s@<0>%s"
+          (colour ())
+          poison
+          (Flambda_colours.normal ())
 
     let output _ _ = Misc.fatal_error "[output] not yet implemented"
 
@@ -88,6 +149,8 @@ module Const_data = struct
         Int64.compare n1 n2
       | Naked_nativeint n1, Naked_nativeint n2 ->
         Targetint.compare n1 n2
+      | Poison k1, Poison k2 ->
+        Kind.compare k1 k2
       | Naked_immediate _, _ -> -1
       | _, Naked_immediate _ -> 1
       | Tagged_immediate _, _ -> -1
@@ -98,6 +161,8 @@ module Const_data = struct
       | _, Naked_int32 _ -> 1
       | Naked_int64 _, _ -> -1
       | _, Naked_int64 _ -> 1
+      | Naked_nativeint _, _ -> -1
+      | _, Naked_nativeint _ -> 1
 
     let equal t1 t2 =
       if t1 == t2 then true
@@ -115,8 +180,11 @@ module Const_data = struct
           Int64.equal n1 n2
         | Naked_nativeint n1, Naked_nativeint n2 ->
           Targetint.equal n1 n2
+        | Poison k1, Poison k2 ->
+          Kind.equal k1 k2
         | (Naked_immediate _ | Tagged_immediate _ | Naked_float _
-            | Naked_int32 _ | Naked_int64 _ | Naked_nativeint _), _ -> false
+            | Naked_int32 _ | Naked_int64 _ | Naked_nativeint _
+            | Poison _ ), _ -> false
 
     let hash t =
       match t with
@@ -126,6 +194,7 @@ module Const_data = struct
       | Naked_int32 n -> Hashtbl.hash n
       | Naked_int64 n -> Hashtbl.hash n
       | Naked_nativeint n -> Targetint.hash n
+      | Poison k -> Hashtbl.hash k
   end)
 end
 
@@ -288,6 +357,13 @@ module Const = struct
   let const_one = tagged_immediate Target_imm.one
   let const_unit = const_zero
 
+  let naked_immediate_poison = create (Poison Naked_immediate)
+  let value_poison = create (Poison Value)
+  let naked_float_poison = create (Poison Naked_float)
+  let naked_int32_poison = create (Poison Naked_int32)
+  let naked_int64_poison = create (Poison Naked_int64)
+  let naked_nativeint_poison = create (Poison Naked_nativeint)
+
   let descr t = find_data t
 
   module T0 = struct
diff --git a/middle_end/flambda/compilenv_deps/reg_width_things.mli b/middle_end/flambda/compilenv_deps/reg_width_things.mli
index b69a89f1b475..d44899f5b85c 100644
--- a/middle_end/flambda/compilenv_deps/reg_width_things.mli
+++ b/middle_end/flambda/compilenv_deps/reg_width_things.mli
@@ -52,14 +52,32 @@ module Const : sig
   val naked_int64 : Int64.t -> t
   val naked_nativeint : Targetint.t -> t
 
+  val naked_immediate_poison : t
+  val value_poison : t
+  val naked_float_poison : t
+  val naked_int32_poison : t
+  val naked_int64_poison : t
+  val naked_nativeint_poison : t
+
   module Descr : sig
-    type t = private
-      | Naked_immediate of Target_imm.t
-      | Tagged_immediate of Target_imm.t
-      | Naked_float of Numbers.Float_by_bit_pattern.t
-      | Naked_int32 of Int32.t
-      | Naked_int64 of Int64.t
-      | Naked_nativeint of Targetint.t
+    module Kind : sig
+      type t = private
+        | Value
+        | Naked_immediate
+        | Naked_float
+        | Naked_int32
+        | Naked_int64
+        | Naked_nativeint
+    end
+
+  type t = private
+    | Naked_immediate of Target_imm.t
+    | Tagged_immediate of Target_imm.t
+    | Naked_float of Numbers.Float_by_bit_pattern.t
+    | Naked_int32 of Int32.t
+    | Naked_int64 of Int64.t
+    | Naked_nativeint of Targetint.t
+    | Poison of Kind.t
 
     include Identifiable.S with type t := t
   end
diff --git a/middle_end/flambda/parser/flambda_to_fexpr.ml b/middle_end/flambda/parser/flambda_to_fexpr.ml
index d944c37ef254..66bced2c5aa1 100644
--- a/middle_end/flambda/parser/flambda_to_fexpr.ml
+++ b/middle_end/flambda/parser/flambda_to_fexpr.ml
@@ -272,6 +272,13 @@ let const c : Fexpr.const =
     Naked_int64 i
   | Naked_nativeint i ->
     Naked_nativeint (i |> Targetint.to_int64)
+  | Poison Naked_immediate
+  | Poison Value
+  | Poison Naked_float
+  | Poison Naked_int32
+  | Poison Naked_int64
+  | Poison Naked_nativeint ->
+    Misc.fatal_errorf "TODO: Poison constants"
 
 let simple env s =
   Simple.pattern_match s
diff --git a/middle_end/flambda/simplify/simplify_named.ml b/middle_end/flambda/simplify/simplify_named.ml
index a22a01980a72..83cea75f1573 100644
--- a/middle_end/flambda/simplify/simplify_named.ml
+++ b/middle_end/flambda/simplify/simplify_named.ml
@@ -71,6 +71,7 @@ let record_any_symbol_projection dacc (defining_expr : Simplified_named.t)
         Simple.pattern_match index
           ~const:(fun const ->
             match Reg_width_const.descr const with
+            | Poison Value -> None
             | Tagged_immediate imm ->
               Simple.pattern_match' block
                 ~const:(fun _ -> None)
@@ -80,7 +81,9 @@ let record_any_symbol_projection dacc (defining_expr : Simplified_named.t)
                     (SP.Projection.block_load ~index)))
                 ~var:(fun _ -> None)
             | Naked_immediate _ | Naked_float _
-            | Naked_int32 _ | Naked_int64 _ | Naked_nativeint _ ->
+            | Naked_int32 _ | Naked_int64 _ | Naked_nativeint _
+            | Poison ( Naked_immediate | Naked_float | Naked_int32
+              | Naked_int64 | Naked_nativeint )->
               Misc.fatal_errorf "Kind error for [Block_load] index:@ \
                   %a@ =@ %a"
                 Bindable_let_bound.print bindable_let_bound
diff --git a/middle_end/flambda/simplify/simplify_static_const.ml b/middle_end/flambda/simplify/simplify_static_const.ml
index 74fef9a6569c..6f1513764b37 100644
--- a/middle_end/flambda/simplify/simplify_static_const.ml
+++ b/middle_end/flambda/simplify/simplify_static_const.ml
@@ -42,8 +42,13 @@ let simplify_field_of_block dacc (field : Field_of_block.t) =
         ~const:(fun const ->
           match Reg_width_const.descr const with
           | Tagged_immediate imm -> Field_of_block.Tagged_immediate imm, ty
+          | Poison Value ->
+            (* CR pchambart: This should be "invalid" and propagate up *)
+            field, T.bottom K.value
           | Naked_immediate _ | Naked_float _ | Naked_int32 _
-              | Naked_int64 _ | Naked_nativeint _ ->
+              | Naked_int64 _ | Naked_nativeint _
+              | Poison ( Naked_immediate | Naked_float | Naked_int32
+                | Naked_int64 | Naked_nativeint ) ->
             (* CR mshinwell: This should be "invalid" and propagate up *)
             field, ty)
 
diff --git a/middle_end/flambda/simplify/simplify_switch_expr.ml b/middle_end/flambda/simplify/simplify_switch_expr.ml
index cd8d0ee5b3f7..9bb7e4f96ed3 100644
--- a/middle_end/flambda/simplify/simplify_switch_expr.ml
+++ b/middle_end/flambda/simplify/simplify_switch_expr.ml
@@ -99,6 +99,7 @@ let rebuild_switch ~simplify_let dacc ~arms ~scrutinee ~scrutinee_ty uacc
                     normal_case ~identity_arms ~not_arms
                   else
                     normal_case ~identity_arms ~not_arms
+                | Poison _
                 | Naked_immediate _ | Naked_float _ | Naked_int32 _
                 | Naked_int64 _ | Naked_nativeint _ ->
                   normal_case ~identity_arms ~not_arms
diff --git a/middle_end/flambda/to_cmm/un_cps.ml b/middle_end/flambda/to_cmm/un_cps.ml
index 0dad1e2de481..117fd4d68a02 100644
--- a/middle_end/flambda/to_cmm/un_cps.ml
+++ b/middle_end/flambda/to_cmm/un_cps.ml
@@ -77,13 +77,22 @@ let const _env cst =
   match Reg_width_const.descr cst with
   | Naked_immediate i ->
     C.targetint (targetint_of_imm i)
+  | Poison Naked_immediate ->
+    C.targetint (targetint_of_imm Target_imm.zero)
   | Tagged_immediate i ->
     C.targetint (tag_targetint (targetint_of_imm i))
+  | Poison Value ->
+    C.targetint (tag_targetint (targetint_of_imm Target_imm.zero))
   | Naked_float f ->
     C.float (Numbers.Float_by_bit_pattern.to_float f)
+  | Poison Naked_float ->
+    C.float 0.
   | Naked_int32 i -> C.int32 i
+  | Poison Naked_int32 -> C.int32 0l
   | Naked_int64 i -> C.int64 i
+  | Poison Naked_int64 -> C.int64 0L
   | Naked_nativeint t -> C.targetint t
+  | Poison Naked_nativeint -> C.targetint Targetint.zero
 
 let default_of_kind (k : Flambda_kind.t) =
   match k with
diff --git a/middle_end/flambda/to_cmm/un_cps_static.ml b/middle_end/flambda/to_cmm/un_cps_static.ml
index 3a1d7f4f24b7..531b70e4de32 100644
--- a/middle_end/flambda/to_cmm/un_cps_static.ml
+++ b/middle_end/flambda/to_cmm/un_cps_static.ml
@@ -57,17 +57,31 @@ let const_static _env cst =
   match Reg_width_const.descr cst with
   | Naked_immediate i ->
       [C.cint (nativeint_of_targetint (targetint_of_imm i))]
+  | Poison Naked_immediate ->
+      (* CR pchambart: Should we use something more noticeable than 0 ? *)
+      [C.cint 0n]
   | Tagged_immediate i ->
       [C.cint (nativeint_of_targetint (tag_targetint (targetint_of_imm i)))]
+  | Poison Value ->
+      [C.cint 1n]
   | Naked_float f ->
       [C.cfloat (Numbers.Float_by_bit_pattern.to_float f)]
+  | Poison Naked_float ->
+      [C.cfloat 0.]
   | Naked_int32 i ->
       [C.cint (Nativeint.of_int32 i)]
+  | Poison Naked_int32 ->
+      [C.cint 0n]
   | Naked_int64 i ->
       if C.arch32 then todo() (* split int64 on 32-bit archs *)
       else [C.cint (Int64.to_nativeint i)]
+  | Poison Naked_int64 ->
+      if C.arch32 then todo() (* split int64 on 32-bit archs *)
+      else [C.cint 0n]
   | Naked_nativeint t ->
       [C.cint (nativeint_of_targetint t)]
+  | Poison Naked_nativeint ->
+      [C.cint 0n]
 
 let simple_static env s =
   Simple.pattern_match s
diff --git a/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.ml b/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.ml
new file mode 100644
index 000000000000..e64622401efd
--- /dev/null
+++ b/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.ml
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2018 OCamlPro SAS                                          *)
+(*   Copyright 2018 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+type 'a t =
+  | Unknown
+  | Ok of 'a
+  | Poison
+  | Bottom
+
+let print f ppf t =
+  match t with
+  | Unknown -> Format.pp_print_string ppf "Unknown"
+  | Ok contents -> Format.fprintf ppf "@[(Ok %a)@]" f contents
+  | Poison -> Format.pp_print_string ppf "Poison"
+  | Bottom -> Format.pp_print_string ppf "Bottom"
+
+let equal eq_contents t1 t2 =
+  match t1, t2 with
+  | Unknown, Unknown -> true
+  | Ok contents1, Ok contents2 -> eq_contents contents1 contents2
+  | Bottom, Bottom -> true
+  | Poison, Poison -> true
+  | (Unknown | Ok _ | Poison | Bottom), _ -> false
+
+let map t ~f =
+  match t with
+  | Unknown -> Unknown
+  | Bottom -> Bottom
+  | Poison -> Poison
+  | Ok contents -> Ok (f contents)
+
+let map_sharing t ~f =
+  match t with
+  | Unknown | Bottom | Poison -> t
+  | Ok contents ->
+    let contents' = f contents in
+    if contents == contents' then t
+    else Ok contents'
+
+let of_or_unknown (unk : _ Or_unknown.t) : _ t =
+  match unk with
+  | Known contents -> Ok contents
+  | Unknown -> Unknown
+
+let of_or_unknown_or_bottom (unk : _ Or_unknown_or_bottom.t) : _ t =
+  match unk with
+  | Ok contents -> Ok contents
+  | Unknown -> Unknown
+  | Bottom -> Bottom
diff --git a/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.mli b/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.mli
new file mode 100644
index 000000000000..f1239f14cec8
--- /dev/null
+++ b/middle_end/flambda/types/basic/or_unknown_or_bottom_or_poison.mli
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2018 OCamlPro SAS                                          *)
+(*   Copyright 2018 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+[@@@ocaml.warning "+a-4-30-40-41-42"]
+
+type 'a t =
+  | Unknown
+  | Ok of 'a
+  | Poison
+  | Bottom
+
+val print
+   : (Format.formatter -> 'a -> unit)
+  -> Format.formatter
+  -> 'a t
+  -> unit
+
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+
+val map : 'a t -> f:('a -> 'b) -> 'b t
+
+val map_sharing : 'a t -> f:('a -> 'a) -> 'a t
+
+val of_or_unknown : 'a Or_unknown.t -> 'a t
+
+val of_or_unknown_or_bottom : 'a Or_unknown_or_bottom.t -> 'a t
diff --git a/middle_end/flambda/types/flambda_type.mli b/middle_end/flambda/types/flambda_type.mli
index f80706c0646a..6b7ad6ec69e9 100644
--- a/middle_end/flambda/types/flambda_type.mli
+++ b/middle_end/flambda/types/flambda_type.mli
@@ -291,6 +291,12 @@ val bottom : Flambda_kind.t -> t
 (** Construct a top ("unknown") type of the given kind. *)
 val unknown : Flambda_kind.t -> t
 
+(** Construct a poison type of the given kind.
+    Poison behaves like bottom, but presence of a type poison
+    in an environment doesn't make the environment bottom.
+    expand_head on poison is bottom. *)
+val poison : Flambda_kind.t -> t
+
 val unknown_with_subkind : Flambda_kind.With_subkind.t -> t
 
 (** Create an bottom type with the same kind as the given type. *)
diff --git a/middle_end/flambda/types/template/flambda_type.templ.ml b/middle_end/flambda/types/template/flambda_type.templ.ml
index 2f246c137779..b508e5ec3ac8 100644
--- a/middle_end/flambda/types/template/flambda_type.templ.ml
+++ b/middle_end/flambda/types/template/flambda_type.templ.ml
@@ -214,8 +214,11 @@ let prove_naked_floats env t : _ proof =
   in
   match expand_head t env with
   | Const (Naked_float f) -> Proved (Float.Set.singleton f)
+  | Const (Poison Naked_float) -> Invalid
   | Const (Naked_immediate _ | Tagged_immediate _ | Naked_int32 _
-    | Naked_int64 _ | Naked_nativeint _) -> wrong_kind ()
+    | Naked_int64 _ | Naked_nativeint _
+    | Poison (Value | Naked_immediate | Naked_int32
+      | Naked_int64 | Naked_nativeint)) -> wrong_kind ()
   | Naked_float (Ok fs) ->
     if Float.Set.is_empty fs then Invalid
     else Proved fs
@@ -233,8 +236,11 @@ let prove_naked_int32s env t : _ proof =
   in
   match expand_head t env with
   | Const (Naked_int32 i) -> Proved (Int32.Set.singleton i)
+  | Const (Poison Naked_int32) -> Invalid
   | Const (Naked_immediate _ | Tagged_immediate _ | Naked_float _
-    | Naked_int64 _ | Naked_nativeint _) -> wrong_kind ()
+    | Naked_int64 _ | Naked_nativeint _
+    | Poison (Value | Naked_immediate | Naked_float
+      | Naked_int64 | Naked_nativeint)) -> wrong_kind ()
   | Naked_int32 (Ok is) ->
     if Int32.Set.is_empty is then Invalid
     else Proved is
@@ -252,8 +258,11 @@ let prove_naked_int64s env t : _ proof =
   in
   match expand_head t env with
   | Const (Naked_int64 i) -> Proved (Int64.Set.singleton i)
+  | Const (Poison Naked_int64) -> Invalid
   | Const (Naked_immediate _ | Tagged_immediate _ | Naked_float _
-    | Naked_int32 _ | Naked_nativeint _) -> wrong_kind ()
+    | Naked_int32 _ | Naked_nativeint _
+    | Poison (Value | Naked_immediate | Naked_float
+      | Naked_int32 | Naked_nativeint)) -> wrong_kind ()
   | Naked_int64 (Ok is) ->
     if Int64.Set.is_empty is then Invalid
     else Proved is
@@ -271,8 +280,11 @@ let prove_naked_nativeints env t : _ proof =
   in
   match expand_head t env with
   | Const (Naked_nativeint i) -> Proved (Targetint.Set.singleton i)
+  | Const (Poison Naked_nativeint) -> Invalid
   | Const (Naked_immediate _ | Tagged_immediate _ | Naked_float _
-    | Naked_int32 _ | Naked_int64 _) -> wrong_kind ()
+    | Naked_int32 _ | Naked_int64 _
+    | Poison (Value | Naked_immediate | Naked_float
+      | Naked_int32 | Naked_int64)) -> wrong_kind ()
   | Naked_nativeint (Ok is) ->
     if Targetint.Set.is_empty is then Invalid
     else Proved is
@@ -290,6 +302,7 @@ let prove_is_int env t : bool proof =
   in
   match expand_head t env with
   | Const (Tagged_immediate _) -> Proved true
+  | Const (Poison Value) -> Invalid
   | Const _ -> wrong_kind ()
   | Value (Ok (Variant blocks_imms)) ->
     begin match blocks_imms.blocks, blocks_imms.immediates with
@@ -320,6 +333,7 @@ let prove_tags_must_be_a_block env t : Tag.Set.t proof =
   in
   match expand_head t env with
   | Const (Tagged_immediate _) -> Unknown
+  | Const (Poison Value) -> Invalid
   | Const _ -> wrong_kind ()
   | Value (Ok (Variant blocks_imms)) ->
     begin match blocks_imms.immediates with
@@ -374,8 +388,11 @@ let prove_naked_immediates env t : Target_imm.Set.t proof =
   in
   match expand_head t env with
   | Const (Naked_immediate i) -> Proved (Target_imm.Set.singleton i)
+  | Const (Poison Naked_immediate) -> Invalid
   | Const (Tagged_immediate _ | Naked_float _ | Naked_int32 _
-    | Naked_int64 _ | Naked_nativeint _) -> wrong_kind ()
+    | Naked_int64 _ | Naked_nativeint _
+    | Poison (Value | Naked_float | Naked_int32
+      | Naked_int64 | Naked_nativeint)) -> wrong_kind ()
   | Naked_immediate (Ok (Naked_immediates is)) ->
     (* CR mshinwell: As noted elsewhere, add abstraction to avoid the need
        for these checks *)
@@ -418,8 +435,11 @@ let prove_equals_tagged_immediates env t : Target_imm.Set.t proof =
   in
   match expand_head t env with
   | Const (Tagged_immediate imm) -> Proved (Target_imm.Set.singleton imm)
-  | Const (Naked_immediate _ | Naked_float _ | Naked_int32 _ | Naked_int64 _
-    | Naked_nativeint _) -> wrong_kind ()
+  | Const (Poison Value) -> Invalid
+  | Const (Naked_immediate _ | Naked_float _ | Naked_int32 _
+    | Naked_int64 _ | Naked_nativeint _
+    | Poison (Naked_immediate | Naked_float | Naked_int32
+      | Naked_int64 | Naked_nativeint)) -> wrong_kind ()
   | Value (Ok (Variant blocks_imms)) ->
     begin match blocks_imms.blocks, blocks_imms.immediates with
     | Unknown, Unknown | Unknown, Known _ | Known _, Unknown -> Unknown
@@ -563,6 +583,7 @@ let prove_variant env t : variant_proof proof_allowing_kind_mismatch =
 let prove_is_a_tagged_immediate env t : _ proof_allowing_kind_mismatch =
   match expand_head t env with
   | Const (Tagged_immediate _) -> Proved ()
+  | Const (Poison Value) -> Invalid
   | Const _ -> Wrong_kind
   | Value Unknown -> Unknown
   | Value (Ok (Variant { blocks; immediates; is_unique = _; })) ->
@@ -578,6 +599,7 @@ let prove_is_a_tagged_immediate env t : _ proof_allowing_kind_mismatch =
 
 let prove_is_a_boxed_float env t : _ proof_allowing_kind_mismatch =
   match expand_head t env with
+  | Const (Poison Value) -> Invalid
   | Const _ -> Wrong_kind
   | Value Unknown -> Unknown
   | Value (Ok (Boxed_float _)) -> Proved ()
@@ -586,6 +608,7 @@ let prove_is_a_boxed_float env t : _ proof_allowing_kind_mismatch =
 
 let prove_is_a_boxed_int32 env t : _ proof_allowing_kind_mismatch =
   match expand_head t env with
+  | Const (Poison Value) -> Invalid
   | Const _ -> Wrong_kind
   | Value Unknown -> Unknown
   | Value (Ok (Boxed_int32 _)) -> Proved ()
@@ -594,6 +617,7 @@ let prove_is_a_boxed_int32 env t : _ proof_allowing_kind_mismatch =
 
 let prove_is_a_boxed_int64 env t : _ proof_allowing_kind_mismatch =
   match expand_head t env with
+  | Const (Poison Value) -> Invalid
   | Const _ -> Wrong_kind
   | Value Unknown -> Unknown
   | Value (Ok (Boxed_int64 _)) -> Proved ()
@@ -602,6 +626,7 @@ let prove_is_a_boxed_int64 env t : _ proof_allowing_kind_mismatch =
 
 let prove_is_a_boxed_nativeint env t : _ proof_allowing_kind_mismatch =
   match expand_head t env with
+  | Const (Poison Value) -> Invalid
   | Const _ -> Wrong_kind
   | Value Unknown -> Unknown
   | Value (Ok (Boxed_nativeint _)) -> Proved ()
diff --git a/middle_end/flambda/types/type_descr.rec.ml b/middle_end/flambda/types/type_descr.rec.ml
index cbd9bdd0d068..3b206e4527ba 100644
--- a/middle_end/flambda/types/type_descr.rec.ml
+++ b/middle_end/flambda/types/type_descr.rec.ml
@@ -30,7 +30,7 @@ module Make (Head : Type_head_intf.S
 = struct
   module Descr = struct
     type t =
-      | No_alias of Head.t Or_unknown_or_bottom.t
+      | No_alias of Head.t Or_unknown_or_bottom_or_poison.t
       | Equals of Simple.t
 
     let print_with_cache ~cache ppf t =
@@ -48,6 +48,12 @@ module Make (Head : Type_head_intf.S
             colour (Flambda_colours.normal ())
         else
           Format.fprintf ppf "@<0>%s_|_@<0>%s" colour (Flambda_colours.normal ())
+      | No_alias Poison ->
+        if !Clflags.flambda_unicode then
+          Format.fprintf ppf "@<0>%s@<1>\u{2620}@<0>%s"
+            colour (Flambda_colours.normal ())
+        else
+          Format.fprintf ppf "@<0>%sP@<0>%s" colour (Flambda_colours.normal ())
       | No_alias (Ok head) -> Head.print_with_cache ~cache ppf head
       | Equals simple ->
         Format.fprintf ppf "@[(@<0>%s=@<0>%s %a)@]"
@@ -62,7 +68,9 @@ module Make (Head : Type_head_intf.S
       if Renaming.is_empty renaming then t
       else
         match t with
-        | No_alias Bottom | No_alias Unknown -> t
+        | No_alias Bottom
+        | No_alias Unknown
+        | No_alias Poison -> t
         | No_alias (Ok head) ->
           let head' = Head.apply_renaming head renaming in
           if head == head' then t
@@ -74,7 +82,9 @@ module Make (Head : Type_head_intf.S
 
     let free_names t =
       match t with
-      | No_alias Bottom | No_alias Unknown -> Name_occurrences.empty
+      | No_alias Bottom
+      | No_alias Unknown
+      | No_alias Poison -> Name_occurrences.empty
       | No_alias (Ok head) -> Head.free_names head
       | Equals simple ->
         Name_occurrences.downgrade_occurrences_at_strictly_greater_kind
@@ -88,7 +98,9 @@ module Make (Head : Type_head_intf.S
 
   let all_ids_for_export t =
     match descr t with
-    | No_alias Bottom | No_alias Unknown -> Ids_for_export.empty
+    | No_alias Bottom
+    | No_alias Unknown
+    | No_alias Poison -> Ids_for_export.empty
     | No_alias (Ok head) -> Head.all_ids_for_export head
     | Equals simple -> Ids_for_export.from_simple simple
 
@@ -98,12 +110,16 @@ module Make (Head : Type_head_intf.S
   let print ppf t =
     print_with_cache ~cache:(Printing_cache.create ()) ppf t
 
-  let create_no_alias head = create (No_alias head)
+  let create_no_alias head =
+    let head = Or_unknown_or_bottom_or_poison.of_or_unknown_or_bottom head in
+    create (No_alias head)
   let create_equals simple = create (Equals simple)
 
+  let poison = lazy (create (No_alias Poison))
   let bottom = lazy (create (No_alias Bottom))
   let unknown = lazy (create (No_alias Unknown))
 
+  let poison () = Lazy.force poison
   let bottom () = Lazy.force bottom
   let unknown () = Lazy.force unknown
 
@@ -112,13 +128,13 @@ module Make (Head : Type_head_intf.S
   let is_obviously_bottom t =
     match peek_descr t with
     | No_alias Bottom -> true
-    | No_alias (Ok _ | Unknown)
+    | No_alias (Ok _ | Unknown | Poison)
     | Equals _ -> false
 
   let is_obviously_unknown t =
     match peek_descr t with
     | No_alias Unknown -> true
-    | No_alias (Ok _ | Bottom)
+    | No_alias (Ok _ | Bottom | Poison)
     | Equals _ -> false
 
   let get_alias_exn t =
@@ -137,20 +153,32 @@ module Make (Head : Type_head_intf.S
       | None -> Bottom
       | Some simple -> Ok (create_equals simple)
       end
-    | No_alias Unknown -> Ok t
+    | No_alias (Unknown | Poison) -> Ok t
     | No_alias Bottom -> Bottom
     | No_alias (Ok head) ->
       Or_bottom.map (Head.apply_rec_info head rec_info)
         ~f:(fun head -> create head)
 
-  let force_to_head ~force_to_kind t =
+  let force_to_head ~force_to_kind t : _ Or_unknown_or_bottom.t =
     match descr (force_to_kind t) with
-    | No_alias head -> head
+    | No_alias head -> begin
+        match head with
+        | Ok t -> Ok t
+        | Unknown -> Unknown
+        | Bottom -> Bottom
+        | Poison -> Bottom
+      end
     | Equals _ -> Misc.fatal_errorf "Expected [No_alias]:@ %a" T.print t
 
   let expand_head ~force_to_kind t env kind : _ Or_unknown_or_bottom.t =
     match descr t with
-    | No_alias head -> head
+    | No_alias head -> begin
+        match head with
+        | Ok t -> Ok t
+        | Unknown -> Unknown
+        | Bottom -> Bottom
+        | Poison -> Bottom
+      end
     | Equals simple ->
       let min_name_mode = Name_mode.min_in_types in
       match TE.get_canonical_simple_exn env simple ~min_name_mode with
@@ -160,7 +188,7 @@ module Make (Head : Type_head_intf.S
            so [Unknown] is fine here. *)
         Unknown
       | simple ->
-        let [@inline always] const const =
+        let [@inline always] const const : _ Or_unknown_or_bottom.t =
           let typ =
             match Reg_width_const.descr const with
             | Naked_immediate i -> T.this_naked_immediate_without_alias i
@@ -169,12 +197,19 @@ module Make (Head : Type_head_intf.S
             | Naked_int32 i -> T.this_naked_int32_without_alias i
             | Naked_int64 i -> T.this_naked_int64_without_alias i
             | Naked_nativeint i -> T.this_naked_nativeint_without_alias i
+            | Poison Naked_immediate -> T.poison_naked_immediate ()
+            | Poison Value -> T.poison_value ()
+            | Poison Naked_float -> T.poison_naked_float ()
+            | Poison Naked_int32 -> T.poison_naked_int32 ()
+            | Poison Naked_int64 -> T.poison_naked_int64 ()
+            | Poison Naked_nativeint -> T.poison_naked_nativeint ()
           in
           force_to_head ~force_to_kind typ
         in
         let [@inline always] name name : _ Or_unknown_or_bottom.t =
           let t = force_to_kind (TE.find env name (Some kind)) in
           match descr t with
+          | No_alias Poison -> Bottom
           | No_alias Bottom -> Bottom
           | No_alias Unknown -> Unknown
           | No_alias (Ok head) -> Ok head
@@ -209,7 +244,7 @@ module Make (Head : Type_head_intf.S
 
   let eviscerate ~force_to_kind t env kind =
     match descr t with
-    | No_alias (Bottom | Unknown) -> t
+    | No_alias (Bottom | Unknown | Poison) -> t
     | No_alias (Ok head) ->
       begin match Head.eviscerate head with
       | Known head -> create_no_alias (Ok head)
@@ -220,7 +255,7 @@ module Make (Head : Type_head_intf.S
       else
         let t = expand_head' ~force_to_kind t env kind in
         match descr t with
-        | No_alias (Bottom | Unknown) -> t
+        | No_alias (Bottom | Unknown | Poison) -> t
         | No_alias (Ok head) ->
           begin match Head.eviscerate head with
           | Known head -> create_no_alias (Ok head)
diff --git a/middle_end/flambda/types/type_descr_intf.ml b/middle_end/flambda/types/type_descr_intf.ml
index aae949412eb6..21c25c7bdf30 100644
--- a/middle_end/flambda/types/type_descr_intf.ml
+++ b/middle_end/flambda/types/type_descr_intf.ml
@@ -27,7 +27,7 @@ module type S = sig
 
   module Descr : sig
     type t = private
-      | No_alias of head Or_unknown_or_bottom.t
+      | No_alias of head Or_unknown_or_bottom_or_poison.t
         (** For each kind there is a lattice of types.
             Unknown = "Any value can flow to this point": the top element.
             Bottom = "No value can flow to this point": the least element.
@@ -48,6 +48,7 @@ module type S = sig
 
   val unknown : unit -> t
   val bottom : unit -> t
+  val poison : unit -> t
 
   val descr : t -> Descr.t
 
diff --git a/middle_end/flambda/types/type_grammar.rec.ml b/middle_end/flambda/types/type_grammar.rec.ml
index bf778f62bc87..37ffe9dafbd5 100644
--- a/middle_end/flambda/types/type_grammar.rec.ml
+++ b/middle_end/flambda/types/type_grammar.rec.ml
@@ -320,6 +320,23 @@ let unknown (kind : K.t) =
 
 let unknown_like t = unknown (kind t)
 
+let poison_value () = Value (T_V.poison ())
+let poison_naked_immediate () = Naked_immediate (T_NI.poison ())
+let poison_naked_float () = Naked_float (T_Nf.poison ())
+let poison_naked_int32 () = Naked_int32 (T_N32.poison ())
+let poison_naked_int64 () = Naked_int64 (T_N64.poison ())
+let poison_naked_nativeint () = Naked_nativeint (T_NN.poison ())
+
+let poison (kind : K.t) =
+  match kind with
+  | Value -> poison_value ()
+  | Naked_number Naked_immediate -> poison_naked_immediate ()
+  | Naked_number Naked_float -> poison_naked_float ()
+  | Naked_number Naked_int32 -> poison_naked_int32 ()
+  | Naked_number Naked_int64 -> poison_naked_int64 ()
+  | Naked_number Naked_nativeint -> poison_naked_nativeint ()
+  | Fabricated -> Misc.fatal_error "Only used in [Flambda_static] now"
+
 let this_naked_immediate i : t =
   Naked_immediate (T_NI.create_equals (Simple.const (
     Reg_width_const.naked_immediate i)))
@@ -710,6 +727,12 @@ let type_for_const const =
   | Naked_int32 n -> this_naked_int32 n
   | Naked_int64 n -> this_naked_int64 n
   | Naked_nativeint n -> this_naked_nativeint n
+  | Poison Naked_immediate -> poison_naked_immediate ()
+  | Poison Value -> poison_value ()
+  | Poison Naked_float -> poison_naked_float ()
+  | Poison Naked_int32 -> poison_naked_int32 ()
+  | Poison Naked_int64 -> poison_naked_int64 ()
+  | Poison Naked_nativeint -> poison_naked_nativeint ()
 
 let kind_for_const const = kind (type_for_const const)
 
diff --git a/middle_end/flambda/types/type_grammar.rec.mli b/middle_end/flambda/types/type_grammar.rec.mli
index bfe9db7c2e29..f271356a6748 100644
--- a/middle_end/flambda/types/type_grammar.rec.mli
+++ b/middle_end/flambda/types/type_grammar.rec.mli
@@ -54,6 +54,8 @@ val bottom_like : t -> t
 val unknown : Flambda_kind.t -> t
 val unknown_like : t -> t
 
+val poison : Flambda_kind.t -> t
+
 val any_value : unit -> t
 
 val any_tagged_immediate : unit -> t
@@ -70,6 +72,13 @@ val any_naked_int32 : unit -> t
 val any_naked_int64 : unit -> t
 val any_naked_nativeint : unit -> t
 
+val poison_value : unit -> t
+val poison_naked_immediate : unit -> t
+val poison_naked_float : unit -> t
+val poison_naked_int32 : unit -> t
+val poison_naked_int64 : unit -> t
+val poison_naked_nativeint : unit -> t
+
 val this_tagged_immediate : Target_imm.t -> t
 val this_boxed_float : Numbers.Float_by_bit_pattern.t -> t
 val this_boxed_int32 : Int32.t -> t
diff --git a/middle_end/flambda/unboxing/unbox_continuation_params.ml b/middle_end/flambda/unboxing/unbox_continuation_params.ml
index 56cc2981f3c7..a39c278474df 100644
--- a/middle_end/flambda/unboxing/unbox_continuation_params.ml
+++ b/middle_end/flambda/unboxing/unbox_continuation_params.ml
@@ -598,7 +598,7 @@ struct
     | Is_int
     | Tag ->
       (* These arguments are filled in later via [project_field]. *)
-      Some Simple.untagged_const_zero
+      Some (Simple.const Reg_width_const.naked_immediate_poison)
     | Const_ctor ->
       begin match use_info with
       | Const_ctor ->
@@ -609,7 +609,7 @@ struct
       | Block _ ->
         (* There are no constant constructors in the variant at the use site.
            We provide a dummy value. *)
-        Some Simple.untagged_const_zero
+        Some (Simple.const Reg_width_const.value_poison)
       end
     | Field { index; } ->
       begin match use_info with
@@ -622,12 +622,12 @@ struct
           (* If the argument at the use is known to be a block, but it has
              fewer fields than the maximum number of fields for the variant,
              then we provide a dummy value. *)
-          Some Simple.const_zero
+          Some (Simple.const Reg_width_const.value_poison)
         end
       | Const_ctor ->
         (* There are no blocks in the variant at the use site.  We again
            provide a dummy value. *)
-        Some Simple.const_zero
+        Some (Simple.const Reg_width_const.value_poison)
       end
 
   let make_boxed_value variant ~param_being_unboxed ~new_params ~fields =
@@ -735,10 +735,10 @@ struct
       end
     | Field { index; } ->
       match use_info with
-      | Const_ctor -> Simple Simple.const_zero
+      | Const_ctor -> Simple (Simple.const Reg_width_const.value_poison)
       | Block { tag = _; size = size_at_use; } ->
         if Targetint.OCaml.compare index size_at_use >= 0 then
-          Simple Simple.const_zero
+          Simple (Simple.const Reg_width_const.value_poison)
         else
           Default_behaviour No_untagging
 end