async file operations

libs/uv/uv.ml

@@ -92,34 +92,34 @@ type fs_cb_int = int uv_result -> unit
 type fs_cb_stat= t_stat uv_result -> unit
 type fs_cb_scandir = (string * int) list uv_result -> unit
 
-external fs_access : t_loop -> string -> int -> unit_cb -> unit = "w_fs_access"
-external fs_chmod : t_loop -> string -> int -> unit_cb -> unit = "w_fs_chmod"
-external fs_chown : t_loop -> string -> int -> int -> unit_cb -> unit = "w_fs_chown"
-external fs_close : t_loop -> t_file -> unit_cb -> unit = "w_fs_close"
-external fs_fchmod : t_loop -> t_file -> int -> unit_cb -> unit = "w_fs_fchmod"
-external fs_fchown : t_loop -> t_file -> int -> int -> unit_cb -> unit = "w_fs_fchown"
-external fs_fdatasync : t_loop -> t_file -> unit_cb -> unit = "w_fs_fdatasync"
-external fs_fstat : t_loop -> t_file -> fs_cb_stat -> unit = "w_fs_fstat"
-external fs_fsync : t_loop -> t_file -> unit_cb -> unit = "w_fs_fsync"
-external fs_ftruncate : t_loop -> t_file -> int64 -> unit_cb -> unit = "w_fs_ftruncate"
-external fs_futime : t_loop -> t_file -> float -> float -> unit_cb -> unit = "w_fs_futime"
-external fs_link : t_loop -> string -> string -> unit_cb -> unit = "w_fs_link"
-external fs_lstat : t_loop -> string -> fs_cb_stat -> unit = "w_fs_lstat"
-external fs_mkdir : t_loop -> string -> int -> unit_cb -> unit = "w_fs_mkdir"
-external fs_mkdtemp : t_loop -> string -> fs_cb_path -> unit = "w_fs_mkdtemp"
-external fs_open : t_loop -> string -> int -> int -> fs_cb_file -> unit = "w_fs_open"
-external fs_read : t_loop -> t_file -> bytes -> int -> int -> int -> fs_cb_int -> unit = "w_fs_read_bytecode" "w_fs_read"
-external fs_readlink : t_loop -> string -> fs_cb_bytes -> unit = "w_fs_readlink"
-external fs_realpath : t_loop -> string -> fs_cb_bytes -> unit = "w_fs_realpath"
-external fs_rename : t_loop -> string -> string -> unit_cb -> unit = "w_fs_rename"
-external fs_rmdir : t_loop -> string -> unit_cb -> unit = "w_fs_rmdir"
-external fs_scandir : t_loop -> string -> int -> fs_cb_scandir -> unit = "w_fs_scandir"
-external fs_sendfile : t_loop -> t_file -> t_file -> int -> int -> unit_cb -> unit = "w_fs_sendfile_bytecode" "w_fs_sendfile"
-external fs_stat : t_loop -> string -> fs_cb_stat -> unit = "w_fs_stat"
-external fs_symlink : t_loop -> string -> string -> int -> unit_cb -> unit = "w_fs_symlink"
-external fs_unlink : t_loop -> string -> unit_cb -> unit = "w_fs_unlink"
-external fs_utime : t_loop -> string -> float -> float -> unit_cb -> unit = "w_fs_utime"
-external fs_write : t_loop -> t_file -> bytes -> int -> int -> int -> fs_cb_int -> unit = "w_fs_write_bytecode" "w_fs_write"
+external fs_access : t_loop -> string -> int -> unit_cb -> unit uv_result = "w_fs_access"
+external fs_chmod : t_loop -> string -> int -> unit_cb -> unit uv_result = "w_fs_chmod"
+external fs_chown : t_loop -> string -> int -> int -> unit_cb -> unit uv_result = "w_fs_chown"
+external fs_close : t_loop -> t_file -> unit_cb -> unit uv_result = "w_fs_close"
+external fs_fchmod : t_loop -> t_file -> int -> unit_cb -> unit uv_result = "w_fs_fchmod"
+external fs_fchown : t_loop -> t_file -> int -> int -> unit_cb -> unit uv_result = "w_fs_fchown"
+external fs_fdatasync : t_loop -> t_file -> unit_cb -> unit uv_result = "w_fs_fdatasync"
+external fs_fstat : t_loop -> t_file -> fs_cb_stat -> unit uv_result = "w_fs_fstat"
+external fs_fsync : t_loop -> t_file -> unit_cb -> unit uv_result = "w_fs_fsync"
+external fs_ftruncate : t_loop -> t_file -> int64 -> unit_cb -> unit uv_result = "w_fs_ftruncate"
+external fs_futime : t_loop -> t_file -> float -> float -> unit_cb -> unit uv_result = "w_fs_futime"
+external fs_link : t_loop -> string -> string -> unit_cb -> unit uv_result = "w_fs_link"
+external fs_lstat : t_loop -> string -> fs_cb_stat -> unit uv_result = "w_fs_lstat"
+external fs_mkdir : t_loop -> string -> int -> unit_cb -> unit uv_result = "w_fs_mkdir"
+external fs_mkdtemp : t_loop -> string -> fs_cb_path -> unit uv_result = "w_fs_mkdtemp"
+external fs_open : t_loop -> string -> int -> int -> fs_cb_file -> unit uv_result = "w_fs_open"
+external fs_read : t_loop -> t_file -> bytes -> int -> int -> int -> fs_cb_int -> unit uv_result = "w_fs_read_bytecode" "w_fs_read"
+external fs_readlink : t_loop -> string -> fs_cb_bytes -> unit uv_result = "w_fs_readlink"
+external fs_realpath : t_loop -> string -> fs_cb_bytes -> unit uv_result = "w_fs_realpath"
+external fs_rename : t_loop -> string -> string -> unit_cb -> unit uv_result = "w_fs_rename"
+external fs_rmdir : t_loop -> string -> unit_cb -> unit uv_result = "w_fs_rmdir"
+external fs_scandir : t_loop -> string -> int -> fs_cb_scandir -> unit uv_result = "w_fs_scandir"
+external fs_sendfile : t_loop -> t_file -> t_file -> int -> int -> unit_cb -> unit uv_result = "w_fs_sendfile_bytecode" "w_fs_sendfile"
+external fs_stat : t_loop -> string -> fs_cb_stat -> unit uv_result = "w_fs_stat"
+external fs_symlink : t_loop -> string -> string -> int -> unit_cb -> unit uv_result = "w_fs_symlink"
+external fs_unlink : t_loop -> string -> unit_cb -> unit uv_result = "w_fs_unlink"
+external fs_utime : t_loop -> string -> float -> float -> unit_cb -> unit uv_result = "w_fs_utime"
+external fs_write : t_loop -> t_file -> bytes -> int -> int -> int -> fs_cb_int -> unit uv_result = "w_fs_write_bytecode" "w_fs_write"
 
 external fs_access_sync : t_loop -> string -> int -> unit uv_result = "w_fs_access_sync"
 external fs_chmod_sync : t_loop -> string -> int -> unit uv_result = "w_fs_chmod_sync"

