3 let b = Bytes.of_string
s;;
8 | Punknown
| Plinux
| Posx
| Psun
| Pfreebsd
9 | Pdragonflybsd
| Popenbsd
| Pnetbsd
| Pcygwin
12 let tempfailureretry f
a =
14 try f
a with Unix.Unix_error
(Unix.EINTR
, _
, _
) -> g ()
18 external cloexec
: Unix.file_descr
-> unit = "ml_cloexec";;
19 external hasdata
: Unix.file_descr
-> bool = "ml_hasdata";;
20 external toutf8
: int -> string = "ml_keysymtoutf8";;
21 external mbtoutf8
: string -> string = "ml_mbtoutf8";;
22 external popen
: string -> (Unix.file_descr
* int) list
-> unit = "ml_popen";;
23 external platform
: unit -> platform
= "ml_platform";;
25 let now = Unix.gettimeofday
;;
26 let platform = platform ();;
27 let dolog fmt
= Format.ksprintf prerr_endline fmt
;;
30 | Unix.Unix_error
(e
, s, a) -> Printf.sprintf
"%s(%s) : %s (%d)"
31 s a (Unix.error_message e
) (Obj.magic e
)
32 | exn
-> Printexc.to_string exn
;
35 let error fmt
= Printf.kprintf failwith fmt
;;
37 module IntSet
= Set.Make
(struct type t
= int let compare = (-) end);;
39 let emptystr s = String.length
s = 0;;
40 let nonemptystr s = String.length
s > 0;;
41 let bound v minv maxv
= max minv
(min maxv v
);;
47 let args = [|sh; "-c"; cmd
|] in
48 let rec std si so se
= function
50 | (fd
, 0) :: rest
-> std fd so se rest
52 Unix.set_close_on_exec fd
;
55 failwith
("unexpected fdn in cygwin popen " ^ string_of_int n
)
57 let si, so
, se
= std Unix.stdin
Unix.stdout
Unix.stderr fda
in
58 ignore
(Unix.create_process
sh args si so se
)
65 type t
= private string
66 val of_string
: string -> t
67 val to_string
: t
-> string
77 let (~
<) = Opaque.of_string;;
78 let (~
>) = Opaque.to_string;;
80 let int_of_string_with_suffix s =
81 let l = String.length
s in
85 let suffix = Char.lowercase
s.[l-1] in
87 | 'k'
-> String.sub
s 0 (l-1), 10
88 | 'm'
-> String.sub
s 0 (l-1), 20
89 | '
g'
-> String.sub
s 0 (l-1), 30
93 let n = int_of_string
s1 in
94 let m = n lsl shift
in
96 then raise
(Failure
"value too large")
100 let string_with_suffix_of_int n =
104 let units = [(30, "G"); (20, "M"); (10, "K")] in
107 let h = n mod 1000 in
110 then string_of_int
h ^
s
112 let s = Printf.sprintf
"_%03d%s" h s in
118 let rec find = function
120 | (shift
, suffix) :: rest
->
121 if (n land ((1 lsl shift
) - 1)) = 0
122 then prettyint (n lsr shift
) ^
suffix
128 let color_of_string s =
129 Scanf.sscanf
s "%d/%d/%d" (fun r
g b ->
130 (float r
/. 256.0, float g /. 256.0, float b /. 256.0)
134 let color_to_string (r
, g, b) =
135 let r = truncate
(r *. 256.0)
136 and g = truncate
(g *. 256.0)
137 and b = truncate
(b *. 256.0) in
138 Printf.sprintf
"%d/%d/%d" r g b
142 if Filename.is_relative path
144 let cwd = Sys.getcwd
() in
145 if Filename.is_implicit path
146 then Filename.concat
cwd path
147 else Filename.concat
cwd (Filename.basename path
)
158 type '
a t
= | Res
of '
a | Exn
of exn
;;
166 try tempfailureretry Unix.close fd
167 with exn
-> f
(exntos exn
)
171 try Res
(tempfailureretry Unix.dup fd
)
176 try Res
(tempfailureretry (Unix.dup2 fd1
) fd2
)
181 let getenvwithdef name def
=
184 with Not_found
-> def