neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Make Ocs_port use the type system better

This commit is contained in:
Neale Pickett 2009-03-03 20:53:16 -07:00
parent 41b96164b1
commit 33d30c694d
1 changed files with 39 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
ocs-1.0.3/src/ocs_port.ml
View File

@ -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
| _ ->