flambda-backend: fix things after merge

Author: riaqn

boot/ocamlc

@@ -231,7 +231,7 @@ end = struct
     let y = y.Let_binding.var in
     let open (val Lambda_utils.int_ops ~loc) in
     let product =
-      Let_binding.make (Immutable Alias) Pintval "product" (x * y)
+      Let_binding.make (Immutable Alias) (Pvalue Pintval) "product" (x * y)
     in
     (* [x * y] is safe, for strictly positive [x] and [y], iff you can undo the
        multiplication: [(x * y)/y = x].  We assume the inputs are values, so we
@@ -240,7 +240,7 @@ end = struct
       (Lifthenelse(product.var / y = x,
          product.var,
          raise_overflow_exn ~loc,
-         Pintval))
+         Pvalue Pintval))
 
   (** [safe_product_pos_vals ~loc xs] generates the lambda expression that
       computes the product of all the lambda values in [xs] assuming they are
@@ -260,7 +260,7 @@ end = struct
      variables, but we assume the optimizer can deal with that case nicely. *)
   let safe_product_pos ?(variable_name = "x") ~loc factors =
     let factors =
-      List.map (Let_binding.make (Immutable Strict) Pintval
+      List.map (Let_binding.make (Immutable Strict) (Pvalue Pintval)
                        variable_name) factors
     in
     Let_binding.let_all factors (safe_product_pos_vals ~loc factors)
@@ -366,7 +366,7 @@ module Iterator_bindings = struct
           (* We can assume that the range is nonempty, but computing its size
              still might overflow *)
           let range_size =
-            Let_binding.make (Immutable Alias) Pintval
+            Let_binding.make (Immutable Alias) (Pvalue Pintval)
               "range_size" (high - low + l1)
           in
           Let_binding.let_one range_size
@@ -375,7 +375,7 @@ module Iterator_bindings = struct
             (Lifthenelse(range_size.var > l0,
                          range_size.var,
                          Precompute_array_size.raise_overflow_exn ~loc,
-                         Pintval))
+                         Pvalue Pintval))
       | Array { iter_arr = _; iter_len } ->
           iter_len.var
 
@@ -445,7 +445,7 @@ let iterator ~transl_exp ~scopes ~loc
     = function
   | Texp_comp_range { ident; pattern = _; start; stop; direction } ->
       let bound name value =
-        Let_binding.make (Immutable Strict) Pintval
+        Let_binding.make (Immutable Strict) (Pvalue Pintval)
           name (transl_exp ~scopes value)
       in
       let start = bound "start" start in
@@ -463,14 +463,14 @@ let iterator ~transl_exp ~scopes ~loc
                          ; direction }
   | Texp_comp_in { pattern; sequence = iter_arr_exp } ->
       let iter_arr =
-        Let_binding.make (Immutable Strict) Pgenval
+        Let_binding.make (Immutable Strict) (Pvalue Pgenval)
           "iter_arr" (transl_exp ~scopes iter_arr_exp)
       in
       let iter_arr_kind = Typeopt.array_kind iter_arr_exp in
       let iter_len =
         (* Extra let-binding if we're not in the fixed-size array case; the
            middle-end will simplify this for us *)
-        Let_binding.make (Immutable Alias) Pintval
+        Let_binding.make (Immutable Alias) (Pvalue Pintval)
           "iter_len"
           (Lprim(Parraylength iter_arr_kind, [iter_arr.var], loc))
       in
@@ -491,7 +491,7 @@ let iterator ~transl_exp ~scopes ~loc
                           [iter_arr.var; Lvar iter_ix],
                           loc))
                    pattern
-                   Pintval
+                   (Pvalue Pintval)
                    body
              }
       in
@@ -542,7 +542,7 @@ let clause ~transl_exp ~scopes ~loc = function
       fun body -> Lifthenelse(transl_exp ~scopes cond,
                     body,
                     lambda_unit,
-                    Pintval (* [unit] is immediate *))
+                    (Pvalue Pintval) (* [unit] is immediate *))
 
 (** The [array_sizing] type describes whether an array comprehension has been
     translated using the fixed-size array optimization ([Fixed_size]), or it has
@@ -614,7 +614,7 @@ let clauses ~transl_exp ~scopes ~loc = function
         for_and_clause ~transl_exp ~loc ~scopes bindings
       in
       let array_size =
-        Let_binding.make (Immutable Alias) Pintval
+        Let_binding.make (Immutable Alias) (Pvalue Pintval)
           "array_size"
           (Iterator_bindings.Fixed_size_array.total_size_nonempty
              ~loc var_bindings)
@@ -625,7 +625,7 @@ let clauses ~transl_exp ~scopes ~loc = function
       }
   | clauses ->
       let array_size =
-        Let_binding.make Mutable Pintval
+        Let_binding.make Mutable (Pvalue Pintval)
           "array_size" (int Resizable_array.starting_size)
       in
       let make_comprehension =
