Cleanup of comprehensions and immutable arrays (#127)

* Delete some CRs

* [minor] Comment typo

* Update `Iarray` to remove `Obj.magic`

* Comment update

* Mark places attributes are correctly unused

* Remove a couple more CRs

* Add immutable array copyright headers

* Declare comprehensions and immutable arrays no longer experimental

* Add new `array_{to,of}_iarray` primitives and prepare to use them

* `make alldepend`

* Bootstrap

* Use new `%array_{to,of}_iarray` primitives

Author: antalsz

.depend

@@ -439,7 +439,6 @@ parsing/extensions.cmx : \
 parsing/extensions.cmi : \
     parsing/parsetree.cmi \
     parsing/location.cmi \
-    parsing/extensions_parsing.cmi \
     parsing/asttypes.cmi
 parsing/extensions_parsing.cmo : \
     parsing/parsetree.cmi \
@@ -1009,6 +1008,7 @@ typing/mtype.cmx : \
     typing/mtype.cmi
 typing/mtype.cmi : \
     typing/types.cmi \
+    typing/subst.cmi \
     typing/path.cmi \
     typing/ident.cmi \
     typing/env.cmi
@@ -1804,6 +1804,7 @@ typing/typemod.cmo : \
     typing/includemod.cmi \
     utils/import_info.cmi \
     typing/ident.cmi \
+    parsing/extensions.cmi \
     typing/envaux.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1842,6 +1843,7 @@ typing/typemod.cmx : \
     typing/includemod.cmx \
     utils/import_info.cmx \
     typing/ident.cmx \
+    parsing/extensions.cmx \
     typing/envaux.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
@@ -1873,6 +1875,7 @@ typing/typemod.cmi : \
 typing/typeopt.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
+    typing/type_immediacy.cmi \
     typing/predef.cmi \
     typing/path.cmi \
     utils/numbers.cmi \
@@ -1882,11 +1885,13 @@ typing/typeopt.cmo : \
     typing/env.cmi \
     typing/ctype.cmi \
     utils/config.cmi \
+    utils/clflags.cmi \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
+    typing/type_immediacy.cmx \
     typing/predef.cmx \
     typing/path.cmx \
     utils/numbers.cmx \
@@ -1896,6 +1901,7 @@ typing/typeopt.cmx : \
     typing/env.cmx \
     typing/ctype.cmx \
     utils/config.cmx \
+    utils/clflags.cmx \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmi : \

boot/ocamlc

@@ -112,7 +112,9 @@ let preserve_tailcall_for_prim = function
     Popaque | Psequor | Psequand
   | Pobj_magic ->
       true
-  | Pbytes_to_string | Pbytes_of_string | Pignore
+  | Pbytes_to_string | Pbytes_of_string
+  | Parray_to_iarray | Parray_of_iarray
+  | Pignore
   | Pgetglobal _ | Psetglobal _ | Pgetpredef _
   | Pmakeblock _ | Pmakefloatblock _
   | Pfield _ | Pfield_computed _ | Psetfield _
@@ -518,6 +520,8 @@ let comp_primitive p args =
   | Pint_as_pointer -> Kccall("caml_int_as_pointer", 1)
   | Pbytes_to_string -> Kccall("caml_string_of_bytes", 1)
   | Pbytes_of_string -> Kccall("caml_bytes_of_string", 1)
+  | Parray_to_iarray -> Kccall("caml_iarray_of_array", 1)
+  | Parray_of_iarray -> Kccall("caml_array_of_iarray", 1)
   | Pobj_dup -> Kccall("caml_obj_dup", 1)
   (* The cases below are handled in [comp_expr] before the [comp_primitive] call
      (in the order in which they appear below),

boot/ocamllex

@@ -239,6 +239,9 @@ type primitive =
   (* Primitives for [Obj] *)
   | Pobj_dup
   | Pobj_magic
+  (* Jane Street extensions *)
+  | Parray_to_iarray
+  | Parray_of_iarray
 
 and integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -1274,7 +1277,9 @@ let mod_setfield pos =
   Psetfield (pos, Pointer, Root_initialization)
 
 let primitive_may_allocate : primitive -> alloc_mode option = function
-  | Pbytes_to_string | Pbytes_of_string | Pignore -> None
+  | Pbytes_to_string | Pbytes_of_string
+  | Parray_to_iarray | Parray_of_iarray
+  | Pignore -> None
   | Pgetglobal _ | Psetglobal _ | Pgetpredef _ -> None
   | Pmakeblock (_, _, _, m) -> Some m
   | Pmakefloatblock (_, m) -> Some m

bytecomp/bytegen.ml

@@ -190,6 +190,11 @@ type primitive =
   (* Primitives for [Obj] *)
   | Pobj_dup
   | Pobj_magic
+  (* Jane Street extensions *)
+  | Parray_to_iarray (* Unsafely reinterpret a mutable array as an immutable
+                        one; O(1) *)
+  | Parray_of_iarray (* Unsafely reinterpret an immutable array as a mutable
+                        one; O(1) *)
 
 and integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge

lambda/lambda.ml

@@ -442,6 +442,9 @@ let primitive ppf = function
   | Pobj_dup -> fprintf ppf "obj_dup"
   | Pobj_magic -> fprintf ppf "obj_magic"
 
+  | Parray_to_iarray -> fprintf ppf "array_to_iarray"
+  | Parray_of_iarray -> fprintf ppf "array_of_iarray"
+
 let name_of_primitive = function
   | Pbytes_of_string -> "Pbytes_of_string"
   | Pbytes_to_string -> "Pbytes_to_string"
@@ -549,6 +552,8 @@ let name_of_primitive = function
   | Pprobe_is_enabled _ -> "Pprobe_is_enabled"
   | Pobj_dup -> "Pobj_dup"
   | Pobj_magic -> "Pobj_magic"
+  | Parray_of_iarray -> "Parray_of_iarray"
+  | Parray_to_iarray -> "Parray_to_iarray"
 
 let check_attribute ppf check =
   let check_property = function

lambda/lambda.mli

@@ -676,7 +676,10 @@ let rec emit_tail_infos is_tail lambda =
   | Lletrec (bindings, body) ->
       List.iter (fun (_, lam) -> emit_tail_infos false lam) bindings;
       emit_tail_infos is_tail body
-  | Lprim ((Pbytes_to_string | Pbytes_of_string), [arg], _) ->
+  | Lprim ((Pbytes_to_string | Pbytes_of_string |
+            Parray_to_iarray | Parray_of_iarray),
+           [arg],
+           _) ->
       emit_tail_infos is_tail arg
   | Lprim (Psequand, [arg1; arg2], _)
   | Lprim (Psequor, [arg1; arg2], _) ->

lambda/printlambda.ml

@@ -858,6 +858,7 @@ let rec choice ctx t =
 
     (* in common cases we just return *)
     | Pbytes_to_string | Pbytes_of_string
+    | Parray_to_iarray | Parray_of_iarray
     | Pgetglobal _ | Psetglobal _ | Pgetpredef _
     | Pfield _ | Pfield_computed _
     | Psetfield _ | Psetfield_computed _

lambda/simplif.ml

@@ -203,6 +203,7 @@ module Precompute_array_size : sig
   val safe_product_pos :
     ?variable_name:string -> loc:scoped_location -> lambda list -> lambda
 end = struct
+  (* Modeled after [Translcore.assert_failed] *)
   let raise_overflow_exn ~loc =
     let loc' = Debuginfo.Scoped_location.to_location loc in
     let slot =
@@ -211,8 +212,11 @@ end = struct
         Env.initial_safe_string
         Predef.path_invalid_argument
     in
-    (* CR aspectorzabusky: Should I call [Translprim.event_after] here?
-       [Translcore.asssert_failed] does (via a local intermediary). *)
+    (* CR-someday aspectorzabusky: We might want to raise an event here for
+       debug tracing (cf. [Translcore.assert_failed] and
+       [Translprim.event_after]), but it's not clear what event that would be,
+       and this isn't a feature we expect to use.  We can add it when it seems
+       important, or when we upstream this change. *)
     Lprim(Praise Raise_regular,
           [Lprim(Pmakeblock(0, Immutable, None, alloc_heap),
                  [ slot
@@ -509,7 +513,8 @@ let binding
       ~scopes
       ~loc
       { comp_cb_iterator; comp_cb_attributes = _ } =
-  (* CR aspectorzabusky: What do we do with attributes here? *)
+  (* No attributes are meaningful here; see the definition of
+     [comp_cb_attributes]. *)
   iterator ~transl_exp ~loc ~scopes comp_cb_iterator
 
 (** Translate the contents of a single [for ... and ...] clause (the contents of
@@ -748,8 +753,6 @@ let body
   let set_element_raw elt =
     (* array.(index) <- elt *)
     Lprim(Parraysetu array_kind, [array.var; index.var; elt], loc)
-      (* CR aspectorzabusky: Is [array_kind] safe here, since it could be
-         [Pgenarray]?  Do we have to learn which it should be? *)
   in
   let set_element_in_bounds elt = match array_sizing with
     | Fixed_size ->
@@ -835,18 +838,15 @@ let comprehension
         (Iterator_bindings.all_let_bindings var_bindings)
         (Lifthenelse(Iterator_bindings.Fixed_size_array.are_any_empty
                        ~loc var_bindings,
-           (* If the array is known to be empty, we short-circuit and return
-              the empty array *)
+           (* If the array is known to be empty, we short-circuit and return the
+              empty array; all empty arrays are identical, so we don't care
+              about its kind or mutability *)
            Lprim(
              Pmakearray(Pgenarray, Immutable, Lambda.alloc_heap),
              [],
              loc),
            (* Otherwise, we translate it normally *)
            comprehension,
-           (* CR aspectorzabusky: My understanding is that all empty arrays
-              are identical, no matter their [array_kind], and that's why I
-              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) *)
            (Pvalue (Parrayval array_kind))))
   | Dynamic_size_info ->

lambda/tmc.ml

@@ -4,8 +4,6 @@ open Debuginfo.Scoped_location
 
 (** Translate array comprehensions; see the .ml file for more details *)
 
-(* CR aspectorzabusky: Is it really true that I don't need to pass in array
-   mutability information here?  (Last sentence of the first paragraph.)  *)
 (** Translate an array comprehension ([Typedtree.comprehension], when it's the
     body of a [Typedtree.Texp_array_comprehension]) into Lambda.  This generates
     more efficient code in the case where the array has a known fixed size, by
@@ -14,7 +12,7 @@ open Debuginfo.Scoped_location
     of the resulting array must be provided.  We do not need to pass in whether
     the resulting array should be mutable or immutable; both sorts of arrays
     will be constructed mutably, and the type checker has already enforced that
-    only mutable arrays are used mutably.
+    only mutable arrays are actually used mutably.
 
     The only variables this term refers to are those that come from the array
     comprehension itself; some C primitives are referenced, but no standard

lambda/transl_array_comprehension.ml

@@ -132,9 +132,6 @@ module Lambda_utils = struct
       let prim = c_prim name 3 in
       fun ~loc x y z -> Lprim(prim, [x; y; z], loc)
 
-    (* CR aspectorzabusky: These primitives are now created unconditionally on
-       compiler startup.  Is that okay? *)
-
     let make_vect =
       let make_vect = binary "caml_make_vect" in
       fun ~loc ~length ~init -> make_vect ~loc length init

lambda/transl_array_comprehension.mli

@@ -84,19 +84,19 @@ open Lambda_utils.Constants
           Nil)
          ]}
 
-    See [CamlinternalComprehension] the types and functions we desugar to, along
-    with some more documentation. *)
+    See [CamlinternalComprehension] for the types and functions we desugar to,
+    along with some more documentation. *)
 
 (** An implementation note: Many of the functions in this file need to translate
     expressions from Typedtree to Lambda; to avoid strange dependency ordering,
     we parameterize those functions by [Translcore.transl_exp], and pass it in
     as a labeled argument, along with the necessary [scopes] labeled argument
     that it requires. *)
 
-(* CR aspectorzabusky: I couldn't get this to build if these were run as soon as
-   this file was processed *)
 (** The functions that are required to build the results of list comprehensions;
-    see the documentation for [CamlinternalComprehension] for more details. *)
+    see the documentation for [CamlinternalComprehension] for more details.
+    Because these are being looked up in the environment, we need to wait to
+    create them until that exists, hence [lazy]. *)
 let ( rev_list_to_list
     , rev_dlist_concat_map
     , rev_dlist_concat_iterate_up
@@ -136,7 +136,9 @@ type translated_iterator =
       ]}
       Once the "iterator arguments", which vary depending on the iterator, are
       applied to this function (see [arg_lets]), then it is simply waiting for
-      the body of the iterator (the final function argument). *)
+      the body of the iterator (the final function argument).  Lazy because it
+      holds a reference to a primitive, which has to be constructed lazily (see
+      above). *)
   ; arg_lets : Let_binding.t list
   (** The first-class let bindings that bind the arguments to the [builder]
       function that actually does the iteration.  These let bindings need to be
@@ -194,8 +196,6 @@ let iterator ~transl_exp ~scopes = function
       ; element
       ; 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 (Pvalue Pgenval)
       }
