Ajout de std_exit au link.

Pas de code produit par une definition de primitive.


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

bytecomp/bytelink.ml

@@ -172,7 +172,7 @@ let link_file outchan = function
 (* Create a bytecode executable file *)
 
 let link_bytecode objfiles exec_name copy_header =
-  let objfiles = "stdlib.cma" :: objfiles in
+  let objfiles = "stdlib.cma" :: (objfiles @ ["std_exit.cmo"]) in
   let tolink =
     List.fold_right scan_file objfiles [] in
   let outchan =

bytecomp/translcore.ml

@@ -273,6 +273,28 @@ let transl_prim prim args =
   with Not_found ->
     Pccall prim
 
+(* Eta-expand a primitive without knowing the types of its arguments *)
+
+let transl_primitive p =
+  let prim =
+    try
+      let (gencomp, intcomp, floatcomp, stringcomp) =
+        Hashtbl.find comparisons_table p.prim_name in
+      gencomp
+    with Not_found ->
+    try
+      Hashtbl.find primitives_table p.prim_name
+    with Not_found ->
+      Pccall p in
+  let rec add_params n params =
+    if n >= p.prim_arity
+    then Lprim(prim, List.rev params)
+    else begin
+      let id = Ident.new "prim" in
+      Lfunction(id, add_params (n+1) (Lvar id :: params))
+    end in
+  add_params 0 []
+
 (* To check the well-formedness of r.h.s. of "let rec" definitions *)
 
 let check_recursive_lambda id lam =
@@ -318,7 +340,9 @@ let name_pattern_list default = function
 
 let rec transl_exp env e =
   match e.exp_desc with
-    Texp_ident(path, desc) ->
+    Texp_ident(path, {val_prim = Some p}) ->
+      transl_primitive p
+  | Texp_ident(path, desc) ->
       begin match path with
           Pident id -> transl_access env id
         | _ -> transl_path path
@@ -332,8 +356,8 @@ let rec transl_exp env e =
       let param = name_pattern_list "param" pat_expr_list in
       Lfunction(param, Matching.for_function e.exp_loc (Lvar param)
                          (transl_cases env (Lvar param) pat_expr_list))
-  | Texp_apply({exp_desc = Texp_ident(path, {val_prim = Some p})},
-               args) when List.length args = p.prim_arity ->
+  | Texp_apply({exp_desc = Texp_ident(path, {val_prim = Some p})}, args)
+    when List.length args = p.prim_arity ->
       Lprim(transl_prim p args, transl_list env args)
   | Texp_apply(funct, args) ->
       Lapply(transl_exp env funct, transl_list env args)
@@ -482,30 +506,6 @@ and transl_let env rec_flag pat_expr_list =
         List.map transl_case pat_expr_list in
       (env, fun e -> Lletrec(decls, e))
 
-(* Compile a primitive definition *)
-
-let transl_primitive = function
-    None -> fatal_error "Translcore.transl_primitive"
-  | Some p ->
-      let prim =
-        try
-          let (gencomp, intcomp, floatcomp, stringcomp) =
-            Hashtbl.find comparisons_table p.prim_name in
-          gencomp
-        with Not_found ->
-        try
-          Hashtbl.find primitives_table p.prim_name
-        with Not_found ->
-          Pccall p in
-      let rec add_params n params =
-        if n >= p.prim_arity
-        then Lprim(prim, List.rev params)
-        else begin
-          let id = Ident.new "prim" in
-          Lfunction(id, add_params (n+1) (Lvar id :: params))
-        end in
-      add_params 0 []
-
 (* Compile an exception definition *)
 
 let transl_exception id decl =

bytecomp/translcore.mli

@@ -22,7 +22,7 @@ val transl_exp: compilenv -> expression -> lambda
 val transl_let:
         compilenv -> rec_flag -> (pattern * expression) list ->
           compilenv * (lambda -> lambda)
-val transl_primitive: Primitive.description option -> lambda
+val transl_primitive: Primitive.description -> lambda
 val transl_exception: Ident.t -> exception_declaration -> lambda
 
 type error =

bytecomp/translmod.ml

@@ -35,9 +35,13 @@ let rec apply_coercion restr arg =
         Lfunction(param,
           apply_coercion cc_res
             (Lapply(Lvar id, [apply_coercion cc_arg (Lvar param)]))))
+  | Tcoerce_primitive p ->
+      fatal_error "Translmod.apply_coercion"
 
 and apply_coercion_field id (pos, cc) =
-  apply_coercion cc (Lprim(Pfield pos, [Lvar id]))
+  match cc with
+    Tcoerce_primitive p -> transl_primitive p
+  | _ -> apply_coercion cc (Lprim(Pfield pos, [Lvar id]))
 
 (* Compose two coercions
    apply_coercion c1 (apply_coercion c2 e) behaves like
@@ -114,8 +118,7 @@ and transl_structure env fields cc = function
       add_let(transl_structure ext_env ext_fields cc rem)
   | Tstr_primitive(id, descr) :: rem ->
       unsafe_implementation := true;
-      Llet(id, transl_primitive descr.val_prim,
-           transl_structure env (id :: fields) cc rem)
+      transl_structure env fields cc rem
   | Tstr_type(decls) :: rem ->
       transl_structure env fields cc rem
   | Tstr_exception(id, decl) :: rem ->
@@ -158,8 +161,7 @@ let transl_toplevel_item = function
       List.iter Ident.make_global idents;
       lam
   | Tstr_primitive(id, descr) ->
-      Ident.make_global id;
-      Lprim(Psetglobal id, [transl_primitive descr.val_prim])
+      lambda_unit
   | Tstr_type(decls) ->
       lambda_unit
   | Tstr_exception(id, decl) ->