@@ -696,7 +696,7 @@ let initial_array ~loc ~array_kind ~array_size ~array_sizing =
     | Dynamic_size, Pfloatarray ->
         Mutable, Resizable_array.make ~loc array_kind (float 0.)
   in
-  Let_binding.make array_let_kind Pgenval "array" array_value
+  Let_binding.make array_let_kind (Pvalue Pgenval) "array" array_value
 
 (** Generate the code for the body of an array comprehension.  This involves
     translating the body expression (a [Typedtree.expression], which is the
@@ -763,14 +763,14 @@ let body
               Lassign(array_size.id, i 2 * array_size.var),
               Lassign(array.id,
                       Resizable_array.double ~loc array.var)),
-            Pintval (* [unit] is immediate *)),
+            (Pvalue Pintval) (* [unit] is immediate *)),
           (* ...and then set the element now that the array is big enough *)
           set_element_raw elt)
   in
   let set_element_known_kind_in_bounds = match array_kind with
     | Pgenarray ->
         let is_first_iteration = (index.var = l0) in
-        let elt = Let_binding.make (Immutable Strict) Pgenval "elt" body in
+        let elt = Let_binding.make (Immutable Strict) (Pvalue Pgenval) "elt" body in
         let make_array = match array_sizing with
           | Fixed_size ->
               make_vect ~loc ~length:array_size.var ~init:elt.var
@@ -781,7 +781,7 @@ let body
              (Lifthenelse(is_first_iteration,
                Lassign(array.id, make_array),
                set_element_in_bounds elt.var,
-               Pintval (* [unit] is immediate *)))
+               (Pvalue Pintval) (* [unit] is immediate *)))
     | Pintarray | Paddrarray | Pfloatarray ->
         set_element_in_bounds body
   in
@@ -801,7 +801,7 @@ let comprehension
   let array =
     initial_array ~loc ~array_kind ~array_size ~array_sizing
   in
-  let index = Let_binding.make Mutable Pintval "index" (int 0) in
+  let index = Let_binding.make Mutable (Pvalue Pintval) "index" (int 0) in
   (* The core of the comprehension: the array, the index, and the iteration that
      fills everything in.  The translation of the clauses will produce a check
      to see if we can avoid doing the hard work of growing the array, which is
@@ -848,6 +848,6 @@ let comprehension
               can use [Pgenarray] to create the empty array above but still
               use [array_kind] here.  Is that right? *)
            (* (And the result has the [value_kind] of the array) *)
-           Parrayval array_kind))
+           (Pvalue (Parrayval array_kind))))
   | Dynamic_size_info ->
       comprehension

boot/ocamllex

@@ -9,23 +9,23 @@ module Let_binding = struct
 
   type t =
     { let_kind   : Let_kind.t
-    ; value_kind : value_kind
+    ; layout : layout
     ; id         : Ident.t
     ; init       : lambda
     ; var        : lambda }
 
-  let make (let_kind : Let_kind.t) value_kind name init =
+  let make (let_kind : Let_kind.t) layout name init =
     let id = Ident.create_local name in
     let var = match let_kind with
       | Mutable -> Lmutvar id
       | Immutable _ -> Lvar id
     in
-    {let_kind; value_kind; id; init; var}
+    {let_kind; layout; id; init; var}
 
-  let let_one {let_kind; value_kind; id; init} body =
+  let let_one {let_kind; layout; id; init} body =
     match let_kind with
-    | Immutable let_kind -> Llet(let_kind, value_kind, id, init, body)
-    | Mutable            -> Lmutlet(value_kind, id, init, body)
+    | Immutable let_kind -> Llet(let_kind, layout, id, init, body)
+    | Mutable            -> Lmutlet(layout, id, init, body)
 
   let let_all = List.fold_right let_one
 end
@@ -43,7 +43,9 @@ module Lambda_utils = struct
         ~loc
         ~mode
         func
-        args =
+        args
+        ~result_layout
+        =
     (* These defaultscould be promoted to optional arguments if they were more
        widely used *)
     let region_close = Rc_normal in
@@ -60,6 +62,7 @@ module Lambda_utils = struct
            ; ap_inlined      = inlined
            ; ap_specialised  = specialised
            ; ap_probe        = probe
+           ; ap_result_layout = result_layout
            }
 
   module type Int_ops = sig

lambda/transl_array_comprehension.ml

@@ -27,15 +27,15 @@ module Let_binding : sig
   (** The first-class (in OCaml) type of let bindings. *)
   type t = private
     { let_kind   : Let_kind.t
-    ; value_kind : value_kind
+    ; layout     : layout
     ; id         : Ident.t
     ; init       : lambda   (* initial value *)
     ; var        : lambda   (* occurrence of this variable *)
     }
 
   (** Create a fresh local identifier (with name as given by the string
       argument) to bind to an initial value given by the lambda argument. *)
