Source file in_channel.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
(*                                                                        *)
(*   Copyright 2021 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

type t = in_channel

type open_flag = Stdlib.open_flag =
  | Open_rdonly
  | Open_wronly
  | Open_append
  | Open_creat
  | Open_trunc
  | Open_excl
  | Open_binary
  | Open_text
  | Open_nonblock

let stdin = Stdlib.stdin
let open_bin = Stdlib.open_in_bin
let open_text = Stdlib.open_in
let open_gen = Stdlib.open_in_gen

let with_open openfun s f =
  let ic = openfun s in
  Fun.protect ~finally:(fun () -> Stdlib.close_in_noerr ic)
    (fun () -> f ic)

let with_open_bin s f =
  with_open Stdlib.open_in_bin s f

let with_open_text s f =
  with_open Stdlib.open_in s f

let with_open_gen flags perm s f =
  with_open (Stdlib.open_in_gen flags perm) s f

let seek = Stdlib.LargeFile.seek_in
let pos = Stdlib.LargeFile.pos_in
let length = Stdlib.LargeFile.in_channel_length
let close = Stdlib.close_in
let close_noerr = Stdlib.close_in_noerr

let input_char ic =
  match Stdlib.input_char ic with
  | c -> Some c
  | exception End_of_file -> None

let input_byte ic =
  match Stdlib.input_byte ic with
  | n -> Some n
  | exception End_of_file -> None

let input_line ic =
  match Stdlib.input_line ic with
  | s -> Some s
  | exception End_of_file -> None

let input = Stdlib.input

external unsafe_input_bigarray :
  t -> _ Bigarray.Array1.t -> int -> int -> int
  = "caml_ml_input_bigarray"

let input_bigarray ic buf ofs len =
  if ofs < 0 || len < 0 || ofs > Bigarray.Array1.dim buf - len
  then invalid_arg "input_bigarray"
  else unsafe_input_bigarray ic buf ofs len

let really_input ic buf pos len =
  match Stdlib.really_input ic buf pos len with
  | () -> Some ()
  | exception End_of_file -> None

let rec unsafe_really_input_bigarray ic buf ofs len =
  if len <= 0 then Some () else begin
    let r = unsafe_input_bigarray ic buf ofs len in
    if r = 0
    then None
    else unsafe_really_input_bigarray ic buf (ofs + r) (len - r)
  end

let really_input_bigarray ic buf ofs len =
  if ofs < 0 || len < 0 || ofs > Bigarray.Array1.dim buf - len
  then invalid_arg "really_input_bigarray"
  else unsafe_really_input_bigarray ic buf ofs len

let really_input_string ic len =
  match Stdlib.really_input_string ic len with
  | s -> Some s
  | exception End_of_file -> None

(* Read up to [len] bytes into [buf], starting at [ofs]. Return total bytes
   read. *)
let read_upto ic buf ofs len =
  let rec loop ofs len =
    if len = 0 then ofs
    else begin
      let r = Stdlib.input ic buf ofs len in
      if r = 0 then
        ofs
      else
        loop (ofs + r) (len - r)
    end
  in
  loop ofs len - ofs

(* Best effort attempt to return a buffer with >= (ofs + n) bytes of storage,
   and such that it coincides with [buf] at indices < [ofs].

   The returned buffer is equal to [buf] itself if it already has sufficient
   free space.

   The returned buffer may have *fewer* than [ofs + n] bytes of storage if this
   number is > [Sys.max_string_length]. However the returned buffer will
   *always* have > [ofs] bytes of storage. In the limiting case when [ofs = len
   = Sys.max_string_length] (so that it is not possible to resize the buffer at
   all), an exception is raised. *)

let ensure buf ofs n =
  let len = Bytes.length buf in
  if len >= ofs + n then buf
  else begin
    let new_len = ref len in
    while !new_len < ofs + n do
      new_len := 2 * !new_len + 1
    done;
    let new_len = !new_len in
    let new_len =
      if new_len <= Sys.max_string_length then
        new_len
      else if ofs < Sys.max_string_length then
        Sys.max_string_length
      else
        failwith "In_channel.input_all: channel content \
                  is larger than maximum string length"
    in
    let new_buf = Bytes.create new_len in
    Bytes.blit buf 0 new_buf 0 ofs;
    new_buf
  end

let input_all ic =
  let chunk_size = 65536 in (* IO_BUFFER_SIZE *)
  let initial_size =
    try
      Stdlib.in_channel_length ic - Stdlib.pos_in ic
    with Sys_error _ ->
      -1
  in
  let initial_size = if initial_size < 0 then chunk_size else initial_size in
  let initial_size =
    if initial_size <= Sys.max_string_length then
      initial_size
    else
      Sys.max_string_length
  in
  let buf = Bytes.create initial_size in
  let nread = read_upto ic buf 0 initial_size in
  if nread < initial_size then (* EOF reached, buffer partially filled *)
    Bytes.sub_string buf 0 nread
  else begin (* nread = initial_size, maybe EOF reached *)
    match Stdlib.input_char ic with
    | exception End_of_file ->
        (* EOF reached, buffer is completely filled *)
        Bytes.unsafe_to_string buf
    | c ->
        (* EOF not reached *)
        let rec loop buf ofs =
          let buf = ensure buf ofs chunk_size in
          let rem = Bytes.length buf - ofs in
          (* [rem] can be < [chunk_size] if buffer size close to
             [Sys.max_string_length] *)
          let r = read_upto ic buf ofs rem in
          if r < rem then (* EOF reached *)
            Bytes.sub_string buf 0 (ofs + r)
          else (* r = rem *)
            loop buf (ofs + rem)
        in
        let buf = ensure buf nread (chunk_size + 1) in
        Bytes.set buf nread c;
        loop buf (nread + 1)
  end

let [@tail_mod_cons] rec input_lines ic =
  match Stdlib.input_line ic with
  | line -> line :: input_lines ic
  | exception End_of_file -> []

let rec fold_lines f accu ic =
  match Stdlib.input_line ic with
  | line -> fold_lines f (f accu line) ic
  | exception End_of_file -> accu

let set_binary_mode = Stdlib.set_binary_mode_in

external is_binary_mode : in_channel -> bool = "caml_ml_is_binary_mode"

external isatty : t -> bool = "caml_sys_isatty"