Middle end/backend/runtime changes for or_null

backend/cmm_helpers.ml

@@ -1383,6 +1383,7 @@ module Extended_machtype = struct
     | Pvalue Pintval -> typ_tagged_int
     | Pvalue _ -> typ_val
     | Punboxed_product fields -> Array.concat (List.map of_layout fields)
+    | Pnullable_value vk -> of_layout (Lambda.Pvalue vk)
 end
 
 let machtype_of_layout layout =
@@ -2997,7 +2998,7 @@ let arraylength kind arg dbg =
                 Any ))
     in
     Cop (Cor, [len; Cconst_int (1, dbg)], dbg)
-  | Paddrarray | Pintarray ->
+  | Pnullablearray _ | Paddrarray | Pintarray ->
     Cop (Cor, [addr_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
   | Pfloatarray | Punboxedfloatarray Pfloat64 ->
     (* Note: we only support 64 bit targets now, so this is ok for
@@ -3792,7 +3793,7 @@ let kind_of_layout (layout : Lambda.layout) =
   | Pvalue (Pboxedvectorval vi) -> Boxed_vector vi
   | Pvalue (Pgenval | Pintval | Pvariant _ | Parrayval _)
   | Ptop | Pbottom | Punboxed_float _ | Punboxed_int _ | Punboxed_vector _
-  | Punboxed_product _ ->
+  | Punboxed_product _ | Pnullable_value _ ->
     Any
 
 (* Atomics *)

middle_end/flambda2/classic_mode_types/value_approximation.ml

@@ -19,6 +19,7 @@
 type 'code t =
   | Value_unknown
   | Value_symbol of Symbol.t
+  | Value_null
   | Value_int of Targetint_31_63.t
   | Closure_approximation of
       { code_id : Code_id.t;
@@ -33,6 +34,7 @@ type 'code t =
 let rec print fmt = function
   | Value_unknown -> Format.fprintf fmt "?"
   | Value_symbol sym -> Symbol.print fmt sym
+  | Value_null -> Format.fprintf fmt "null"
   | Value_int i -> Targetint_31_63.print fmt i
   | Closure_approximation { code_id; _ } ->
     Format.fprintf fmt "[%a]" Code_id.print code_id
@@ -49,13 +51,13 @@ let rec print fmt = function
 
 let is_unknown = function
   | Value_unknown -> true
-  | Value_symbol _ | Value_int _ | Closure_approximation _
+  | Value_symbol _ | Value_null | Value_int _ | Closure_approximation _
   | Block_approximation _ ->
     false
 
 let rec free_names ~code_free_names approx =
   match approx with
-  | Value_unknown | Value_int _ -> Name_occurrences.empty
+  | Value_unknown | Value_null | Value_int _ -> Name_occurrences.empty
   | Value_symbol sym -> Name_occurrences.singleton_symbol sym Name_mode.normal
   | Block_approximation (_tag, approxs, _) ->
     Array.fold_left

middle_end/flambda2/classic_mode_types/value_approximation.mli

@@ -19,6 +19,7 @@
 type 'code t =
   | Value_unknown
   | Value_symbol of Symbol.t
+  | Value_null
   | Value_int of Targetint_31_63.t
   | Closure_approximation of
       { code_id : Code_id.t;

middle_end/flambda2/from_lambda/closure_conversion.ml

@@ -106,6 +106,7 @@ let rec declare_const acc (const : Lambda.structured_constant) :
     Acc.t * declare_const_result * string =
   let module SC = Static_const in
   match const with
+  | Const_base Const_null -> acc, Field Null, "null"
   | Const_base (Const_int c) ->
     acc, Field (Tagged_immediate (Targetint_31_63.of_int c)), "int"
   | Const_base (Const_char c) ->
@@ -180,6 +181,12 @@ let rec declare_const acc (const : Lambda.structured_constant) :
 let close_const0 acc (const : Lambda.structured_constant) =
   let acc, const, name = declare_const acc const in
   match const with
+  | Field Null ->
+    ( acc,
+      Simple.const Reg_width_const.null,
+      name,
+      Flambda_kind.With_subkind.nullable_value
+        Flambda_kind.With_subkind.any_value )
   | Field (Tagged_immediate i) ->
     ( acc,
       Simple.const (Reg_width_const.tagged_immediate i),
@@ -255,6 +262,7 @@ let find_value_approximation env simple =
     ~symbol:(fun sym ~coercion:_ -> Value_approximation.Value_symbol sym)
     ~const:(fun const ->
       match Reg_width_const.descr const with
+      | Null -> Value_approximation.Value_null
       | Tagged_immediate i -> Value_approximation.Value_int i
       | Naked_immediate _ | Naked_float _ | Naked_float32 _ | Naked_int32 _
       | Naked_int64 _ | Naked_vec128 _ | Naked_nativeint _ ->
@@ -283,8 +291,10 @@ module Inlining = struct
       Inlining_report.record_decision_at_call_site_for_unknown_function ~tracker
         ~apply ~pass:After_closure_conversion ();
       Not_inlinable
-    | Some (Value_symbol _) | Some (Value_int _) | Some (Block_approximation _)
-      ->
+    | Some (Value_symbol _)
+    | Some Value_null
+    | Some (Value_int _)
+    | Some (Block_approximation _) ->
       assert false
     | Some (Closure_approximation { code; _ }) ->
       let metadata = Code_or_metadata.code_metadata code in
@@ -865,7 +875,8 @@ let close_primitive acc env ~let_bound_ids_with_kinds named
       | Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
       | Punboxed_product_field _ | Pget_header _ | Prunstack | Pperform
       | Presume | Preperform | Patomic_exchange | Patomic_cas
-      | Patomic_fetch_add | Pdls_get | Patomic_load _ ->
+      | Patomic_fetch_add | Pdls_get | Patomic_load _ | Pcoerce_to_null
+      | Pcoerce_to_non_null ->
         (* Inconsistent with outer match *)
         assert false
     in
@@ -930,7 +941,8 @@ type simplified_block_load =
 let simplify_block_load acc body_env ~block ~field : simplified_block_load =
   match find_value_approximation_through_symbol acc body_env block with
   | Value_unknown -> Unknown
-  | Closure_approximation _ | Value_symbol _ | Value_int _ -> Not_a_block
+  | Closure_approximation _ | Value_symbol _ | Value_null | Value_int _ ->
+    Not_a_block
   | Block_approximation (_tag, approx, _alloc_mode) -> (
     let approx =
       Simple.pattern_match field
@@ -944,6 +956,7 @@ let simplify_block_load acc body_env ~block ~field : simplified_block_load =
     in
     match approx with
     | Some (Value_symbol sym) -> Field_contents (Simple.symbol sym)
+    | Some Value_null -> Field_contents Simple.null
     | Some (Value_int i) -> Field_contents (Simple.const_int i)
     | Some approx -> Block_but_cannot_simplify approx
     | None -> Not_a_block)
@@ -1271,8 +1284,8 @@ let close_exact_or_unknown_apply acc env
           acc, Call_kind.direct_function_call code_id mode, can_erase_callee
       | None -> acc, Call_kind.indirect_function_call_unknown_arity mode, false
       | Some
-          (Value_unknown | Value_symbol _ | Value_int _ | Block_approximation _)
-        ->
+          ( Value_unknown | Value_symbol _ | Value_null | Value_int _
+          | Block_approximation _ ) ->
         assert false (* See [close_apply] *))
     | Method { kind; obj } ->
       let acc, obj = find_simple acc env obj in
@@ -1473,7 +1486,7 @@ let unboxing_primitive (k : Function_decl.unboxing_kind) boxed_variable i =
       Values
         { tag = Known Tag.Scannable.zero;
           size = Known (Targetint_31_63.of_int (List.length kinds));
-          field_kind = Any_value
+          field_kind = Value
         }
     in
     Flambda_primitive.Binary
@@ -2891,7 +2904,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t =
           Code_metadata.result_mode metadata,
           Code_metadata.contains_no_escaping_local_allocs metadata )
     | Value_unknown -> None
-    | Value_symbol _ | Value_int _ | Block_approximation _ ->
+    | Value_symbol _ | Value_null | Value_int _ | Block_approximation _ ->
       if Flambda_features.check_invariants ()
       then
         Misc.fatal_errorf
@@ -3168,7 +3181,7 @@ let wrap_final_module_block acc env ~program ~prog_return_cont
       Values
         { tag = Known Tag.Scannable.zero;
           size = Known (Targetint_31_63.of_int module_block_size_in_words);
-          field_kind = Any_value
+          field_kind = Value
         }
     in
     List.fold_left

middle_end/flambda2/from_lambda/closure_conversion_aux.ml

@@ -396,12 +396,12 @@ module Acc = struct
               "Closure_conversion: approximation loader returned a Symbol \
                approximation (%a) for symbol %a"
               Symbol.print sym Symbol.print symbol
-          | Value_unknown | Value_int _ | Closure_approximation _
+          | Value_unknown | Value_null | Value_int _ | Closure_approximation _
           | Block_approximation _ ->
             ());
         let rec filter_inlinable approx =
           match (approx : Env.value_approximation) with
-          | Value_unknown | Value_symbol _ | Value_int _ -> approx
+          | Value_unknown | Value_symbol _ | Value_null | Value_int _ -> approx
           | Block_approximation (tag, approxs, alloc_mode) ->
             let approxs = Array.map filter_inlinable approxs in
             Value_approximation.Block_approximation (tag, approxs, alloc_mode)
@@ -491,6 +491,7 @@ module Acc = struct
           let approx_of_field :
               Field_of_static_block.t -> _ Value_approximation.t = function
             | Symbol sym -> Value_symbol sym
+            | Null -> Value_null
             | Tagged_immediate i -> Value_int i
             | Dynamically_computed _ -> Value_unknown
           in
@@ -535,7 +536,7 @@ module Acc = struct
       Misc.fatal_errorf "Symbol %a approximated to symbol %a" Symbol.print
         symbol Symbol.print s
     | Value_unknown | Closure_approximation _ | Block_approximation _
-    | Value_int _ ->
+    | Value_null | Value_int _ ->
       (* We need all defined symbols to be present in [symbol_approximations],
          even when their approximation is [Value_unknown] *)
       { t with

middle_end/flambda2/from_lambda/lambda_to_flambda.ml

@@ -698,7 +698,8 @@ let primitive_can_raise (prim : Lambda.primitive) =
   | Pprobe_is_enabled _ | Pobj_dup | Pobj_magic _
   | Pbox_float (_, _)
   | Punbox_float _ | Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
-  | Punboxed_product_field _ | Pget_header _ ->
+  | Punboxed_product_field _ | Pget_header _ | Pcoerce_to_null
+  | Pcoerce_to_non_null ->
     false
   | Patomic_exchange | Patomic_cas | Patomic_fetch_add | Patomic_load _ -> false
   | Prunstack | Pperform | Presume | Preperform | Pdls_get ->
@@ -890,8 +891,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
             match layout with
             | Ptop | Pbottom ->
               Misc.fatal_error "Cannot bind layout [Ptop] or [Pbottom]"
-            | Pvalue _ | Punboxed_int _ | Punboxed_float _ | Punboxed_vector _
-              ->
+            | Pvalue _ | Pnullable_value _ | Punboxed_int _ | Punboxed_float _
+            | Punboxed_vector _ ->
               ( env,
                 [ ( id,
                     Flambda_kind.With_subkind
@@ -1014,8 +1015,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
       let id = Ident.create_local name in
       let result_layout = L.primitive_result_layout prim in
       (match result_layout with
-      | Pvalue _ | Punboxed_float _ | Punboxed_int _ | Punboxed_vector _
-      | Punboxed_product _ ->
+      | Pvalue _ | Pnullable_value _ | Punboxed_float _ | Punboxed_int _
+      | Punboxed_vector _ | Punboxed_product _ ->
         ()
       | Ptop | Pbottom ->
         Misc.fatal_errorf "Invalid result layout %a for primitive %a"
@@ -1549,8 +1550,8 @@ and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents
       in
       Some (Unboxed_number bn)
     | Pvalue (Pgenval | Pintval | Pvariant _ | Parrayval _)
-    | Ptop | Pbottom | Punboxed_float _ | Punboxed_int _ | Punboxed_vector _
-    | Punboxed_product _ ->
+    | Pnullable_value _ | Ptop | Pbottom | Punboxed_float _ | Punboxed_int _
+    | Punboxed_vector _ | Punboxed_product _ ->
       Location.prerr_warning
         (Debuginfo.Scoped_location.to_location loc)
         Warnings.Unboxing_impossible;