first async function, callbacks into Haxe

.gitignore

@@ -33,6 +33,7 @@
 /libs/xml-light/xml_lexer.ml
 /libs/xml-light/xml_parser.ml
 /libs/xml-light/xml_parser.mli
+/libs/uv/test
 /std/tools/haxedoc/haxedoc
 /std/tools/haxedoc/haxedoc.n
 /std/tools/haxelib/haxelib

libs/uv/test.ml

@@ -6,16 +6,18 @@ print_string "init loop...\n"; flush_all ();
 let loop = Uv.loop_init () in
 (*let cb_c () = print_string "closed\n" in
 let cb file = print_string "hey I got a file I guess\n"; flush_all (); Uv.fs_close loop file cb_c in*)
-let cb file =
-	print_string "hey I got a file I guess\n"; flush_all ();
-	let stat = Uv.fs_fstat_sync loop file in
-	print_string ("length: " ^ (Int64.to_string stat.size) ^ "\n"); flush_all ();
-	Uv.fs_close_sync loop file;
-	print_string "closed\n"; flush_all ();
+let cb = function
+	| CbError err -> print_string ("got an error: " ^ err ^ "\n"); flush_all ();
+	| CbSuccess file ->
+		print_string "hey I got a file I guess\n"; flush_all ();
+		let stat = Uv.fs_fstat_sync loop file in
+		print_string ("length: " ^ (Int64.to_string stat.size) ^ "\n"); flush_all ();
+		Uv.fs_close_sync loop file;
+		print_string "closed\n"; flush_all ();
 in
 print_string "open files...\n"; flush_all ();
 Uv.fs_open loop "uv.ml" 0 511 cb;
-Uv.fs_open loop "Makefile" 0 511 cb;
+Uv.fs_open loop "non-ext" 0 511 cb;
 print_string "sync open...\n"; flush_all ();
 let other_file = Uv.fs_open_sync loop "Makefile" 0 511 in
 print_string "run gc...\n"; flush_all ();

libs/uv/uv.ml

@@ -47,29 +47,33 @@ type t_buf
 (* Non-abstract type definitions  *)
 
 type t_stat = {
-  dev: int;
-  kind: int;
-  perm: int;
-  nlink: int;
-  uid: int;
-  gid: int;
-  rdev: int;
-  ino: int;
-  size: int64;
-  blksize: int;
-  blocks: int;
-  flags: int;
-  gen: int;
-  atime: int64;
-  atime_nsec: int;
-  mtime: int64;
-  mtime_nsec: int;
-  ctime: int64;
-  ctime_nsec: int;
-  birthtime: int64;
-  birthtime_nsec: int;
+	dev: int;
+	kind: int;
+	perm: int;
+	nlink: int;
+	uid: int;
+	gid: int;
+	rdev: int;
+	ino: int;
+	size: int64;
+	blksize: int;
+	blocks: int;
+	flags: int;
+	gen: int;
+	atime: int64;
+	atime_nsec: int;
+	mtime: int64;
+	mtime_nsec: int;
+	ctime: int64;
+	ctime_nsec: int;
+	birthtime: int64;
+	birthtime_nsec: int;
 }
 
+type 'a cb_result =
+	| CbError of string (* error message *)
+	| CbSuccess of 'a
+
 (* ------------- LOOP ----------------------------------------------- *)
 
 external loop_init : unit -> t_loop = "w_loop_init"
@@ -79,13 +83,13 @@ external loop_alive : t_loop -> bool = "w_loop_alive"
 
 (* ------------- FILESYSTEM ----------------------------------------- *)
 
-type fs_cb = unit -> unit
-type fs_cb_bytes = string -> unit
-type fs_cb_path = string -> unit
-type fs_cb_file = t_file -> unit
-type fs_cb_int = int -> unit
-type fs_cb_stat= t_stat -> unit
-type fs_cb_scandir = (string * int) list -> unit
+type fs_cb = unit cb_result -> unit
+type fs_cb_bytes = string cb_result -> unit
+type fs_cb_path = string cb_result -> unit
+type fs_cb_file = t_file cb_result -> unit
+type fs_cb_int = int cb_result -> unit
+type fs_cb_stat= t_stat cb_result -> unit
+type fs_cb_scandir = (string * int) list cb_result -> unit
 
 external fs_close : t_loop -> t_file -> fs_cb -> unit = "w_fs_close"
 external fs_open : t_loop -> string -> int -> int -> fs_cb_file -> unit = "w_fs_open"

libs/uv/uv_stubs.c

