Ajout de Sys.file_exists

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

bytecomp/linker.ml

@@ -149,7 +149,7 @@ let link_bytecode objfiles exec_name copy_header =
   let tolink =
     List.fold_left scan_file [] (List.rev objfiles) in
   let outchan =
-    open_out_gen [Sys.Open_wronly; Sys.Open_trunc; Sys.Open_creat; Sys.Open_binary] 0o777 exec_name in
+    open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] 0o777 exec_name in
   try
     (* Copy the header *)
     if copy_header then begin
@@ -212,7 +212,7 @@ let link objfiles =
       or Sys.command ("strip " ^ !Clflags.exec_name) <> 0
       then raise(Error Custom_runtime);
       let oc =
-        open_out_gen [Sys.Open_wronly; Sys.Open_append; Sys.Open_binary] 0 !Clflags.exec_name in
+        open_out_gen [Open_wronly; Open_append; Open_binary] 0 !Clflags.exec_name in
       let ic = open_in_bin bytecode_name in
       copy_file ic oc;
       close_in ic;

byterun/sys.c

@@ -3,6 +3,7 @@
 #include <errno.h>
 #include <fcntl.h>
 #include <signal.h>
+#include <stdlib.h>
 #include <string.h>
 #include <unistd.h>
 #include "config.h"
@@ -88,11 +89,10 @@ value sys_open(path, flags, perm) /* ML */
   return Val_long(ret);
 }
 
-value sys_close(fd)             /* ML */
-     value fd;
+value sys_file_exists(name)     /* ML */
+     value name;
 {
-  if (close(Int_val(fd)) != 0) sys_error(NULL);
-  return Atom(0);
+  return Val_bool(access(String_val(name), F_OK) == 0);
 }
 
 value sys_remove(name)          /* ML */
@@ -119,8 +119,6 @@ value sys_chdir(dirname)        /* ML */
   return Atom(0);
 }
 
-extern char * getenv();
-
 value sys_getenv(var)           /* ML */
      value var;
 {
@@ -179,7 +177,7 @@ char * searchpath(name)
       *p++ = *q++;
     }
     *p = 0;
-    if (access(fullname, 1) == 0) return fullname;
+    if (access(fullname, F_OK) == 0) return fullname;
     if (*path == 0) return 0;
     path++;
   }

driver/compile.ml

@@ -66,7 +66,7 @@ let implementation sourcefile =
       Typemod.type_structure (initial_env()) (Parse.implementation lb) in
     if !Clflags.print_types then (Printtyp.signature sg; print_flush());
     let (coercion, crc) =
-      if file_exists (prefixname ^ ".mli") then begin
+      if Sys.file_exists (prefixname ^ ".mli") then begin
         let (dclsig, crc) =
           Env.read_signature modulename (prefixname ^ ".cmi") in
         (Includemod.signatures Env.initial sg dclsig, crc)

stdlib/.depend

@@ -3,7 +3,6 @@ format.cmi: list.cmi
 gc.cmi: 
 lexing.cmi: obj.cmi 
 parsing.cmi: lexing.cmi obj.cmi 
-pervasives.cmi: sys.cmi 
 printexc.cmi: 
 arg.cmo: arg.cmi sys.cmi string.cmi list.cmi array.cmi printf.cmi 
 array.cmo: array.cmi list.cmi array.cmi 
@@ -17,7 +16,7 @@ lexing.cmo: lexing.cmi string.cmi obj.cmi
 list.cmo: list.cmi list.cmi 
 obj.cmo: obj.cmi 
 parsing.cmo: parsing.cmi array.cmi lexing.cmi obj.cmi 
-pervasives.cmo: pervasives.cmi sys.cmi 
+pervasives.cmo: pervasives.cmi 
 printexc.cmo: printexc.cmi obj.cmi 
 printf.cmo: printf.cmi string.cmi obj.cmi 
 queue.cmo: queue.cmi 

stdlib/Makefile

@@ -29,9 +29,6 @@ pervasives.cmi: pervasives.mli
 pervasives.cmo: pervasives.ml
 	$(CAMLC) -nopervasives -c pervasives.ml
 
-sys.cmi: sys.mli
-	$(CAMLC) -nopervasives -c sys.mli
-
 .SUFFIXES: .mli .ml .cmi .cmo
 
 .mli.cmi:

stdlib/pervasives.ml

@@ -134,7 +134,12 @@ let stderr = open_descriptor_out 2
 
 (* General output functions *)
 
-open Sys
+type open_flag =
+    Open_rdonly | Open_wronly | Open_rdwr
+  | Open_append | Open_creat | Open_trunc | Open_excl
+  | Open_binary | Open_text
+
+external open_desc: string -> open_flag list -> int -> int = "sys_open"
 
 let open_out_gen mode perm name =
   open_descriptor_out(open_desc name mode perm)

stdlib/pervasives.mli

