IO.ml 4.42 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15
(* Input-output utilities. *)

16
(* ------------------------------------------------------------------------- *)
17
(* [try/finally] has the same semantics as in Java. *)
18 19 20 21 22 23 24 25 26 27 28 29

let try_finally action handler =
  let result =
    try
      action()
    with e ->
      handler();
      raise e
  in
  handler();
  result

30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
(* ------------------------------------------------------------------------- *)
(* [moving_away filename action] moves the file [filename] away (if it exists),
   performs [action], then moves the file back into place (if it was moved
   away). *)

let moving_away filename action =
  if Sys.file_exists filename then
    let newname = filename ^ ".moved_by_menhir" in
    Sys.rename filename newname;
    try_finally action (fun () ->
      Sys.rename newname filename
    )
  else
    action()

POTTIER Francois's avatar
POTTIER Francois committed
45 46 47 48 49 50 51 52 53
(* ------------------------------------------------------------------------- *)
(* [with_file filename creation action] creates the file [filename] by
   running [creation], then runs [action], and ensures that the file
   is removed in the end. *)

let with_file filename creation action =
  creation();
  try_finally action (fun () -> Sys.remove filename)

54
(* ------------------------------------------------------------------------- *)
55
(* [exhaust channel] reads all of the data that's available on [channel].
POTTIER Francois's avatar
POTTIER Francois committed
56 57
   It does not assume that the length of the data is known ahead of time.
   It does not close the channel. *)
58 59

let chunk_size =
POTTIER Francois's avatar
POTTIER Francois committed
60
  16384
61 62 63

let exhaust channel =
  let buffer = Buffer.create chunk_size in
POTTIER Francois's avatar
POTTIER Francois committed
64
  let chunk = Bytes.create chunk_size in
65 66 67 68 69
  let rec loop () =
    let length = input channel chunk 0 chunk_size in
    if length = 0 then
      Buffer.contents buffer
    else begin
POTTIER Francois's avatar
POTTIER Francois committed
70
      Buffer.add_subbytes buffer chunk 0 length;
71 72 73 74 75 76 77 78 79 80 81 82
      loop()
    end
  in
  loop()

(* ------------------------------------------------------------------------- *)
(* [invoke command] invokes an external command (which expects no
   input) and returns its output, if the command succeeds. It returns
   [None] if the command fails. *)

let invoke command =
  let ic = Unix.open_process_in command in
83 84 85
  (* 20130911 Be careful to read in text mode, so as to avoid newline
     translation problems (which would manifest themselves on Windows). *)
  set_binary_mode_in ic false;
86 87 88 89 90 91 92
  let result = exhaust ic in
  match Unix.close_process_in ic with
  | Unix.WEXITED 0 ->
      Some result
  | _ ->
      None

93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
(* ------------------------------------------------------------------------- *)
(* [read_whole_file filename] reads the file [filename] in text mode and
   returns its contents as a string. *)

let read_whole_file filename =

  (* Open the file in text mode, so that (under Windows) CRLF is converted to LF.
     This guarantees that one byte is one character and seems to be required in
     order to report accurate positions. *)

  let channel = open_in filename in

  (* The standard library functions [pos_in] and [seek_in] do not work correctly
     when CRLF conversion is being performed, so we abandon their use. (They were
     used to go and extract the text of semantic actions.) Instead we load the
     entire file into memory up front, and work with a string. *)

  (* The standard library function [in_channel_length] does not work correctly
     when CRLF conversion is being performed, so we do not use it to read the
     whole file. And the standard library function [Buffer.add_channel] uses
     [really_input] internally, so we cannot use it either. Bummer. *)

  let s = exhaust channel in
  close_in channel;
  s