src/macro/eval/evalEncode.ml

@@ -63,12 +63,23 @@ let vifun4 f = vfunction (fun vl -> match vl with
 	| [v0;v1;v2] -> f v0 v1 v2 vnull vnull
 	| [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull
 	| [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4
-	| _ -> invalid_call_arg_number 4 (List.length  vl
+	| _ -> invalid_call_arg_number 5 (List.length  vl
+))
+
+let vifun5 f = vfunction (fun vl -> match vl with
+	| [] -> f vnull vnull vnull vnull vnull vnull
+	| [v0] -> f v0 vnull vnull vnull vnull vnull
+	| [v0;v1] -> f v0 v1 vnull vnull vnull vnull
+	| [v0;v1;v2] -> f v0 v1 v2 vnull vnull vnull
+	| [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull vnull
+	| [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4 vnull
+	| [v0;v1;v2;v3;v4;v5] -> f v0 v1 v2 v3 v4 v5
+	| _ -> invalid_call_arg_number 6 (List.length  vl
 ))
 
 let vfun0 f = vstatic_function (fun vl -> match vl with
 	| [] -> f ()
-	| _ -> invalid_call_arg_number 1 (List.length  vl
+	| _ -> invalid_call_arg_number 0 (List.length  vl
 ))
 
 let vfun1 f = vstatic_function (fun vl -> match vl with
@@ -108,7 +119,7 @@ let vfun5 f = vstatic_function (fun vl -> match vl with
 	| [v0;v1;v2] -> f v0 v1 v2 vnull vnull
 	| [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull
 	| [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4
-	| _ -> invalid_call_arg_number 4 (List.length  vl
+	| _ -> invalid_call_arg_number 5 (List.length  vl
 ))
 
 (* Objects *)

src/macro/eval/evalHash.ml

@@ -142,6 +142,7 @@ let key_eval_uv_FileWatcher = hash "eval.uv.FileWatcher"
 let key_eval_uv_Loop = hash "eval.uv.Loop"
 let key_eval_uv_Stat = hash "eval.uv.Stat"
 let key_nusys_io_File = hash "nusys.io.File"
+let key_nusys_io_AsyncFile = hash "nusys.io.AsyncFile"
 let key_eval_uv_Socket = hash "eval.uv.Socket"
 let key_nusys_net_Dns = hash "nusys.net.Dns"
 let key_sys_net_Address = hash "sys.net.Address"

src/macro/eval/evalStdLib.ml

@@ -3145,6 +3145,10 @@ module StdUv = struct
 		let this vthis = match vthis with
 			| VInstance {ikind = IUv (UvFile f)} -> f
 			| v -> unexpected_value v "UVFile"
+		let get_async = vifun0 (fun vthis ->
+			let this = this vthis in
+			encode_instance key_nusys_io_AsyncFile ~kind:(IUv (UvFile this))
+		)
 		let chmod = vifun1 (fun vthis mode ->
 			let this = this vthis in
 			let mode = decode_int mode in
@@ -3215,6 +3219,86 @@ module StdUv = struct
 		)
 	end
 
+	module AsyncFile = struct
+		let this vthis = match vthis with
+			| VInstance {ikind = IUv (UvFile f)} -> f
+			| v -> unexpected_value v "UVFile"
+		let chmod = vifun2 (fun vthis mode cb ->
+			let this = this vthis in
+			let mode = decode_int mode in
+			wrap_sync (Uv.fs_fchmod (loop ()) this mode (wrap_cb_unit cb));
+			vnull
+		)
+		let chown = vifun3 (fun vthis uid gid cb ->
+			let this = this vthis in
+			let uid = decode_int uid in
+			let gid = decode_int gid in
+			wrap_sync (Uv.fs_fchown (loop ()) this uid gid (wrap_cb_unit cb));
+			vnull
+		)
+		let close = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.fs_close (loop ()) this (wrap_cb_unit cb));
+			vnull
+		)
+		let datasync = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.fs_fdatasync (loop ()) this (wrap_cb_unit cb));
+			vnull
+		)
+		let read = vifun5 (fun vthis buffer_i offset length position cb ->
+			let this = this vthis in
+			let buffer = decode_bytes buffer_i in
+			let offset = decode_int offset in
+			let length = decode_int length in
+			let position = decode_int position in
+			if length <= 0 || offset < 0 || length + offset > (Bytes.length buffer) then
+				exc_string "invalid call";
+			wrap_sync (Uv.fs_read (loop ()) this buffer offset length position (wrap_cb cb (fun bytesRead ->
+					encode_obj [key_bytesRead,vint bytesRead;key_buffer,buffer_i]
+				)));
+			vnull
+		)
+		let sync = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.fs_fsync (loop ()) this (wrap_cb_unit cb));
+			vnull
+		)
+		let stat = vifun1 (fun vthis cb ->
+			let this = this vthis in
+			wrap_sync (Uv.fs_fstat (loop ()) this (wrap_cb cb (fun stat ->
+					encode_instance key_eval_uv_Stat ~kind:(IUv (UvStat stat))
+				)));
+			vnull
+		)
+		let truncate = vifun2 (fun vthis len cb ->
+			let this = this vthis in
+			let len = decode_int len in
+			wrap_sync (Uv.fs_ftruncate (loop ()) this (Int64.of_int len) (wrap_cb_unit cb));
+			vnull
+		)
+		let utimes_native = vifun3 (fun vthis atime mtime cb ->
+			let this = this vthis in
+			let atime = decode_float atime in
+			let mtime = decode_float mtime in
+			wrap_sync (Uv.fs_futime (loop ()) this atime mtime (wrap_cb_unit cb));
+			vnull
+		)
+		let write = vifun5 (fun vthis buffer_i offset length position cb ->
+			let this = this vthis in
+			let buffer = decode_bytes buffer_i in
+			let offset = decode_int offset in
+			let length = decode_int length in
+			let position = decode_int position in
+			if length <= 0 || offset < 0 || length + offset > (Bytes.length buffer) then
+				exc_string "invalid call";
+			wrap_sync (Uv.fs_write (loop ()) this buffer offset length position (wrap_cb cb (fun bytesWritten ->
+					encode_obj [key_bytesWritten,vint bytesWritten;key_buffer,buffer_i]
+				)));
+			vnull
+		)
+	end
+
 	module FileSystem = struct
 		let access = vfun2 (fun path mode ->
 			let path = decode_string path in
@@ -3347,30 +3431,23 @@ module StdUv = struct
 		let access = vfun3 (fun path mode cb ->
 			let path = decode_string path in
 			let mode = default_int mode 0 in
-			(try Uv.fs_access (loop ()) path mode (wrap_cb_unit cb)
-				with Failure err -> exc_string err);
+			wrap_sync (Uv.fs_access (loop ()) path mode (wrap_cb_unit cb));
 			vnull
 		)
 		let exists = vfun2 (fun path cb ->
 			let path = decode_string path in
-			(try Uv.fs_access (loop ()) path 0 (fun res ->
+			wrap_sync (Uv.fs_access (loop ()) path 0 (fun res ->
 				ignore (match res with
 					| Uv.UvError err -> call_value cb [vnull; vfalse]
 					| Uv.UvSuccess () -> call_value cb [vnull; vtrue])
-				)
-				with Failure err -> exc_string err);
+				));
 			vnull
 		)
 		let readdirTypes = vfun2 (fun path cb ->
 			let path = decode_string path in
-			(try Uv.fs_scandir (loop ()) path 0 (fun res ->
-				ignore (match res with
-					| Uv.UvError err -> call_value cb [vnull; vfalse]
-					| Uv.UvSuccess entries ->
-						let entries = encode_array (List.map (fun e -> encode_instance key_eval_uv_DirectoryEntry ~kind:(IUv (UvDirent e))) entries) in
-						call_value cb [vnull; entries])
-				)
-				with Failure err -> exc_string err);
+			wrap_sync (Uv.fs_scandir (loop ()) path 0 (wrap_cb cb (fun entries ->
+					encode_array (List.map (fun e -> encode_instance key_eval_uv_DirectoryEntry ~kind:(IUv (UvDirent e))) entries)
+				)));
 			vnull
 		)
 	end
@@ -3442,7 +3519,7 @@ module StdUv = struct
 			let this = this vthis in
 			wrap_sync (Uv.tcp_shutdown this (fun res ->
 				match res with
-					| Uv.UvError err -> call_value cb [wrap_error err; vnull]; ()
+					| Uv.UvError err -> ignore (call_value cb [wrap_error err; vnull])
 					| Uv.UvSuccess () -> wrap_sync (Uv.tcp_close this (wrap_cb_unit cb))
 				));
 			vnull
@@ -4179,6 +4256,7 @@ let init_standard_library builtins =
 		"readdirTypes",StdUv.AsyncFileSystem.readdirTypes;
 	] [];
 	init_fields builtins (["nusys";"io"],"File") [] [
+		"get_async",StdUv.File.get_async;
 		"chmod",StdUv.File.chmod;
 		"chown",StdUv.File.chown;
 		"close",StdUv.File.close;
@@ -4190,6 +4268,18 @@ let init_standard_library builtins =
 		"utimes_native",StdUv.File.utimes_native;
 		"write",StdUv.File.write;
 	];
+	init_fields builtins (["nusys";"io"],"AsyncFile") [] [
+		"chmod",StdUv.AsyncFile.chmod;
+		"chown",StdUv.AsyncFile.chown;
+		"close",StdUv.AsyncFile.close;
+		"datasync",StdUv.AsyncFile.datasync;
+		"read",StdUv.AsyncFile.read;
+		"stat",StdUv.AsyncFile.stat;
+		"sync",StdUv.AsyncFile.sync;
+		"truncate",StdUv.AsyncFile.truncate;
+		"utimes_native",StdUv.AsyncFile.utimes_native;
+		"write",StdUv.AsyncFile.write;
+	];
 	init_fields builtins (["eval";"uv"],"DirectoryEntry") [] [
 		"get_name",StdUv.DirectoryEntry.get_name;
 		"get_type",StdUv.DirectoryEntry.get_type;