3 let b = Bytes.of_string
s;;
7 type platform
= | Punknown
| Plinux
| Posx
| Psun
| Pbsd
| Pcygwin
;;
9 let tempfailureretry f
a =
11 try f
a with Unix.Unix_error
(Unix.EINTR
, _
, _
) -> g ()
15 external cloexec
: Unix.file_descr
-> unit = "ml_cloexec";;
16 external hasdata
: Unix.file_descr
-> bool = "ml_hasdata";;
17 external toutf8
: int -> string = "ml_keysymtoutf8";;
18 external mbtoutf8
: string -> string = "ml_mbtoutf8";;
19 external popen
: string -> (Unix.file_descr
* int) list
-> unit = "ml_popen";;
20 external platform
: unit -> (platform
* string array
) = "ml_platform";;
22 let now = Unix.gettimeofday
;;
23 let platform, uname
= platform ();;
24 let dolog fmt
= Format.ksprintf prerr_endline fmt
;;
27 | Unix.Unix_error
(e
, s, a) -> Printf.sprintf
"%s(%s) : %s (%d)"
28 s a (Unix.error_message e
) (Obj.magic e
)
29 | exn
-> Printexc.to_string exn
;
32 let error fmt
= Printf.kprintf failwith fmt
;;
34 module IntSet
= Set.Make
(struct type t
= int let compare = (-) end);;
36 let emptystr s = String.length
s = 0;;
37 let nonemptystr s = String.length
s > 0;;
38 let bound v minv maxv
= max minv
(min maxv v
);;
44 let args = [|sh; "-c"; cmd
|] in
45 let rec std si so se
= function
47 | (fd
, 0) :: rest
-> std fd so se rest
49 Unix.set_close_on_exec fd
;
52 failwith
("unexpected fdn in cygwin popen " ^ string_of_int n
)
54 let si, so
, se
= std Unix.stdin
Unix.stdout
Unix.stderr fda
in
55 ignore
(Unix.create_process
sh args si so se
)
62 type t
= private string
63 val of_string
: string -> t
64 val to_string
: t
-> string
74 let (~
<) = Opaque.of_string;;
75 let (~
>) = Opaque.to_string;;
77 let int_of_string_with_suffix s =
78 let l = String.length
s in
82 let suffix = Char.lowercase
s.[l-1] in
84 | 'k'
-> String.sub
s 0 (l-1), 10
85 | 'm'
-> String.sub
s 0 (l-1), 20
86 | '
g'
-> String.sub
s 0 (l-1), 30
90 let n = int_of_string
s1 in
91 let m = n lsl shift
in
93 then raise
(Failure
"value too large")
97 let string_with_suffix_of_int n =
101 let units = [(30, "G"); (20, "M"); (10, "K")] in
104 let h = n mod 1000 in
107 then string_of_int
h ^
s
109 let s = Printf.sprintf
"_%03d%s" h s in
115 let rec find = function
117 | (shift
, suffix) :: rest
->
118 if (n land ((1 lsl shift
) - 1)) = 0
119 then prettyint (n lsr shift
) ^
suffix
125 let color_of_string s =
126 Scanf.sscanf
s "%d/%d/%d" (fun r
g b ->
127 (float r
/. 256.0, float g /. 256.0, float b /. 256.0)
131 let color_to_string (r
, g, b) =
132 let r = truncate
(r *. 256.0)
133 and g = truncate
(g *. 256.0)
134 and b = truncate
(b *. 256.0) in
135 Printf.sprintf
"%d/%d/%d" r g b
139 if Filename.is_relative path
141 let cwd = Sys.getcwd
() in
142 if Filename.is_implicit path
143 then Filename.concat
cwd path
144 else Filename.concat
cwd (Filename.basename path
)
156 try tempfailureretry Unix.close fd
157 with exn
-> f
(exntos exn
)
161 let getenvwithdef name def
=
162 match Sys.getenv name
with
164 | exception Not_found
-> def