-  val make : Let_kind.t -> value_kind -> string -> lambda -> t
+  val make : Let_kind.t -> layout -> string -> lambda -> t
 
   (** Create a Lambda let-binding (with [Llet]) from a first-class let
       binding, providing the body. *)
@@ -65,7 +65,8 @@ module Lambda_utils : sig
   (** Apply a Lambda function to some Lambda values, at a location; all the
       other information needed by [Lapply] is set to some default value. *)
   val apply :
-    loc:scoped_location -> mode:alloc_mode -> lambda -> lambda list -> lambda
+    loc:scoped_location -> mode:alloc_mode -> lambda -> lambda list ->
+      result_layout:layout -> lambda
 
   (** Nicer OCaml syntax for constructing Lambda ASTs that operate on integers;
       created by [int_ops], which includes the necessary location in all the

lambda/transl_comprehension_utils.ml

@@ -149,8 +149,8 @@ type translated_iterator =
   (** The name given to the values we're iterating over; needs to be a fresh
       name for [for]-[in] iterators in case the user specifies a complex
       pattern. *)
-  ; element_kind : value_kind
-  (** The [value_kind] of the values we're iterating over. *)
+  ; element_kind : layout
+  (** The [layout] of the values we're iterating over. *)
   ; add_bindings : lambda -> lambda
   (** Any extra bindings that should be present in the body of this iterator,
       for use by nested pieces of the translation; used if the user specifies a
@@ -169,7 +169,7 @@ let iterator ~transl_exp ~scopes = function
          correct (i.e., left-to-right) order *)
       let transl_bound var bound =
         Let_binding.make
-          (Immutable Strict) Pintval
+          (Immutable Strict) (Pvalue Pintval)
           var (transl_exp ~scopes bound)
       in
       let start = transl_bound "start" start in
@@ -179,25 +179,25 @@ let iterator ~transl_exp ~scopes = function
                         | Downto -> rev_dlist_concat_iterate_down)
       ; arg_lets     = [start; stop]
       ; element      = ident
-      ; element_kind = Pintval
+      ; element_kind = Pvalue Pintval
       ; add_bindings = Fun.id
       }
   | Texp_comp_in { pattern; sequence } ->
       let iter_list =
-        Let_binding.make (Immutable Strict) Pgenval
+        Let_binding.make (Immutable Strict) (Pvalue Pgenval)
           "iter_list" (transl_exp ~scopes sequence)
       in
       (* Create a fresh variable to use as the function argument *)
       let element = Ident.create_local "element" in
       { builder      = rev_dlist_concat_map
       ; arg_lets     = [iter_list]
       ; element
-      ; element_kind = Typeopt.value_kind pattern.pat_env pattern.pat_type
+      ; element_kind = Typeopt.layout pattern.pat_env pattern.pat_type
       ; add_bindings =
           (* CR aspectorzabusky: This has to be at [value_kind] [Pgenval],
              right, since we don't know more specifically? *)
           Matching.for_let
-            ~scopes pattern.pat_loc (Lvar element) pattern Pgenval
+            ~scopes pattern.pat_loc (Lvar element) pattern (Pvalue Pgenval)
       }
 
 (** Translates a list comprehension binding
@@ -238,8 +238,8 @@ let rec translate_bindings
           ~kind:(Curried { nlocal = 2 })
           (* Only the accumulator is local, but since the function itself is
              local, [nlocal] has to be equal to the number of parameters *)
-          ~params:[element, element_kind; inner_acc, Pgenval]
-          ~return:Pgenval
+          ~params:[element, element_kind; inner_acc, Pvalue Pgenval]
+          ~return:(Pvalue Pgenval)
           ~attr:default_function_attribute
           ~loc
           ~mode:alloc_local
@@ -253,6 +253,7 @@ let rec translate_bindings
           (Lazy.force builder)
           (List.map (fun Let_binding.{id; _} -> Lvar id) arg_lets @
            [body_func; accumulator])
+          ~result_layout:(Pvalue Pgenval)
       in
       arg_lets @ body_arg_lets, result
   | [] ->
@@ -283,7 +284,7 @@ let rec translate_clauses
             Lifthenelse(transl_exp ~scopes cond,
                         body ~accumulator,
                         accumulator,
-                        Pgenval (* [list]s have the standard representation *))
+                        (Pvalue Pgenval) (* [list]s have the standard representation *))
       end
   | [] ->
       comprehension_body ~accumulator
@@ -304,3 +305,4 @@ let comprehension ~transl_exp ~scopes ~loc { comp_body; comp_clauses } =
     ~mode:alloc_heap
     (Lazy.force rev_list_to_list)
     [rev_comprehension]
+    ~result_layout:(Pvalue Pgenval)