ref, unref, less code that just casts handles

libs/uv/uv.ml

@@ -150,13 +150,31 @@ external fs_unlink_sync : t_loop -> string -> unit uv_result = "w_fs_unlink_sync
 external fs_utime_sync : t_loop -> string -> float -> float -> unit uv_result = "w_fs_utime_sync"
 external fs_write_sync : t_loop -> t_file -> bytes -> int -> int -> int -> int uv_result = "w_fs_write_sync_bytecode" "w_fs_write_sync"
 
+(* ------------- HANDLE --------------------------------------------- *)
+
+(* 'a should be a subtype of t_handle (uv_handle_t) *)
+external close : 'a -> unit_cb -> unit uv_result = "w_close"
+external ref_ : 'a -> unit = "w_ref"
+external unref : 'a -> unit = "w_unref"
+
 (* ------------- FILESYSTEM EVENTS ---------------------------------- *)
 
 type fs_event_cb = (string * int) uv_result -> unit
 
-external fs_event_start : t_loop -> string -> bool -> bool -> fs_event_cb -> t_fs_event uv_result = "w_fs_event_start"
+external fs_event_start : t_loop -> string -> bool -> fs_event_cb -> t_fs_event uv_result = "w_fs_event_start"
 external fs_event_stop : t_fs_event -> unit_cb -> unit uv_result = "w_fs_event_stop"
 
+(* ------------- STREAM --------------------------------------------- *)
+
+type stream_bytes_cb = bytes uv_result -> unit
+
+(* 'a should be a subtype of t_stream (uv_stream_t) *)
+external shutdown : 'a -> unit_cb -> unit uv_result = "w_shutdown"
+external listen : 'a -> int -> unit_cb -> unit uv_result = "w_listen"
+external write : 'a -> bytes -> unit_cb -> unit uv_result = "w_write"
+external read_start : 'a -> stream_bytes_cb -> unit uv_result = "w_read_start"
+external read_stop : 'a -> unit uv_result = "w_read_stop"
+
 (* ------------- TCP ------------------------------------------------ *)
 
 type uv_ip_address =
@@ -168,8 +186,6 @@ type uv_ip_address_port = {
 	port: int;
 }
 
-type stream_bytes_cb = bytes uv_result -> unit
-
 external tcp_init : t_loop -> t_tcp uv_result = "w_tcp_init"
 external tcp_nodelay : t_tcp -> bool -> unit uv_result = "w_tcp_nodelay"
 external tcp_keepalive : t_tcp -> bool -> int -> unit uv_result = "w_tcp_keepalive"
@@ -180,12 +196,6 @@ external tcp_connect_ipv4 : t_tcp -> int -> int -> unit_cb -> unit uv_result = "
 external tcp_connect_ipv6 : t_tcp -> bytes -> int -> unit_cb -> unit uv_result = "w_tcp_connect_ipv6"
 external tcp_getsockname : t_tcp -> uv_ip_address_port uv_result = "w_tcp_getsockname"
 external tcp_getpeername : t_tcp -> uv_ip_address_port uv_result = "w_tcp_getpeername"
-external tcp_shutdown : t_tcp -> unit_cb -> unit uv_result = "w_tcp_shutdown"
-external tcp_close : t_tcp -> unit_cb -> unit uv_result = "w_tcp_close"
-external tcp_listen : t_tcp -> int -> unit_cb -> unit uv_result = "w_tcp_listen"
-external tcp_write : t_tcp -> bytes -> unit_cb -> unit uv_result = "w_tcp_write"
-external tcp_read_start : t_tcp -> stream_bytes_cb -> unit uv_result = "w_tcp_read_start"
-external tcp_read_stop : t_tcp -> unit uv_result = "w_tcp_read_stop"
 
 (* ------------- UDP ------------------------------------------------ *)
 
@@ -227,7 +237,7 @@ external dns_getaddrinfo : t_loop -> string -> bool -> bool -> int -> dns_gai_cb
 
 type timer_cb = unit -> unit
 
-external timer_start : t_loop -> int -> bool -> timer_cb -> t_timer uv_result = "w_timer_start"
+external timer_start : t_loop -> int -> timer_cb -> t_timer uv_result = "w_timer_start"
 external timer_stop : t_timer -> unit_cb -> unit uv_result = "w_timer_stop"
 
 (* ------------- PROCESS -------------------------------------------- *)

libs/uv/uv_stubs.c

@@ -481,13 +481,25 @@ static void handle_close_cb(uv_handle_t *handle) {
 	CAMLreturn0;
 }
 
-static value w_close(value handle, value cb) {
+CAMLprim value w_close(value handle, value cb) {
 	CAMLparam2(handle, cb);
 	((uv_w_handle_t *)UV_HANDLE_DATA(Handle_val(handle)))->cb_close = cb;
 	uv_close(Handle_val(handle), handle_close_cb);
 	UV_SUCCESS_UNIT;
 }
 
+CAMLprim value w_ref(value handle) {
+	CAMLparam1(handle);
+	uv_ref(Handle_val(handle));
+	CAMLreturn(Val_unit);
+}
+
+CAMLprim value w_unref(value handle) {
+	CAMLparam1(handle);
+	uv_unref(Handle_val(handle));
+	CAMLreturn(Val_unit);
+}
+
 // ------------- FILESYSTEM EVENTS ----------------------------------
 
 static void handle_fs_event_cb(uv_fs_event_t *handle, const char *filename, int events, int status) {
@@ -508,7 +520,7 @@ static void handle_fs_event_cb(uv_fs_event_t *handle, const char *filename, int
 	CAMLreturn0;
 }
 
-CAMLprim value w_fs_event_start(value loop, value path, value persistent, value recursive, value cb) {
+CAMLprim value w_fs_event_start(value loop, value path, value recursive, value cb) {
 	CAMLparam4(loop, path, recursive, cb);
 	UV_ALLOC_CHECK(handle, uv_fs_event_t);
 	UV_ERROR_CHECK_C(uv_fs_event_init(Loop_val(loop), FsEvent_val(handle)), free(FsEvent_val(handle)));
@@ -519,8 +531,6 @@ CAMLprim value w_fs_event_start(value loop, value path, value persistent, value
 		uv_fs_event_start(FsEvent_val(handle), handle_fs_event_cb, String_val(path), Bool_val(recursive) ? UV_FS_EVENT_RECURSIVE : 0),
 		{ unalloc_data(UV_HANDLE_DATA(FsEvent_val(handle))); free(FsEvent_val(handle)); }
 		);
-	if (!Bool_val(persistent))
-		uv_unref(Handle_val(handle));
 	UV_SUCCESS(handle);
 }
 
@@ -599,7 +609,7 @@ static void handle_stream_cb_read(uv_stream_t *stream, long int nread, const uv_
 	CAMLreturn0;
 }
 
-static value w_shutdown(value stream, value cb) {
+CAMLprim value w_shutdown(value stream, value cb) {
 	CAMLparam2(stream, cb);
 	UV_ALLOC_CHECK(req, uv_shutdown_t);
 	UV_REQ_DATA(Shutdown_val(req)) = (void *)cb;
@@ -608,14 +618,14 @@ static value w_shutdown(value stream, value cb) {
 	UV_SUCCESS_UNIT;
 }
 
-static value w_listen(value stream, value backlog, value cb) {
+CAMLprim value w_listen(value stream, value backlog, value cb) {
 	CAMLparam3(stream, backlog, cb);
 	UV_HANDLE_DATA_SUB(Stream_val(stream), stream).cb_connection = cb;
 	UV_ERROR_CHECK(uv_listen(Stream_val(stream), Int_val(backlog), handle_stream_cb_connection));
 	UV_SUCCESS_UNIT;
 }
 
-static value w_write(value stream, value data, value cb) {
+CAMLprim value w_write(value stream, value data, value cb) {
 	CAMLparam3(stream, data, cb);
 	UV_ALLOC_CHECK(req, uv_write_t);
 	UV_REQ_DATA(Write_val(req)) = (void *)cb;
@@ -625,14 +635,14 @@ static value w_write(value stream, value data, value cb) {
 	UV_SUCCESS_UNIT;
 }
 
-static value w_read_start(value stream, value cb) {
+CAMLprim value w_read_start(value stream, value cb) {
 	CAMLparam2(stream, cb);
 	UV_HANDLE_DATA_SUB(Stream_val(stream), stream).cb_read = cb;
 	UV_ERROR_CHECK(uv_read_start(Stream_val(stream), handle_stream_cb_alloc, handle_stream_cb_read));
 	UV_SUCCESS_UNIT;
 }
 
-static value w_read_stop(value stream) {
+CAMLprim value w_read_stop(value stream) {
 	CAMLparam1(stream);
 	UV_ERROR_CHECK(uv_read_stop(Stream_val(stream)));
 	UV_SUCCESS_UNIT;
@@ -758,30 +768,6 @@ CAMLprim value w_tcp_getpeername(value handle) {
 	CAMLreturn(w_getname(&storage));
 }
 
-CAMLprim value w_tcp_shutdown(value handle, value cb) {
-	return w_shutdown(handle, cb);
-}
-
-CAMLprim value w_tcp_close(value handle, value cb) {
-	return w_close(handle, cb);
-}
-
-CAMLprim value w_tcp_listen(value handle, value backlog, value cb) {
-	return w_listen(handle, backlog, cb);
-}
-
-CAMLprim value w_tcp_write(value handle, value data, value cb) {
-	return w_write(handle, data, cb);
-}
-
-CAMLprim value w_tcp_read_start(value handle, value cb) {
-	return w_read_start(handle, cb);
-}
-
-CAMLprim value w_tcp_read_stop(value handle) {
-	return w_read_stop(handle);
-}
-
 // ------------- UDP ------------------------------------------------
 
 static void handle_udp_cb_recv(uv_udp_t *handle, long int nread, const uv_buf_t *buf, const struct sockaddr *addr, unsigned int flags) {
@@ -1047,8 +1033,8 @@ static void handle_timer_cb(uv_timer_t *handle) {
 	CAMLreturn0;
 }
 
-CAMLprim value w_timer_start(value loop, value timeout, value persistent, value cb) {
-	CAMLparam4(loop, timeout, persistent, cb);
+CAMLprim value w_timer_start(value loop, value timeout, value cb) {
+	CAMLparam3(loop, timeout, cb);
 	UV_ALLOC_CHECK(handle, uv_timer_t);
 	UV_ERROR_CHECK_C(uv_timer_init(Loop_val(loop), Timer_val(handle)), free(Timer_val(handle)));
 	UV_HANDLE_DATA(Timer_val(handle)) = alloc_data_timer(cb);
@@ -1058,8 +1044,6 @@ CAMLprim value w_timer_start(value loop, value timeout, value persistent, value
 		uv_timer_start(Timer_val(handle), handle_timer_cb, Int_val(timeout), Int_val(timeout)),
 		{ unalloc_data(UV_HANDLE_DATA(Timer_val(handle))); free(Timer_val(handle)); }
 		);
-	if (!Bool_val(persistent))
-		uv_unref(Handle_val(handle));
 	UV_SUCCESS(handle);
 }
 

src/macro/eval/evalHash.ml

@@ -154,3 +154,4 @@ let key_nusys_net_Address = hash "nusys.net.Address"
 let key_nusys_net_SocketAddress = hash "nusys.net.SocketAddress"
 let key_eval_uv_Timer = hash "eval.uv.Timer"
 let key_eval_uv_Process = hash "eval.uv.Process"
+let key_sys_FileWatcherEvent = hash "sys.FileWatcherEvent"

src/macro/eval/evalStdLib.ml

@@ -3094,6 +3094,17 @@ module StdUv = struct
 			| Uv.UvSuccess v -> call_value cb [vnull; enc v])
 	)
 
+	let wrap_ref this = vifun0 (fun vthis ->
+		let this = this vthis in
+		Uv.ref_ this;
+		vnull
+	)
+	let wrap_unref this = vifun0 (fun vthis ->
+		let this = this vthis in
+		Uv.unref this;
+		vnull
+	)
+
 	module DirectoryEntry = struct
 		let this vthis = match vthis with
 			| VInstance {ikind = IUv (UvDirent e)} -> e
@@ -3112,11 +3123,27 @@ module StdUv = struct
 		let this vthis = match vthis with
 			| VInstance {ikind = IUv (UvFsEvent e)} -> e
 			| v -> unexpected_value v "UvFsEvent"
+		let new_ = (fun vl ->
+			match vl with
+				| [path; recursive; cb] ->
+					let path = decode_string path in
+					let recursive = decode_bool recursive in
+					let handle = wrap_sync (Uv.fs_event_start (loop ()) path recursive (wrap_cb cb (fun (path, event) ->
+							if event > 3 then
+								assert false;
+							(* event: 1 = Rename, 2 = Change, 3 = Rename + Change *)
+							encode_enum_value key_sys_FileWatcherEvent (event - 1) [|encode_string path|] None
+						))) in
+					encode_instance key_eval_uv_FileWatcher ~kind:(IUv (UvFsEvent handle))
+				| _ -> assert false
+		)
 		let close = vifun1 (fun vthis cb ->
 			let this = this vthis in
 			wrap_sync (Uv.fs_event_stop this (wrap_cb_unit cb));
 			vnull
 		)
+		let ref_ = wrap_ref this
+		let unref = wrap_unref this
 	end
 
 	module Stat = struct
@@ -3414,17 +3441,6 @@ module StdUv = struct
 			wrap_sync (Uv.fs_utime_sync (loop ()) path atime mtime);
 			vnull
 		)
-		let watch_native = vfun4 (fun path persistent recursive cb ->
-			let path = decode_string path in
-			let persistent = default_bool persistent true in
-			let recursive = default_bool recursive false in
-			let handle = wrap_sync (Uv.fs_event_start (loop ()) path persistent recursive (fun res ->
-				ignore (match res with
-					| Uv.UvError err -> call_value cb [wrap_error err; vnull; vnull]
-					| Uv.UvSuccess (path, event) -> call_value cb [vnull; encode_string path; vint event])
-				)) in
-			encode_instance key_eval_uv_FileWatcher ~kind:(IUv (UvFsEvent handle))
-		)
 	end
 
 	module AsyncFileSystem = struct
@@ -3463,7 +3479,7 @@ module StdUv = struct
 		let listen = vifun2 (fun vthis backlog cb ->
 			let this = this vthis in
 			let backlog = decode_int backlog in
-			wrap_sync (Uv.tcp_listen this backlog (wrap_cb_unit cb));
+			wrap_sync (Uv.listen this backlog (wrap_cb_unit cb));
 			vnull;
 		)
 		let accept = vifun0 (fun vthis ->
@@ -3502,31 +3518,31 @@ module StdUv = struct
 		let write = vifun2 (fun vthis data cb ->
 			let this = this vthis in
 			let data = decode_bytes data in
-			wrap_sync (Uv.tcp_write this data (wrap_cb_unit cb));
+			wrap_sync (Uv.write this data (wrap_cb_unit cb));
 			vnull
 		)
 		let startRead = vifun1 (fun vthis cb ->
 			let this = this vthis in
-			wrap_sync (Uv.tcp_read_start this (wrap_cb cb encode_bytes));
+			wrap_sync (Uv.read_start this (wrap_cb cb encode_bytes));
 			vnull
 		)
 		let stopRead = vifun0 (fun vthis ->
 			let this = this vthis in
-			wrap_sync (Uv.tcp_read_stop this);
+			wrap_sync (Uv.read_stop this);
 			vnull
 		)
 		let end_ = vifun1 (fun vthis cb ->
 			let this = this vthis in
-			wrap_sync (Uv.tcp_shutdown this (fun res ->
+			wrap_sync (Uv.shutdown this (fun res ->
 				match res with
 					| Uv.UvError err -> ignore (call_value cb [wrap_error err; vnull])
-					| Uv.UvSuccess () -> wrap_sync (Uv.tcp_close this (wrap_cb_unit cb))
+					| Uv.UvSuccess () -> wrap_sync (Uv.close this (wrap_cb_unit cb))
 				));
 			vnull
 		)
 		let close = vifun1 (fun vthis cb ->
 			let this = this vthis in
-			wrap_sync (Uv.tcp_close this (wrap_cb_unit cb));
+			wrap_sync (Uv.close this (wrap_cb_unit cb));
 			vnull
 		)
 		let setKeepAlive = vifun2 (fun vthis enable initialDelay ->
@@ -3553,6 +3569,8 @@ module StdUv = struct
 		)
 		let getSockName = getName Uv.tcp_getsockname
 		let getPeerName = getName Uv.tcp_getpeername
+		let ref_ = wrap_ref this
+		let unref = wrap_unref this
 	end
 
 	module UdpSocket = struct
@@ -3737,11 +3755,10 @@ module StdUv = struct
 			| v -> unexpected_value v "UvTimer"
 		let new_ = (fun vl ->
 			match vl with
-				| [timeMs; persistent; cb] ->
+				| [timeMs; cb] ->
 					let timeMs = decode_int timeMs in
-					let persistent = decode_bool persistent in
-					let handle = wrap_sync (Uv.timer_start (loop ()) timeMs persistent (fun () ->
-						ignore (call_value cb [])
+					let handle = wrap_sync (Uv.timer_start (loop ()) timeMs (fun () ->
+							ignore (call_value cb [])
 						)) in
 					encode_instance key_eval_uv_Timer ~kind:(IUv (UvTimer handle))
 				| _ -> assert false
@@ -3751,6 +3768,8 @@ module StdUv = struct
 			wrap_sync (Uv.timer_stop this (wrap_cb_unit cb));
 			vnull
 		)
+		let ref_ = wrap_ref this
+		let unref = wrap_unref this
 	end
 
 	module Process = struct
@@ -3792,6 +3811,8 @@ module StdUv = struct
 			let this = this vthis in
 			vint (Uv.process_get_pid this)
 		)
+		let ref_ = wrap_ref this
+		let unref = wrap_unref this
 	end
 
 	let init = vfun0 (fun () ->
@@ -3980,6 +4001,7 @@ let init_constructors builtins =
 		(fun _ ->
 			encode_instance key_sys_net_Deque ~kind:(IDeque (Deque.create()))
 		);
+	add key_eval_uv_FileWatcher StdUv.FileWatcher.new_;
 	add key_eval_uv_Socket StdUv.Socket.new_;
 	add key_eval_uv_UdpSocket StdUv.UdpSocket.new_;
 	add key_eval_uv_Timer StdUv.Timer.new_;
@@ -4441,7 +4463,6 @@ let init_standard_library builtins =
 		"symlink",StdUv.FileSystem.symlink;
 		"unlink",StdUv.FileSystem.unlink;
 		"utimes_native",StdUv.FileSystem.utimes_native;
-		"watch_native",StdUv.FileSystem.watch_native;
 	] [];
 	init_fields builtins (["nusys";"async"],"FileSystem") [
 		"access",StdUv.AsyncFileSystem.access;
@@ -4479,6 +4500,8 @@ let init_standard_library builtins =
 	];
 	init_fields builtins (["eval";"uv"],"FileWatcher") [] [
 		"close",StdUv.FileWatcher.close;
+		"ref",StdUv.FileWatcher.ref_;
+		"unref",StdUv.FileWatcher.unref;
 	];
 	init_fields builtins (["eval";"uv"],"Stat") [] [
 		"get_dev",StdUv.Stat.get_dev;
@@ -4508,6 +4531,8 @@ let init_standard_library builtins =
 		"setNoDelay",StdUv.Socket.setNoDelay;
 		"getSockName",StdUv.Socket.getSockName;
 		"getPeerName",StdUv.Socket.getPeerName;
+		"ref",StdUv.Socket.ref_;
+		"unref",StdUv.Socket.unref;
 	];
 	init_fields builtins (["eval";"uv"],"UdpSocket") [] [
 		"addMembership",StdUv.UdpSocket.addMembership;
@@ -4534,8 +4559,12 @@ let init_standard_library builtins =
 	] [];
 	init_fields builtins (["eval";"uv"],"Timer") [] [
 		"close",StdUv.Timer.close;
+		"ref",StdUv.Timer.ref_;
+		"unref",StdUv.Timer.unref;
 	];
 	init_fields builtins (["eval";"uv"],"Process") [] [
 		"kill",StdUv.Process.kill;
 		"getPid",StdUv.Process.getPid;
+		"ref",StdUv.Process.ref_;
+		"unref",StdUv.Process.unref;
 	]