"with" -> "with type"

Compilation de [| ... |] avec plus de 256 elements.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@310 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 25 insertions, 2 deletions

diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 8710902e6..d3c8bfc8f 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -93,7 +93,7 @@ val name_lambda: lambda -> (Ident.t -> lambda) -> lambda
 val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
 val is_guarded: lambda -> bool
 
-module IdentSet: Set.S with elt = Ident.t
+module IdentSet: Set.S with type elt = Ident.t
 val free_variables: lambda -> IdentSet.t
 
 type compilenv
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index e1415947d..e58fcc2c8 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -235,6 +235,10 @@ let array_kind arg =
   | _ -> Pgenarray (* This can happen with abbreviations that we can't expand
                       here because the typing environment is lost *)
 
+let prim_makearray =
+  { prim_name = "make_vect"; prim_arity = 2; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false }
+
 let transl_prim prim args =
   try
     let (gencomp, intcomp, floatcomp, stringcomp) =
@@ -400,7 +404,26 @@ let rec transl_exp env e =
         | Record_float -> Psetfloatfield lbl.lbl_pos in
       Lprim(access, [transl_exp env arg; transl_exp env newval])
   | Texp_array expr_list ->
-      Lprim(Pmakearray(array_kind e), transl_list env expr_list)
+      let kind = array_kind e in
+      let len = List.length expr_list in
+      if len <= Config.max_young_wosize then
+        Lprim(Pmakearray kind, transl_list env expr_list)
+      else begin
+        let v = Ident.new "makearray" in
+        let rec fill_fields pos = function
+          [] ->
+            Lvar v
+        | arg :: rem ->
+            Lsequence(Lprim(Parraysetu kind,
+                            [Lvar v;
+                             Lconst(Const_base(Const_int pos));
+                             transl_exp env arg]),
+                      fill_fields (pos+1) rem) in
+        Llet(v, Lprim(Pccall prim_makearray,
+                      [Lconst(Const_base(Const_int len));
+                       transl_exp env (List.hd expr_list)]),
+                fill_fields 1 (List.tl expr_list))
+      end
   | Texp_ifthenelse(cond, ifso, Some ifnot) ->
       Lifthenelse(transl_exp env cond, transl_exp env ifso,
                                        transl_exp env ifnot)