@@ -85,16 +85,15 @@ CAMLprim value w_stop(value loop) {
 
 // ------------- FILESYSTEM -----------------------------------------
 
-// TODO: exception handling (optional arguments ...?)
-
 static void handle_fs_cb(uv_fs_t *req) {
 	CAMLparam0();
 	value cb = (value)UV_REQ_DATA(req);
+	value res = caml_alloc(1, req->result < 0 ? 0 : 1);
 	if (req->result < 0)
-		caml_failwith(uv_strerror(req->result));
-		//hl_call1(void, cb, vdynamic *, construct_error((vbyte *)strdup(uv_strerror(req->result)), req->result));
+		Field(res, 0) = caml_copy_string(uv_strerror(req->result));
 	else
-		caml_callback(cb, Val_unit);
+		Field(res, 0) = Val_unit;
+	caml_callback(cb, res);
 	uv_fs_req_cleanup(req);
 	caml_remove_global_root(UV_REQ_DATA_A(req));
 	free(req);
@@ -109,13 +108,15 @@ static value handle_fs_cb_sync(uv_fs_t *req) {
 	static void name(uv_fs_t *req) { \
 		CAMLparam0(); \
 		value cb = (value)UV_REQ_DATA(req); \
+		value res = caml_alloc(1, req->result < 0 ? 0 : 1); \
 		if (req->result < 0) \
-			caml_failwith(uv_strerror(req->result)); \
+			Field(res, 0) = caml_copy_string(uv_strerror(req->result)); \
 		else { \
 			value value2; \
 			do setup while (0); \
-			caml_callback(cb, value2); \
+			Field(res, 0) = value2; \
 		} \
+		caml_callback(cb, res); \
 		uv_fs_req_cleanup(req); \
 		caml_remove_global_root(UV_REQ_DATA_A(req)); \
 		free(req); \
@@ -170,46 +171,6 @@ UV_FS_HANDLER(handle_fs_cb_scandir, {
 		}
 	});
 
-	/*
-#define UV_REQ_WRAP(name, reqtype, sign, call, handler) \
-	CAMLprim value w_ ## name(sign, value cb) { \
-		UV_ALLOC_CHECK(req, reqtype); \
-		UV_REQ_DATA(req) = (void *)cb; \
-		UV_ERROR_CHECK_C(uv_ ## name(req, call, handler), free(req)); \
-		caml_register_global_root(UV_REQ_DATA(req)); \
-		CAMLreturn0; \
-	}
-#define UV_REQ_WRAP_LOOP(name, reqtype, sign, call, ffi, handler) \
-	CAMLprim value w_ ## name(value *loop, sign, value cb) { \
-		UV_ALLOC_CHECK(req, reqtype); \
-		UV_REQ_DATA(req) = (void *)cb; \
-		UV_ERROR_CHECK_C(uv_ ## name(loop, req, call, handler), free(req)); \
-		caml_register_global_root(UV_REQ_DATA(req)); \
-		CAMLreturn0; \
-	}
-#define UV_REQ_WRAP_LOOP_SYNC(name, ret, reqtype, sign, call, ffiret, ffi, handler, doret) \
-	CAMLprim value w_ ## name ## _sync(uv_loop_t *loop, sign) { \
-		UV_ALLOC_CHECK(req, reqtype); \
-		UV_ERROR_CHECK_C(uv_ ## name(loop, req, call, NULL), free(req)); \
-		doret handler ## _sync(req); \
-	}
-	*/
-/*
-#define COMMA ,
-#define FS_WRAP1_LOOP(name, ret, arg1, ffiret, ffi, ffihandler, handler, doret) \
-	UV_REQ_WRAP_LOOP(name, uv_fs_t, arg1 _arg1, _arg1, ffi ffihandler, handler); \
-	UV_REQ_WRAP_LOOP_SYNC(name, ret, uv_fs_t, arg1 _arg1, _arg1, ffiret, ffi, handler, doret)
-#define FS_WRAP2_LOOP(name, ret, arg1, arg2, ffiret, ffi, ffihandler, handler, doret) \
-	UV_REQ_WRAP_LOOP(name, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2, _arg1 COMMA _arg2, ffi ffihandler, handler); \
-	UV_REQ_WRAP_LOOP_SYNC(name, ret, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2, _arg1 COMMA _arg2, ffiret, ffi, handler, doret)
-#define FS_WRAP3_LOOP(name, ret, arg1, arg2, arg3, ffiret, ffi, ffihandler, handler, doret) \
-	UV_REQ_WRAP_LOOP(name, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2 COMMA arg3 _arg3, _arg1 COMMA _arg2 COMMA _arg3, ffi ffihandler, handler); \
-	UV_REQ_WRAP_LOOP_SYNC(name, ret, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2 COMMA arg3 _arg3, _arg1 COMMA _arg2 COMMA _arg3, ffiret, ffi, handler, doret)
-#define FS_WRAP4_LOOP(name, ret, arg1, arg2, arg3, arg4, ffiret, ffi, ffihandler, handler, doret) \
-	UV_REQ_WRAP_LOOP(name, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2 COMMA arg3 _arg3 COMMA arg4 _arg4, _arg1 COMMA _arg2 COMMA _arg3 COMMA _arg4, ffi ffihandler, handler); \
-	UV_REQ_WRAP_LOOP_SYNC(name, ret, uv_fs_t, arg1 _arg1 COMMA arg2 _arg2 COMMA arg3 _arg3 COMMA arg4 _arg4, _arg1 COMMA _arg2 COMMA _arg3 COMMA _arg4, ffiret, ffi, handler, doret)
-*/
-
 #define FS_WRAP1(name, arg1conv, handler) \
 	CAMLprim value w_ ## name(value loop, value arg1, value cb) { \
 		CAMLparam3(loop, arg1, cb); \

src/macro/eval/evalDecode.ml

@@ -80,6 +80,10 @@ let decode_bool v = match v with
 	| VFalse -> false
 	| _ -> unexpected_value v "bool"
 
+let decode_func v = match v with
+	| VFunction (f, _) -> f
+	| _ -> unexpected_value v "function"
+
 let default_int v vd = match v with
 	| VNull -> vd
 	| VInt32 i -> Int32.to_int i

src/macro/eval/evalStdLib.ml

@@ -3068,9 +3068,24 @@ end
 module StdUv = struct
 	open Uv
 
+	(* Reference to the active libuv loop *)
 	let loop_ref = ref None
 	let loop () = Option.get !loop_ref
 
+	(* Wrap a Haxe callback which will take no result *)
+	let wrap_cb_unit cb = (fun res ->
+		ignore (match res with
+			| Uv.CbError err -> call_value cb [encode_string err; vnull]
+			| Uv.CbSuccess () -> call_value cb [vnull; vnull])
+	)
+
+	(* Wrap a Haxe callback which will take a result, as encoded by `enc` *)
+	(*let wrap_cb cb enc = (fun res ->
+		match res with
+			| Uv.CbError err -> call_value cb [encode_string err; vnull]
+			| Uv.CbSuccess val -> call_value cb [vnull; enc val]
+	)*)
+
 	module Loop = struct
 		let this vthis = match vthis with
 			| VInstance {ikind = IUv (UvLoop l)} -> l
@@ -3078,21 +3093,41 @@ module StdUv = struct
 	end
 
 	module FileSystem = struct
+		let access = vfun2 (fun path mode ->
+			let path = decode_string path in
+			let mode = decode_int mode in
+			Uv.fs_access_sync (loop ()) path 0;
+			vnull
+		)
 		let exists = vfun1 (fun path ->
-			let s = decode_string path in
+			let path = decode_string path in
 			try
-				Uv.fs_access_sync (loop ()) s 0;
+				Uv.fs_access_sync (loop ()) path 0;
 				vtrue
 			with _ ->
 				vfalse
 		)
 	end
 
+	module AsyncFileSystem = struct
+		let access = vfun3 (fun path mode cb ->
+			let path = decode_string path in
+			(*let mode = decode_int mode in*)
+			Uv.fs_access (loop ()) path 0 (wrap_cb_unit cb);
+			vnull
+		)
+	end
+
 	let init = vfun0 (fun () ->
 		loop_ref := Some (Uv.loop_init ());
 		(*encode_instance key_eval_uv_Loop ~kind:(IUv (UvLoop (Uv.loop_init ())))*)
 		vnull
 	)
+
+	let run = vfun0 (fun () ->
+		Uv.run (loop ()) 0;
+		vnull
+	)
 end
 
 let init_fields builtins path static_fields instance_fields =
@@ -3694,8 +3729,13 @@ let init_standard_library builtins =
 	init_fields builtins (["eval";"uv"],"Loop") [] [];
 	init_fields builtins (["eval";"uv"],"File") [] [];
 	init_fields builtins (["eval"],"Uv") [
-		"init",StdUv.init
+		"init",StdUv.init;
+		"run",StdUv.run
 	] [];
 	init_fields builtins (["nusys"],"FileSystem") [
+		"access",StdUv.FileSystem.access;
 		"exists",StdUv.FileSystem.exists
 	] [];
+	init_fields builtins (["nusys";"async"],"FileSystem") [
+		"access",StdUv.AsyncFileSystem.access
+	] []