@@ -146,9 +146,15 @@ val read_int : unit -> int
 val read_float : unit -> float
 
 (* General output functions *)
+
+type open_flag =
+    Open_rdonly | Open_wronly | Open_rdwr
+  | Open_append | Open_creat | Open_trunc | Open_excl
+  | Open_binary | Open_text
+
 val open_out : string -> out_channel
 val open_out_bin : string -> out_channel
-val open_out_gen : Sys.open_flag list -> int -> string -> out_channel
+val open_out_gen : open_flag list -> int -> string -> out_channel
 val flush : out_channel -> unit = "flush"
 val output_char : out_channel -> char -> unit = "output_char"
 val output_string : out_channel -> string -> unit
@@ -165,7 +171,7 @@ val close_out : out_channel -> unit = "close_out"
 (* General input functions *)
 val open_in : string -> in_channel
 val open_in_bin : string -> in_channel
-val open_in_gen : Sys.open_flag list -> int -> string -> in_channel
+val open_in_gen : open_flag list -> int -> string -> in_channel
 val input_char : in_channel -> char = "input_char"
 val input_line : in_channel -> string
 val input : in_channel -> string -> int -> int -> int

stdlib/sys.ml

@@ -1,18 +1,12 @@
 (* System interface *)
 
-type open_flag =
-    Open_rdonly | Open_wronly | Open_rdwr
-  | Open_append | Open_creat | Open_trunc | Open_excl
-  | Open_binary | Open_text
-
 external get_argv: unit -> string array = "sys_get_argv"
 
 let argv = get_argv()
 
+external file_exists: string -> bool = "sys_file_exists"
 external remove: string -> unit = "sys_remove"
 external getenv: string -> string = "sys_getenv"
-external open_desc: string -> open_flag list -> int -> int = "sys_open"
-external close_desc: int -> unit = "sys_close"
 external command: string -> int = "sys_system_command"
 external chdir: string -> unit = "sys_chdir"
 

stdlib/sys.mli

@@ -1,15 +1,9 @@
 (* System interface *)
 
-type open_flag =
-    Open_rdonly | Open_wronly | Open_rdwr
-  | Open_append | Open_creat | Open_trunc | Open_excl
-  | Open_binary | Open_text
-
 val argv: string array
+val file_exists: string -> bool = "sys_file_exists"
 val remove: string -> unit = "sys_remove"
 val getenv: string -> string = "sys_getenv"
-val open_desc: string -> open_flag list -> int -> int = "sys_open"
-val close_desc: int -> unit = "sys_close"
 val command: string -> int = "sys_system_command"
 val chdir: string -> unit = "sys_chdir"
 

toplevel/expunge.ml

@@ -31,10 +31,10 @@ let main () =
   let header = String.create(String.length Config.exec_magic_number) in
   really_input ic header 0 (String.length Config.exec_magic_number);
   if header <> Config.exec_magic_number then begin
-    prerr_endline "Wrong Obj.magic number"; exit 2
+    prerr_endline "Wrong magic number"; exit 2
   end;
   let oc =
-    open_out_gen [Sys.Open_wronly; Sys.Open_creat; Sys.Open_trunc; Sys.Open_binary] 0o777 output_name in
+    open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777 output_name in
   (* Copy the file up to the symbol section as is *)
   seek_in ic 0;
   copy_file_chunk ic oc (pos_trailer - symbol_size - debug_size);

utils/misc.ml

@@ -22,21 +22,15 @@ let rec for_all2 pred l1 l2 =
 
 (* File functions *)
 
-let file_exists filename =
-  try
-    Sys.close_desc(Sys.open_desc filename [Sys.Open_rdonly] 0); true
-  with Sys_error msg ->
-    false
-
 let find_in_path path name =
   if Filename.is_absolute name then
-    if file_exists name then name else raise Not_found
+    if Sys.file_exists name then name else raise Not_found
   else begin
     let rec try_dir = function
       [] -> raise Not_found
     | dir::rem ->
         let fullname = Filename.concat dir name in
-        if file_exists fullname then fullname else try_dir rem
+        if Sys.file_exists fullname then fullname else try_dir rem
     in try_dir path
   end
 
@@ -49,7 +43,7 @@ let remove_file filename =
 let temp_file base suffix =
   let rec try_name counter =
     let name = "/tmp/" ^ base ^ string_of_int counter ^ suffix in
-    if file_exists name then try_name (counter + 1) else name
+    if Sys.file_exists name then try_name (counter + 1) else name
   in try_name 0
 
 (* Hashtable functions *)

utils/misc.mli

@@ -8,8 +8,6 @@ exception Fatal_error
 val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
 val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
 
-val file_exists: string -> bool
-        (* Check if the given file name List.exists. *)
 val find_in_path: string list -> string -> string
         (* Search a file in a list of directories. *)
 val remove_file: string -> unit