diff --git a/ocs-1.0.3/src/ocs_port.ml b/ocs-1.0.3/src/ocs_port.ml index 76f3af7..a47887d 100644 --- a/ocs-1.0.3/src/ocs_port.ml +++ b/ocs-1.0.3/src/ocs_port.ml @@ -2,62 +2,58 @@ open Ocs_error -type port_impl = - | Input_channel of in_channel +type port = + | Input_channel of in_channel * char option ref | Output_channel of out_channel - | Input_string of string * int ref + | Input_string of (string * int ref) * char option ref | Output_string of Buffer.t -type port = { - ungot : char option ref; - impl : port_impl; -} - let is_input p = - match p.impl with + match p with | Input_string _ | Input_channel _ -> true | _ -> false let is_output p = - match p.impl with + match p with | Output_string _ | Output_channel _ -> true | _ -> false let getc p = - match (!(p.ungot), p.impl) with - | (Some c, _) -> - p.ungot := None; + match p with + | Input_channel (_, ({contents = Some c} as ungot)) + | Input_string (_, ({contents = Some c} as ungot)) -> + ungot := None; Some c - | (None, Input_string (str, pos)) -> - if !pos >= (String.length str) then - None - else - let c = str.[!pos] in - pos := !pos + 1; - Some c - | (None, Input_channel chan) -> + | Input_channel (chan, {contents = None}) -> begin try Some (input_char chan) with End_of_file -> None end + | Input_string ((str, pos), {contents = None}) -> + if !pos >= (String.length str) then + None + else + let c = str.[!pos] in + pos := !pos + 1; + Some c | _ -> None let flush p = - match p.impl with + match p with | Output_channel chan -> Pervasives.flush chan | _ -> () let close p = - p.ungot := None; - match p.impl with - | Input_channel chan -> + match p with + | Input_channel (chan, ungot) -> + ungot := None; close_in chan | Output_channel chan -> close_out chan @@ -65,16 +61,21 @@ let close p = () let ungetc p c = - p.ungot := Some c + match p with + | Input_channel (_, ungot) + | Input_string (_, ungot) -> + ungot := Some c + | _ -> + () let char_ready p = - match (!(p.ungot), p.impl) with - | (Some _, Input_string _) - | (Some _, Input_channel _) -> + match p with + | Input_string (_, {contents = Some _}) + | Input_channel (_, {contents = Some _}) -> true - | (None, Input_string (str, pos)) -> + | Input_string ((str, pos), {contents = None}) -> !pos < (String.length str) - | (None, Input_channel chan) -> + | Input_channel (chan, {contents = None}) -> let fd = Unix.descr_of_in_channel chan in let (r, _, _) = Unix.select [fd] [] [] 0.0 in List.length r > 0 @@ -82,7 +83,7 @@ let char_ready p = false let putc p c = - match p.impl with + match p with | Output_string buf -> Buffer.add_char buf c | Output_channel chan -> @@ -91,7 +92,7 @@ let putc p c = () let puts p s = - match p.impl with + match p with | Output_string buf -> Buffer.add_string buf s | Output_channel chan -> @@ -99,11 +100,9 @@ let puts p s = | _ -> () -let input_port ch = - { ungot = ref None; impl = Input_channel ch } +let input_port ch = Input_channel (ch, ref None) -let output_port ch = - { ungot = ref None; impl = Output_channel ch } +let output_port ch = Output_channel ch let open_input_port name = try @@ -117,14 +116,12 @@ let open_output_port name = with Sys_error err -> raise (Error ("unable to open '" ^ name ^ "' for output: " ^ err)) -let open_input_string s = - { ungot = ref None; impl = Input_string (s, ref 0) } +let open_input_string s = Input_string ((s, ref 0), ref None) -let open_output_string () = - { ungot = ref None; impl = Output_string (Buffer.create 256) } +let open_output_string () =Output_string (Buffer.create 256) let get_output_string p = - match p.impl with + match p with | Output_string buf -> Buffer.contents buf | _ ->