@@ -208,7 +208,8 @@ let iterator ~transl_exp ~scopes = function
     so bindings are just like iterators with a possible annotation.  As a
     result, this function is essentially the same as [iterator], which see. *)
 let binding ~transl_exp ~scopes { comp_cb_iterator; comp_cb_attributes = _ } =
-  (* CR aspectorzabusky: What do we do with attributes here? *)
+  (* No attributes are meaningful here; see the definition of
+     [comp_cb_attributes]. *)
   iterator ~transl_exp ~scopes comp_cb_iterator
 
 (** Translate all the bindings of a single [for ... and ...] clause (the

lambda/transl_comprehension_utils.ml

@@ -562,8 +562,6 @@ and transl_exp0 ~in_new_scope ~scopes e =
               if Config.flambda2 then
                 imm_array
               else
-                (* CR aspectorzabusky: Do we construct things correctly in this
-                   case? *)
                 match kind with
                 | Paddrarray | Pintarray ->
                   Lconst(Const_block(0, cl))

lambda/transl_list_comprehension.ml

@@ -399,6 +399,8 @@ let lookup_primitive loc poly pos p =
     | "%compare" -> Comparison(Compare, Compare_generic)
     | "%obj_dup" -> Primitive(Pobj_dup, 1)
     | "%obj_magic" -> Primitive(Pobj_magic, 1)
+    | "%array_to_iarray" -> Primitive (Parray_to_iarray, 1)
+    | "%array_of_iarray" -> Primitive (Parray_of_iarray, 1)
     | s when String.length s > 0 && s.[0] = '%' ->
        raise(Error(loc, Unknown_builtin_primitive s))
     | _ -> External p
@@ -869,7 +871,9 @@ let lambda_primitive_needs_event_after = function
   | Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
   | Pbbswap _ | Pobj_dup -> true
 
-  | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _
+  | Pbytes_to_string | Pbytes_of_string
+  | Parray_to_iarray | Parray_of_iarray
+  | Pignore | Psetglobal _
   | Pgetglobal _ | Pgetpredef _ | Pmakeblock _ | Pmakefloatblock _
   | Pfield _ | Pfield_computed _ | Psetfield _
   | Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Praise _

lambda/translcore.ml

@@ -1321,7 +1321,9 @@ let rec close ({ backend; fenv; cenv ; mutable_vars; kinds; catch_env } as env)
   | Lprim(Pignore, [arg], _loc) ->
       let expr, approx = make_const_int 0 in
       Usequence(fst (close env arg), expr), approx
-  | Lprim((Pbytes_to_string | Pbytes_of_string | Pobj_magic),
+  | Lprim((Pbytes_to_string | Pbytes_of_string |
+           Parray_to_iarray | Parray_of_iarray |
+           Pobj_magic),
           [arg], _loc) ->
       close env arg
   | Lprim(Pgetglobal cu, [], loc) ->

lambda/translprim.ml

@@ -162,6 +162,8 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
   | Pgetglobal _
   | Psetglobal _
   | Pgetpredef _
+  | Parray_to_iarray
+  | Parray_of_iarray
     ->
       Misc.fatal_errorf "lambda primitive %a can't be converted to \
                          clambda primitive"

middle_end/closure/closure.ml

@@ -419,7 +419,9 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         (If_then_else (cond, arg2, Var const_false, Lambda.layout_int)))
   | Lprim ((Psequand | Psequor), _, _) ->
     Misc.fatal_error "Psequand / Psequor must have exactly two arguments"
-  | Lprim ((Pbytes_to_string | Pbytes_of_string | Pobj_magic),
+  | Lprim ((Pbytes_to_string | Pbytes_of_string |
+            Parray_to_iarray | Parray_of_iarray |
+            Pobj_magic),
            [arg], _) ->
     close t env arg
   | Lprim (Pignore, [arg], _) ->

middle_end/convert_primitives.ml

@@ -174,6 +174,8 @@ let psubint = "Psubint"
 let pxorbint = "Pxorbint"
 let pxorint = "Pxorint"
 let pprobe_is_enabled = "Pprobe_is_enabled"
+let parray_of_iarray = "Parray_of_iarray"
+let parray_to_iarray = "Parray_to_iarray"
 let pabsfloat_arg = "Pabsfloat_arg"
 let paddbint_arg = "Paddbint_arg"
 let paddfloat_arg = "Paddfloat_arg"
@@ -281,6 +283,8 @@ let psubint_arg = "Psubint_arg"
 let pxorbint_arg = "Pxorbint_arg"
 let pxorint_arg = "Pxorint_arg"
 let pprobe_is_enabled_arg = "Pprobe_is_enabled_arg"
+let parray_of_iarray_arg = "Parray_of_iarray_arg"
+let parray_to_iarray_arg = "Parray_to_iarray_arg"
 let raise = "raise"
 let raise_arg = "raise_arg"
 let read_mutable = "read_mutable"
@@ -421,6 +425,8 @@ let of_primitive : Lambda.primitive -> string = function
   | Pprobe_is_enabled _ -> pprobe_is_enabled
   | Pobj_dup -> pobj_dup
   | Pobj_magic -> pobj_magic
+  | Parray_of_iarray -> parray_of_iarray
+  | Parray_to_iarray -> parray_to_iarray
 
 let of_primitive_arg : Lambda.primitive -> string = function
   | Pbytes_of_string -> pbytes_of_string_arg
@@ -529,3 +535,5 @@ let of_primitive_arg : Lambda.primitive -> string = function
   | Pprobe_is_enabled _ -> pprobe_is_enabled_arg
   | Pobj_dup -> pobj_dup_arg
   | Pobj_magic -> pobj_magic_arg
+  | Parray_of_iarray -> parray_of_iarray_arg
+  | Parray_to_iarray -> parray_to_iarray_arg