5
Jane Street Holding, LLC
7
email: mmottl\@janestcapital.com
8
WWW: http://www.janestcapital.com/ocaml
10
This library is free software; you can redistribute it and/or
11
modify it under the terms of the GNU Lesser General Public
12
License as published by the Free Software Foundation; either
13
version 2 of the License, or (at your option) any later version.
15
This library is distributed in the hope that it will be useful,
16
but WITHOUT ANY WARRANTY; without even the implied warranty of
17
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18
Lesser General Public License for more details.
20
You should have received a copy of the GNU Lesser General Public
21
License along with this library; if not, write to the Free Software
22
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25
(* Read_c: wrapping unsafe C-style readers to safe ML-style ones. *)
33
let handle_error buf sptr_ptr read_err =
34
let err_pos = dealloc_sptr_ptr buf sptr_ptr in
37
| ReadError.Variant _ -> err_pos - 4
40
raise_read_error read_err err_pos
42
let handle_exc buf sptr_ptr exc =
43
ignore (dealloc_sptr_ptr buf sptr_ptr);
46
let at_end buf sptr_ptr pos_ref el =
47
let pos = dealloc_sptr_ptr buf sptr_ptr in
51
let make read_c buf ~pos_ref =
52
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
54
try read_c sptr_ptr eptr with
55
| Error read_err -> handle_error buf sptr_ptr read_err
56
| exc -> handle_exc buf sptr_ptr exc
58
at_end buf sptr_ptr pos_ref el
60
let unmake read_ml buf sptr_ptr _eptr =
61
let start_pos = get_sptr_ptr sptr_ptr buf in
62
let pos_ref = ref start_pos in
63
let el = read_ml buf ~pos_ref in
64
set_sptr_ptr sptr_ptr buf ~pos:!pos_ref;
67
let make1 read_c read_ml_el buf ~pos_ref =
68
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
69
let read_c_el = unmake read_ml_el buf in
71
try read_c read_c_el sptr_ptr eptr with
72
| Error read_err -> handle_error buf sptr_ptr read_err
73
| exc -> handle_exc buf sptr_ptr exc
75
at_end buf sptr_ptr pos_ref el
77
let make2 read_c read_ml_el1 read_ml_el2 buf ~pos_ref =
78
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
79
let read_c_el1 = unmake read_ml_el1 buf in
80
let read_c_el2 = unmake read_ml_el2 buf in
82
try read_c read_c_el1 read_c_el2 sptr_ptr eptr with
83
| Error read_err -> handle_error buf sptr_ptr read_err
84
| exc -> handle_exc buf sptr_ptr exc
86
at_end buf sptr_ptr pos_ref el
88
let make3 read_c read_ml_el1 read_ml_el2 read_ml_el3 buf ~pos_ref =
89
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
90
let read_c_el1 = unmake read_ml_el1 buf in
91
let read_c_el2 = unmake read_ml_el2 buf in
92
let read_c_el3 = unmake read_ml_el3 buf in
94
try read_c read_c_el1 read_c_el2 read_c_el3 sptr_ptr eptr with
95
| Error read_err -> handle_error buf sptr_ptr read_err
96
| exc -> handle_exc buf sptr_ptr exc
98
at_end buf sptr_ptr pos_ref el
100
let bin_read_unit = make Unsafe_read_c.bin_read_unit
101
let bin_read_bool = make Unsafe_read_c.bin_read_bool
102
let bin_read_string = make Unsafe_read_c.bin_read_string
103
let bin_read_char = make Unsafe_read_c.bin_read_char
104
let bin_read_int = make Unsafe_read_c.bin_read_int
105
let bin_read_float = make Unsafe_read_c.bin_read_float
106
let bin_read_int32 = make Unsafe_read_c.bin_read_int32
107
let bin_read_int64 = make Unsafe_read_c.bin_read_int64
108
let bin_read_nativeint = make Unsafe_read_c.bin_read_nativeint
109
let bin_read_nat0 = make Unsafe_read_c.bin_read_nat0
110
let bin_read_ref mlw = make1 Unsafe_read_c.bin_read_ref mlw
111
let bin_read_lazy mlw = make1 Unsafe_read_c.bin_read_lazy mlw
112
let bin_read_option mlw = make1 Unsafe_read_c.bin_read_option mlw
113
let bin_read_pair mlw = make2 Unsafe_read_c.bin_read_pair mlw
114
let bin_read_triple mlw = make3 Unsafe_read_c.bin_read_triple mlw
115
let bin_read_list mlw = make1 Unsafe_read_c.bin_read_list mlw
116
let bin_read_array mlw = make1 Unsafe_read_c.bin_read_array mlw
117
let bin_read_hashtbl mlw = make2 Unsafe_read_c.bin_read_hashtbl mlw
118
let bin_read_float32_vec = make Unsafe_read_c.bin_read_float32_vec
119
let bin_read_float64_vec = make Unsafe_read_c.bin_read_float64_vec
120
let bin_read_vec = make Unsafe_read_c.bin_read_vec
121
let bin_read_float32_mat = make Unsafe_read_c.bin_read_float32_mat
122
let bin_read_float64_mat = make Unsafe_read_c.bin_read_float64_mat
123
let bin_read_mat = make Unsafe_read_c.bin_read_mat
124
let bin_read_bigstring = make Unsafe_read_c.bin_read_bigstring
125
let bin_read_float_array = make Unsafe_read_c.bin_read_float_array
126
let bin_read_variant_int el = make Unsafe_read_c.bin_read_variant_int el
127
let bin_read_variant_tag el = make Unsafe_read_c.bin_read_variant_tag el
added
removed
lib/read_c.ml
